Commit 473b8f81 authored by Bernd Paysan's avatar Bernd Paysan

Move code for presentation support over to Gforth

parent c05da02a
This diff is collapsed.
......@@ -30,157 +30,7 @@ require minos2/font-style.fs
44e update-size#
require minos2/text-style.fs
Variable slides[]
Variable slide#
0 Value n2-img
0 Value m2-img
0 Value $q-img
3 Constant n/m-switch
8 Constant m/$-switch
: >slides ( o -- ) slides[] >stack ;
glue ' new static-a with-allocater Constant glue-left
glue ' new static-a with-allocater Constant glue-right
: glue0 ( -- ) 0e fdup
[ glue-left .hglue-c ]L df!
[ glue-right .hglue-c ]L df! ;
: trans-frame ( o -- )
>o transp# to frame-color o> ;
: solid-frame ( o -- )
>o white# to frame-color o> ;
: !slides ( nprev n -- )
44e update-size# update-glue
over slide# !
slides[] $[] @ /flip drop
slides[] $[] @ /flop drop glue0 ;
: fade-img ( r0..1 img1 img2 -- ) >r >r
[ whitish x-color 1e f+ ] Fliteral fover f-
r> >o to frame-color parent-w .parent-w /flop drop o>
[ whitish x-color ] Fliteral f+
r> >o to frame-color parent-w .parent-w /flop drop o> ;
: anim!slides ( r0..1 n -- )
slides[] $[] @ /flop drop
fdup fnegate dpy-w @ fm* glue-left .hglue-c df!
-1e f+ dpy-w @ fm* glue-right .hglue-c df! ;
: prev-anim ( n r0..1 -- )
dup 0<= IF drop fdrop EXIT THEN
fdup 1e f>= IF fdrop
dup 1- swap !slides +sync +resize EXIT
THEN
1e fswap f-
1- sin-t anim!slides +sync +resize ;
: next-anim ( n r0..1 -- )
dup slides[] $[]# 1- u>= IF drop fdrop EXIT THEN
fdup 1e f>= IF fdrop
dup 1+ swap !slides +sync +resize EXIT
THEN
1+ sin-t anim!slides +sync +resize ;
1e FValue slide-time%
: prev-slide ( -- )
slide-time% anims[] $@len IF anim-end .2e f* THEN
slide# @ ['] prev-anim >animate ;
: next-slide ( -- )
slide-time% anims[] $@len IF anim-end .2e f* THEN
slide# @ ['] next-anim >animate ;
: slide-frame ( glue color -- o )
font-size# 70% f* }}frame ;
: vp-frame ( color -- o ) \ drop $FFFFFFFF
color, glue*wh slide-frame dup .button3 simple[] ;
: -25%b >o current-font-size% -25% f* to border o o> ;
box-actor class
\ sfvalue: s-x
\ sfvalue: s-y
\ sfvalue: last-x
\ sfvalue: last-t
\ sfvalue: speed
end-class slide-actor
0 Value scroll<<
:noname ( axis dir -- ) nip
0< IF prev-slide ELSE next-slide THEN ; slide-actor is scrolled
:noname ( rx ry b n -- ) dup 1 and 0= IF
over $180 and IF 4 to scroll<< THEN
over $08 scroll<< lshift and IF prev-slide 2drop fdrop fdrop EXIT THEN
over $10 scroll<< lshift and IF next-slide 2drop fdrop fdrop EXIT THEN
over -$2 and 0= IF
fover caller-w >o x f- w f/ o>
fdup 0.1e f< IF fdrop 2drop fdrop fdrop prev-slide EXIT
ELSE 0.9e f> IF 2drop fdrop fdrop next-slide EXIT THEN THEN
THEN THEN
[ box-actor :: clicked ] +sync +resize ; slide-actor is clicked
:noname ( ekey -- )
case
k-up of prev-slide endof
k-down of next-slide endof
k-prior of prev-slide endof
k-next of next-slide endof
k-volup of prev-slide endof
k-voldown of next-slide endof
s-k3 of 1e ambient% sf!
Ambient 1 ambient% opengl:glUniform1fv +sync endof
k-f3 of ambient% sf@ 0.1e f+ 1e fmin ambient% sf!
Ambient 1 ambient% opengl:glUniform1fv +sync endof
k-f4 of ambient% sf@ 0.1e f- 0e fmax ambient% sf!
Ambient 1 ambient% opengl:glUniform1fv +sync endof
s-k5 of 1e saturate% sf!
Saturate 1 saturate% opengl:glUniform1fv +sync endof
k-f5 of saturate% sf@ 0.1e f+ 3e fmin saturate% sf!
Saturate 1 saturate% opengl:glUniform1fv +sync endof
k-f6 of saturate% sf@ 0.1e f- 0e fmax saturate% sf!
Saturate 1 saturate% opengl:glUniform1fv +sync endof
k-f7 of color-theme 0<> IF anim-end 0.25e o
[: 1e fswap f- fdup f>s to color-theme 0.5e f+ ColorMode! +sync +vpsync ;]
>animate THEN endof
k-f8 of color-theme 0= IF anim-end 0.25e o
[: fdup f>s to color-theme 0.5e f+ ColorMode! +sync +vpsync ;]
>animate THEN endof
k-f1 of top-widget ..widget endof
[ box-actor :: ekeyed ] EXIT
endcase +sync +resize ; slide-actor to ekeyed
\ :noname ( $xy b -- ) dup 1 > IF
\ [ box-actor :: touchdown ] EXIT
\ THEN drop
\ xy@ to s-y to s-x ftime to last-t
\ true to grab-move? ; slide-actor is touchdown
\ :noname ( $xy b -- ) dup 1 > IF
\ [ box-actor :: touchmove ] EXIT
\ THEN drop xy@ fdrop
\ ftime last-t fover to last-t f- \ delta-t
\ last-x fover to last-x f- \ delta-x
\ fswap f/ caller-w .w f/ to speed
\ last-x s-x f- caller-w .w f/ fdup f0< IF \ to the right
\ 1e f+ slide# @ prev-anim
\ ELSE \ to the left
\ slide# @ next-anim
\ THEN ; slide-actor is touchmove
:noname ( $xy b -- ) 2dup [ box-actor :: touchmove ] drop
xy@ dpy-h @ s>f fswap f- dpy-h @ 2/ fm/ lightpos-xyz sfloat+ sf!
dpy-w @ s>f f- dpy-w @ 2/ fm/ lightpos-xyz sf!
3.0e lightpos-xyz 2 sfloats + sf!
LightPos 1 lightpos-xyz opengl:glUniform3fv +sync ; slide-actor is touchmove
\ :noname ( $xy b -- ) dup 1 > IF
\ [ box-actor :: touchup ] EXIT
\ THEN 2drop
\ slide# @ 1e next-anim
\ false to grab-move? ; slide-actor is touchup
: slide[] ( o -- o )
>o slide-actor new to act o act >o to caller-w o> o o> ;
glue-left >o 1glue vglue-c glue! 1glue dglue-c glue! o>
glue-right >o 1glue vglue-c glue! 1glue dglue-c glue! o>
require minos2/presentation-support.fs
tex: net2o-logo
tex: 35c3-logo
......@@ -200,10 +50,6 @@ tex: 35c3-logo
}}v >o font-size# f2/ to border o o>
to baseline# ;
: pres-frame ( colorday colornight -- o1 o2 )
day-mode new-color, night-mode -1 +to color,# new-color, fdrop day-mode
glue*wh slide-frame dup .button1 simple[] ;
$FFFFBBFF text-color: redish
$00CCCCFF dup text-emoji-color: blue-emoji#
m2c:shadow-color# @ color, FValue shadow-col#
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment