Commit 8ad45e9d authored by Bernd Paysan's avatar Bernd Paysan

A number of MINOS2 fixes

parent 7bab2f40
Pipeline #1176 passed with stage
in 9 minutes and 42 seconds
...@@ -42,7 +42,7 @@ Variable lsids ...@@ -42,7 +42,7 @@ Variable lsids
: $l, ( addr u -- ) dup , here swap dup allot move align ; : $l, ( addr u -- ) dup , here swap dup allot move align ;
: new-lsid ( addr u -- lsid ) : new-lsid ( addr u -- lsid )
here dup >r lsids append-list 0 , lsid# dup , 1+ to lsid# $l, r> ; align here dup >r lsids append-list 0 , lsid# dup , 1+ to lsid# $l, r> ;
: [new-lsid] ( addr u -- addr ) : [new-lsid] ( addr u -- addr )
2>r next-section 2r> align new-lsid >r 2>r next-section 2r> align new-lsid >r
previous-section r> ; previous-section r> ;
......
...@@ -82,7 +82,7 @@ is anim-ins ...@@ -82,7 +82,7 @@ is anim-ins
\ helper for animation \ helper for animation
: sin-t ( r0..1 -- r0..1 ) \ sinusoidal movement : sin-t ( r0..1 -- r0..1 ) \ sinusoidal movement
pi f* fcos f2/ 0.5e fswap f- ; pi f* fcos f2/ 1/2 fswap f- ;
: sin-at ( r0..r1 -- r0..1 ) \ accellerating : sin-at ( r0..r1 -- r0..1 ) \ accellerating
pi f2/ f* fcos 1e fswap f- ; pi f2/ f* fcos 1e fswap f- ;
: sin-dt ( r0..r1 -- r0..1 ) \ decellerating : sin-dt ( r0..r1 -- r0..1 ) \ decellerating
...@@ -91,4 +91,4 @@ is anim-ins ...@@ -91,4 +91,4 @@ is anim-ins
\ often used animation \ often used animation
: fade ( r -- ) : fade ( r -- )
0.999e fmin text-color 0.5e f- floor f+ 0.5e f+ to text-color ; 0.999e fmin text-color 1/2 f- floor f+ 1/2 f+ to text-color ;
...@@ -54,7 +54,7 @@ ...@@ -54,7 +54,7 @@
bounds ?DO bounds ?DO
fdup I f@ i>off >v fdup I f@ i>off >v
ysc f* y0 f+ >xy xsc f+ ysc f* y0 f+ >xy xsc f+
color i>c n> 0.5e fdup f# #>st v+> i-off @ i, color i>c n> 1/2 fdup f# #>st v+> i-off @ i,
1 flush-lines? IF 0 ELSE [ 1 floats ]L THEN 1 flush-lines? IF 0 ELSE [ 1 floats ]L THEN
+LOOP fdrop line-strip> ; +LOOP fdrop line-strip> ;
...@@ -67,7 +67,7 @@ ...@@ -67,7 +67,7 @@
dup f@ xsc f* x0 f+ float+ dup f@ xsc f* x0 f+ float+
I f@ ysc f* y0 f+ I f@ ysc f* y0 f+
i>off >v >xy i>off >v >xy
color i>c n> 0.5e fdup f# #>st v+> i-off @ i, color i>c n> 1/2 fdup f# #>st v+> i-off @ i,
1 flush-lines? IF 0 ELSE [ 1 floats ]L THEN 1 flush-lines? IF 0 ELSE [ 1 floats ]L THEN
+LOOP drop line-strip> ; +LOOP drop line-strip> ;
...@@ -81,7 +81,7 @@ ...@@ -81,7 +81,7 @@
dup f@ xsc f* f+ fswap float+ dup f@ xsc f* f+ fswap float+
I f@ ysc f* y0 f+ I f@ ysc f* y0 f+
i>off >v >xy i>off >v >xy
color i>c n> 0.5e fdup f# #>st v+> i-off @ i, color i>c n> 1/2 fdup f# #>st v+> i-off @ i,
1 flush-lines? IF 0 ELSE [ 1 floats ]L THEN 1 flush-lines? IF 0 ELSE [ 1 floats ]L THEN
+LOOP fdrop drop line-strip> ; +LOOP fdrop drop line-strip> ;
......
...@@ -192,10 +192,10 @@ end-class slide-actor ...@@ -192,10 +192,10 @@ end-class slide-actor
k-f4 of saturate% sf@ 0.1e f- 0e fmax saturate% sf! k-f4 of saturate% sf@ 0.1e f- 0e fmax saturate% sf!
Saturate 1 saturate% opengl:glUniform1fv +sync endof Saturate 1 saturate% opengl:glUniform1fv +sync endof
k-f5 of color-theme 0<> IF anim-end 0.25e o 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 ;] [: 1e fswap f- fdup f>s to color-theme 1/2 f+ ColorMode! +sync +vpsync ;]
>animate THEN endof >animate THEN endof
k-f6 of color-theme 0= IF anim-end 0.25e o k-f6 of color-theme 0= IF anim-end 0.25e o
[: fdup f>s to color-theme 0.5e f+ ColorMode! +sync +vpsync ;] [: fdup f>s to color-theme 1/2 f+ ColorMode! +sync +vpsync ;]
>animate THEN endof >animate THEN endof
k-f1 of top-widget ..widget endof k-f1 of top-widget ..widget endof
[ box-actor :: ekeyed ] EXIT [ box-actor :: ekeyed ] EXIT
......
...@@ -230,7 +230,7 @@ is reload-textures ...@@ -230,7 +230,7 @@ is reload-textures
[: [: o font-size# 15% f* fround >lowered ;] caller-w .parent-w .do-childs [: [: o font-size# 15% f* fround >lowered ;] caller-w .parent-w .do-childs
caller-w 0e >lowered caller-w 0e >lowered
[: o /vflip drop ;] data @ .parent-w .do-childs [: o /vflip drop ;] data @ .parent-w .do-childs
data @ /flop drop +resize +sync data @ /flop drop +lang +resize +sync
;] swap click[] ; ;] swap click[] ;
glue new Constant glue*wh glue new Constant glue*wh
......
...@@ -25,6 +25,7 @@ debug: time( \ +db time( \ ) ...@@ -25,6 +25,7 @@ debug: time( \ +db time( \ )
debug: gui( \ +db gui( \ ) debug: gui( \ +db gui( \ )
debug: click( \ +db click( \ ) debug: click( \ +db click( \ )
debug: click-o( \ +db click-o( \ ) debug: click-o( \ +db click-o( \ )
debug: resize( \ +db resize( \ )
[IFUNDEF] no-file# [IFUNDEF] no-file#
2 Constant ENOENT 2 Constant ENOENT
...@@ -302,7 +303,8 @@ end-class widget ...@@ -302,7 +303,8 @@ end-class widget
:noname w border f2* f+ borderl f+ kerning f+ 0e fdup ; widget is hglue :noname w border f2* f+ borderl f+ kerning f+ 0e fdup ; widget is hglue
:noname h border borderv f+ bordert f+ raise f- f+ 0e fdup ; widget is vglue :noname h border borderv f+ bordert f+ raise f- f+ 0e fdup ; widget is vglue
:noname d border borderv f+ raise f+ f+ 0e fdup ; widget is dglue :noname d border borderv f+ raise f+ f+ 0e fdup ; widget is dglue
: widget-resize to d to h to w to y to x ; : widget-resize to d to h to w to y to x
resize( w.indent# spaces name$ type ." : " x f. y f. w f. h f. d f. cr ) ;
' widget-resize widget is resize ' widget-resize widget is resize
' hglue widget is hglue@ ' hglue widget is hglue@
' vglue widget is vglue@ ' vglue widget is vglue@
...@@ -450,7 +452,7 @@ tile class ...@@ -450,7 +452,7 @@ tile class
value: cv-data value: cv-data
end-class canvas end-class canvas
:noname draw-canvas text-canvas ; canvas is draw :noname render> draw-canvas text-canvas vi0 ; canvas is draw
\ tile that doesn't draw \ tile that doesn't draw
...@@ -863,13 +865,32 @@ glue class ...@@ -863,13 +865,32 @@ glue class
method map method map
end-class box end-class box
1e20 fconstant 1fil
1fil fdup f* fconstant 1fill
1fil 1fill f* fconstant 1filll
1fil 1/f fconstant 0g \ minimum glue, needs to be bigger than zero to avoid 0/0
: .fil[l[l]] ( f -- )
fdup 0g 10e f* f< IF 0g f/ f. 'g' emit space EXIT THEN
fdup 1fil f< IF f. EXIT THEN
1fil f/ fdup 1fil f< IF f. ." fil" EXIT THEN
1fil f/ fdup 1fil f< IF f. ." fill" EXIT THEN
1fil f/ f. ." filll" ;
: .glue { f: t f: s f: a -- }
t f. s .fil[l[l]] space a .fil[l[l]] ;
: gdup ( glue -- glue glue ) fthird fthird fthird ;
: >glue0 ( -- ) : >glue0 ( -- )
aidglue ?dup-IF .aidglue0 THEN ; aidglue ?dup-IF .aidglue0 THEN ;
: >hglue!@ ( glue -- glue' ) : >hglue!@ ( glue -- glue' )
resize( w.indent# spaces name$ type ." : h " gdup .glue cr )
aidglue ?dup-IF .hglue!@ THEN ; aidglue ?dup-IF .hglue!@ THEN ;
: >vglue!@ ( glue -- glue' ) : >vglue!@ ( glue -- glue' )
resize( w.indent# spaces name$ type ." : v " gdup .glue cr )
aidglue ?dup-IF .vglue!@ THEN ; aidglue ?dup-IF .vglue!@ THEN ;
: >dglue!@ ( glue -- glue' ) : >dglue!@ ( glue -- glue' )
resize( w.indent# spaces name$ type ." : d " gdup .glue cr )
aidglue ?dup-IF .dglue!@ THEN ; aidglue ?dup-IF .dglue!@ THEN ;
: do-childs { xt: xt -- .. } : do-childs { xt: xt -- .. }
...@@ -948,11 +969,6 @@ box class ...@@ -948,11 +969,6 @@ box class
end-class vbox \ vertical alignment end-class vbox \ vertical alignment
box class end-class zbox \ overlay alignment box class end-class zbox \ overlay alignment
1e20 fconstant 1fil
1fil fdup f* fconstant 1fill
1fil 1fill f* fconstant 1filll
1fil 1/f fconstant 0g \ minimum glue, needs to be bigger than zero to avoid 0/0
: fils ( f -- f' ) 1fil f* ; : fils ( f -- f' ) 1fil f* ;
: fills ( f -- f' ) 1fill f* ; : fills ( f -- f' ) 1fill f* ;
: fillls ( f -- f' ) 1filll f* ; : fillls ( f -- f' ) 1filll f* ;
...@@ -962,14 +978,6 @@ box class end-class zbox \ overlay alignment ...@@ -962,14 +978,6 @@ box class end-class zbox \ overlay alignment
: 1kglue ( -- t s a ) 0e 0g 1fill ; : 1kglue ( -- t s a ) 0e 0g 1fill ;
: 1Mglue ( -- t s a ) 0e 0g 1filll ; : 1Mglue ( -- t s a ) 0e 0g 1filll ;
: .fil[l[l]] ( f -- )
fdup 1fil f< IF f. EXIT THEN
1fil f/ fdup 1fil f< IF f. ." fil" EXIT THEN
1fil f/ fdup 1fil f< IF f. ." fill" EXIT THEN
1fil f/ f. ." filll" ;
: .glue { f: t f: s f: a -- }
t f. s f. a .fil[l[l]] ;
: .rec { f: x f: y f: w f: h f: d -- } : .rec { f: x f: y f: w f: h f: d -- }
x f. y f. w f. h f. d f. ; x f. y f. w f. h f. d f. ;
...@@ -1085,13 +1093,14 @@ glue*2 >o 1glue f2* hglue-c glue! 0glue f2* dglue-c glue! 1glue f2* vglue-c glue ...@@ -1085,13 +1093,14 @@ glue*2 >o 1glue f2* hglue-c glue! 0glue f2* dglue-c glue! 1glue f2* vglue-c glue
\ ." hchild resized: " x f. y f. w f. h f. d f. cr \ ." hchild resized: " x f. y f. w f. h f. d f. cr
y h d ; y h d ;
: hbox-resize { f: x f: y f: w f: h f: d -- } : hbox-resize { f: x f: y f: w f: h f: d -- }
x y w h d widget-resize 1 +to w.indent# x y w h d widget-resize
hglue+ frot bxx f- f-rot w bxx f- { f: wtotal } hglue+ frot bxx f- f-rot w bxx f- { f: wtotal }
2 fpick wtotal f<= ?g3>2 { f: wmin f: a } 2 fpick wtotal f<= ?g3>2 { f: wmin f: a }
wtotal wmin f- a f/ 0e fdup x bx f+ wtotal wmin f- a f/ 0e fdup x bx f+
['] hglue-step box-hvisible# ?do-childs ['] hglue-step box-hvisible# ?do-childs
fdrop fdrop fdrop fdrop fdrop fdrop fdrop fdrop
y h d ['] hbox-resize1 box-hvisible# ?do-childs fdrop fdrop fdrop y h d ['] hbox-resize1 box-hvisible# ?do-childs fdrop fdrop fdrop
-1 +to w.indent#
\ ." hbox sized to: " x f. y f. w f. h f. d f. cr \ ." hbox sized to: " x f. y f. w f. h f. d f. cr
; ;
...@@ -1170,6 +1179,7 @@ glue*2 >o 1glue f2* hglue-c glue! 0glue f2* dglue-c glue! 1glue f2* vglue-c glue ...@@ -1170,6 +1179,7 @@ glue*2 >o 1glue f2* hglue-c glue! 0glue f2* dglue-c glue! 1glue f2* vglue-c glue
\ ." vchild resized: " x f. y f. w f. h f. d f. cr \ ." vchild resized: " x f. y f. w f. h f. d f. cr
x w ; x w ;
: vbox-resize { f: x f: y f: w f: h f: d -- } : vbox-resize { f: x f: y f: w f: h f: d -- }
1 +to w.indent#
x y w h d widget-resize x y w h d widget-resize
hglue* glue-drop vglue+ dglue+ glue+ frot byd f- f-rot hglue* glue-drop vglue+ dglue+ glue+ frot byd f- f-rot
h d f+ byd f- { f: htotal } h d f+ byd f- { f: htotal }
...@@ -1182,6 +1192,7 @@ glue*2 >o 1glue f2* hglue-c glue! 0glue f2* dglue-c glue! 1glue f2* vglue-c glue ...@@ -1182,6 +1192,7 @@ glue*2 >o 1glue f2* hglue-c glue! 0glue f2* dglue-c glue! 1glue f2* vglue-c glue
x bx f+ w bxx f- x bx f+ w bxx f-
['] vbox-resize1 box-vvisible# ?do-childs ['] vbox-resize1 box-vvisible# ?do-childs
fdrop fdrop fdrop fdrop
-1 +to w.indent#
\ ." vbox sized to: " x f. y f. w f. h f. d f. cr \ ." vbox sized to: " x f. y f. w f. h f. d f. cr
; ;
...@@ -1193,11 +1204,13 @@ glue*2 >o 1glue f2* hglue-c glue! 0glue f2* dglue-c glue! 1glue f2* vglue-c glue ...@@ -1193,11 +1204,13 @@ glue*2 >o 1glue f2* hglue-c glue! 0glue f2* dglue-c glue! 1glue f2* vglue-c glue
x y w h d ; x y w h d ;
: zbox-resize { f: x f: y f: w f: h f: d -- } : zbox-resize { f: x f: y f: w f: h f: d -- }
1 +to w.indent#
x y w h d widget-resize x y w h d widget-resize
x bx f+ y byy f+ w bxx f- x bx f+ y byy f+ w bxx f-
h byy f- d bdd f- h byy f- d bdd f-
['] zbox-resize1 box-visible# ?do-childs ['] zbox-resize1 box-visible# ?do-childs
fdrop fdrop fdrop fdrop fdrop fdrop fdrop fdrop fdrop fdrop
-1 +to w.indent#
\ ." zbox sized to: " x f. y f. w f. h f. d f. cr \ ." zbox sized to: " x f. y f. w f. h f. d f. cr
; ;
...@@ -1340,7 +1353,7 @@ $10 stack: vp<> ...@@ -1340,7 +1353,7 @@ $10 stack: vp<>
o vp<> >stack o vp<> >stack
need-mask >r vp-need to need-mask need-mask >r vp-need to need-mask
catch r> to need-mask catch r> to need-mask
vp<> stack> drop throw vp<> stack> >o rdrop throw
ELSE drop THEN ; ELSE drop THEN ;
1 sfloats buffer: vp-ambient% 1.0e vp-ambient% sf! 1 sfloats buffer: vp-ambient% 1.0e vp-ambient% sf!
...@@ -1467,25 +1480,31 @@ $10 stack: vp<> ...@@ -1467,25 +1480,31 @@ $10 stack: vp<>
; viewport is resize ; viewport is resize
:noname ( -- glue ) :noname ( -- glue )
box-flags vp-hfix# and IF [ vbox :: hglue ] box-flags vp-hfix# and IF [ vbox :: hglue ]
ELSE vp-glue .hglue >hglue!@ THEN ; viewport is hglue ELSE vp-glue .hglue >hglue!@ THEN
resize( ." vp.hglue: " gdup .glue cr ) ; viewport is hglue
:noname ( -- glue ) :noname ( -- glue )
box-flags vp-dfix# and IF [ vbox :: dglue ] box-flags vp-dfix# and IF [ vbox :: dglue ]
ELSE vp-glue .dglue >dglue!@ THEN ; viewport is dglue ELSE vp-glue .dglue >dglue!@ THEN
resize( ." vp.dglue: " gdup .glue cr ) ; viewport is dglue
:noname ( -- glue ) :noname ( -- glue )
box-flags vp-vfix# and IF [ vbox :: vglue ] box-flags vp-vfix# and IF [ vbox :: vglue ]
ELSE vp-glue .vglue >vglue!@ THEN ; viewport is vglue ELSE vp-glue .vglue >vglue!@ THEN
resize( ." vp.vglue: " gdup .glue cr ) ; viewport is vglue
:noname ( -- glue ) :noname ( -- glue )
box-flags vp-hfix# and IF [ vbox :: hglue@ ] box-flags vp-hfix# and IF [ vbox :: hglue@ ]
ELSE vp-glue .hglue@ THEN ; viewport is hglue@ ELSE vp-glue .hglue@ THEN
resize( ." vp.hglue@: " gdup .glue cr ) ; viewport is hglue@
:noname ( -- glue ) :noname ( -- glue )
box-flags vp-dfix# and IF [ vbox :: dglue@ ] box-flags vp-dfix# and IF [ vbox :: dglue@ ]
ELSE vp-glue .dglue@ THEN ; viewport is dglue@ ELSE vp-glue .dglue@ THEN
resize( ." vp.dglue@: " gdup .glue cr ) ; viewport is dglue@
:noname ( -- glue ) :noname ( -- glue )
box-flags vp-vfix# and IF [ vbox :: vglue@ ] box-flags vp-vfix# and IF [ vbox :: vglue@ ]
ELSE vp-glue .vglue@ THEN ; viewport is vglue@ ELSE vp-glue .vglue@ THEN
resize( ." vp.vglue@: " gdup .glue cr ) ; viewport is vglue@
: }}vp ( b:n1 .. b:nm glue vp-tex -- viewport ) { g t } : }}vp ( b:n1 .. b:nm glue vp-tex -- viewport ) { g t }
}} viewport new >o "vp" to name$ +childs t is vp-tex g to vp-glue o o> ; }} viewport new >o -1 to baseline-offset "vp" to name$
+childs t is vp-tex g to vp-glue o o> ;
\ slider (simple composit object) \ slider (simple composit object)
......
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