Added presentation support stuff

Makefile.in

@@ -364,8 +364,8 @@ MINOS2_SRC = gl-helper.fs gl-terminal.fs jpeg-exif.fs linux-gl.fs	    \
 	wayland-gl.fs soil-texture.fs gl-sample.fs gl-slideshow.fs	     \
 	ftgl-helper.fs ftgl-sample.fs widgets.fs actors.fs x11-actors.fs     \
 	android-actors.fs wayland-actors.fs widgets-test.fs presentation.fs  \
-	mts-tools.fs mkv-tools.fs omx-example.fs mkv-tags.fs		    \
-	android-recorder.fs animation.fs need-x.fs font-style.fs	    \
+	presentation-support.fs mts-tools.fs mkv-tools.fs omx-example.fs     \
+	mkv-tags.fs android-recorder.fs animation.fs need-x.fs font-style.fs \
 	text-style.fs gst-helper.fs plot.fs md-viewer.fs md-test.fs
 
 MINOS2_BIN = ascii.png button.png button2.png button3.png bad-gateway.png \

minos2/presentation-support.fs

+\ Presentation support
+
+\ Copyright (C) 2019 Free Software Foundation, Inc.
+
+\ This file is part of Gforth.
+
+\ Gforth is free software; you can redistribute it and/or
+\ modify it under the terms of the GNU General Public License
+\ as published by the Free Software Foundation, either version 3
+\ of the License, or (at your option) any later version.
+
+\ This program is distributed in the hope that it will be useful,
+\ but WITHOUT ANY WARRANTY; without even the implied warranty of
+\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+\ GNU General Public License for more details.
+
+\ You should have received a copy of the GNU General Public License
+\ along with this program. If not, see http://www.gnu.org/licenses/.
+
+Variable slides[]
+Variable slide#
+
+: >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
+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 k-ctrl-mask or      of  1e ambient% sf!
+	    Ambient 1 ambient% opengl:glUniform1fv  +sync endof
+	s-k3      of  ambient% sf@ 0.1e f+ 1e fmin  ambient% sf!
+	    Ambient 1 ambient% opengl:glUniform1fv  +sync endof
+	k-f3      of  ambient% sf@ 0.1e f- 0e fmax  ambient% sf!
+	    Ambient 1 ambient% opengl:glUniform1fv  +sync endof
+	s-k4 k-ctrl-mask or     of  1e saturate% sf!
+	    Saturate 1 saturate% opengl:glUniform1fv  +sync endof
+	s-k4      of  saturate% sf@ 0.1e f+ 3e fmin saturate% sf!
+	    Saturate 1 saturate% opengl:glUniform1fv  +sync endof
+	k-f4      of  saturate% sf@ 0.1e f- 0e fmax saturate% sf!
+	    Saturate 1 saturate% opengl:glUniform1fv  +sync endof
+	k-f5 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-f6 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 -- ) 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
+: 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>
+
+: 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[] ;

minos2/presentation.fs

@@ -27,146 +27,10 @@ ctx 0= [IF]  window-init  [THEN]
 
 require minos2/font-style.fs
 
-: update-size# ( -- )
-    dpy-w @ s>f 42e f/ fround to font-size#
-    font-size# 16e f/ m2c:curminwidth% f!
-    dpy-h @ s>f dpy-w @ fm/ 45% f/ font-size# f* fround to baseline#
-    dpy-w @ s>f 1280e f/ to pixelsize# ;
-
-update-size#
+44e update-size#
 
 require minos2/text-style.fs
-
-Variable slides[]
-Variable slide#
-
-: >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 -- )
-    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 ;
-
-box-actor class
-    \ sfvalue: s-x
-    \ sfvalue: s-y
-    \ sfvalue: last-x
-    \ sfvalue: last-t
-    \ sfvalue: speed
-end-class slide-actor
-
-: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 $8  and IF  prev-slide  2drop fdrop fdrop  EXIT  THEN
-	over $10 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 to 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
-	[ 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 presentation-support.fs
 
 tex: minos2
 ' minos2 "net2o-minos2.png" 0.666e }}image-file Constant minos2-glue drop
@@ -178,9 +42,6 @@ tex: minos2
     }}v >o font-size# f2/ to border o o>
     to baseline# r> ;
 
-: pres-frame ( color -- o1 o2 ) \ drop $FFFFFFFF
-    color, glue*wh slide-frame dup .button1 simple[] ;
-
 ' }}i18n-text is }}text'
 
 {{
@@ -188,7 +49,7 @@ tex: minos2
 
 \ page 0
 {{
-    $FFFFFFFF pres-frame
+    $FFFFFFFF dup pres-frame
     {{
 	glue*l }}glue \ ) $CCDDDD3F color, 4e }}frame dup .button1
 	l" ΜΙΝΩΣ2 GUI”" /title
@@ -202,7 +63,7 @@ tex: minos2
 
 \ page 6
 {{
-    $FFBFFFFF pres-frame
+    $FFBFFFFF dup pres-frame
     {{
 	l" ΜΙΝΩΣ2 Widgets" /title
 	l" Design principle is a Lego–style combination of many extremely simple objects" \\
@@ -233,7 +94,7 @@ tex: minos2
 
 \ page 7
 {{
-$BFFFFFFF pres-frame
+$BFFFFFFF dup pres-frame
 {{
     l" ΜΙΝΩΣ2 Boxes" /title
     {{
@@ -259,7 +120,7 @@ $BFFFFFFF pres-frame
 
 \ page 8
 {{
-    $FFFFBFFF pres-frame
+    $FFFFBFFF dup pres-frame
     {{
 	l" ΜΙΝΩΣ2 Displays" /title
 	l" Render into different kinds of displays" \\
@@ -274,7 +135,7 @@ $BFFFFFFF pres-frame
 
 \ page 9
 {{
-    $BFDFFFFF pres-frame
+    $BFDFFFFF dup pres-frame
     {{
 	l" Minimize Draw Calls" /title
 	l" OpenGL wants as few draw–calls per frame, so different contexts are drawn in stacks with a draw–call each" p\\
@@ -291,7 +152,7 @@ $BFFFFFFF pres-frame
 
 \ page 17
 {{
-    $FFFFFFFF pres-frame
+    $FFFFFFFF dup pres-frame
     {{
 	l" Literatur & Links" /title
 	vt{{