Move code for presentation support over to Gforth (473b8f81) · Commits · Bernd Paysan / net2o

doc/ef2019-presentation.fs

0 → 100644

+755 −0

File added.

Preview size limit exceeded, changes collapsed.

doc/ft2019-presentation.fs

+1 −155

Original line number	Diff line number	Diff line
		@@ -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#