Move code for presentation support over to Gforth

doc/ft2019-presentation.fs

@@ -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#