Check-in [1a914abaed]
Not logged in
Home Timeline Branches Tags Tickets Wiki Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Work on boxes
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 1a914abaede039a2b3c99b6122b96fa4b9f65c37
User & Date: bernd 2014-03-21 21:29:33.305
Context
2014-03-21
23:14
More work on boxes, still untested check-in: 0ac9dc7f4c user: bernd tags: trunk
21:29
Work on boxes check-in: 1a914abaed user: bernd tags: trunk
20:02
Fixed Linux problem with FreetypeGL - need to init context first check-in: 10867065c5 user: bernd tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Changes to gles2/widgets.fs.
︙︙
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77

:noname w @ 0 0 ; widget to hglue
:noname h @ 0 0 ; widget to vglue
:noname d @ 0 0 ; widget to dglue
' hglue widget to hglue@
' vglue widget to vglue@
' dglue widget to dglue@

widget class
    field: child-w
    field: act
    method resized
    method map
end-class box

tex: style-tex \ 8 x 8 subimages, each sized 128x128
style-tex 1024 dup rgba-newtex

\ tile widget

widget class
    field: frame#








<
<
<
<
<
<
<








57
58
59
60
61
62
63







64
65
66
67
68
69
70

:noname w @ 0 0 ; widget to hglue
:noname h @ 0 0 ; widget to vglue
:noname d @ 0 0 ; widget to dglue
' hglue widget to hglue@
' vglue widget to vglue@
' dglue widget to dglue@








tex: style-tex \ 8 x 8 subimages, each sized 128x128
style-tex 1024 dup rgba-newtex

\ tile widget

widget class
    field: frame#
︙︙
181
182
183
184
185
186
187



































































188

    style-i# @ 1 style-i# +! ;
: style: load-style Create , DOES> @ frame# ! ;

"button.png" style: button1
"button2.png" style: button2
"button3.png" style: button3




































































previous previous previous set-current








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248

    style-i# @ 1 style-i# +! ;
: style: load-style Create , DOES> @ frame# ! ;

"button.png" style: button1
"button2.png" style: button2
"button3.png" style: button3

\ boxes

widget class
    field: child-w
    field: act
    3 cells +field hglue-c
    3 cells +field dglue-c
    3 cells +field vglue-c
    method resized
    method !resized
    method map
end-class box

: @+ ( addr -- u addr' )  dup >r @ r> cell+ ;
: !- ( addr -- u addr' )  dup >r ! r> cell- ;
: glue@ ( addr -- t s a )  @+ @+ @ ;
: glue! ( t s a addr -- )  2 cells + !- !- ! ;
:noname hglue-c glue@ ; box to hglue@
:noname dglue-c glue@ ; box to dglue@
:noname vglue-c glue@ ; box to vglue@

:noname ( -- )
    hglue hglue-c glue!
    dglue dglue-c glue!
    vglue vglue-c glue! ; box to !resized 

box class end-class hbox \ horizontal alignment
box class end-class vbox \ vertical alignment
box class end-class zbox \ overlay alignment

: do-childs { xt -- .. }
    child-w @ >o
    BEGIN  xt execute  next-w @ o>  dup  WHILE  >o  REPEAT
    drop ;

\ glue arithmetics

: 0glue ( -- t s a ) 0 0 0 ;
: 1glue ( -- t s a ) 0 0 [ -1 1 rshift ]L ;

: glue+ { t1 s1 a1 t2 s2 a2 -- t3 s3 a3 }
    t1 t2 + s1 s2 + a1 a2 + ;
: glue* { t1 s1 a1 t2 s2 a2 -- t3 s3 a3 }
    t1 t2 max
    t1 s1 - t2 s2 - max over - 0 max
    t1 a1 + t2 a2 + min 2 pick - 0 max ;

: hglue+ 0glue [: hglue@ glue+ ;] do-childs ;
: dglue+ 0glue [: dglue@ glue+ ;] do-childs ;
: vglue+ 0glue [: vglue@ glue+ ;] do-childs ;

: hglue* 1glue [: hglue@ glue* ;] do-childs ;
: dglue* 1glue [: dglue@ glue* ;] do-childs ;
: vglue* 1glue [: vglue@ glue* ;] do-childs ;

' hglue+ hbox is hglue
' dglue* hbox is dglue
' vglue* hbox is vglue

' hglue* vbox is hglue
' dglue+ vbox is dglue
' vglue+ vbox is vglue

' hglue* zbox is hglue
' dglue* zbox is dglue
' vglue* zbox is vglue

previous previous previous set-current
Changes to widgets.fs.
︙︙
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77

:noname w @ 0 0 ; widget to hglue
:noname h @ 0 0 ; widget to vglue
:noname d @ 0 0 ; widget to dglue
' hglue widget to hglue@
' vglue widget to vglue@
' dglue widget to dglue@

widget class
    field: child-w
    field: act
    method resized
    method map
end-class box

tex: style-tex \ 8 x 8 subimages, each sized 128x128
style-tex 1024 dup rgba-newtex

\ tile widget

widget class
    field: frame#








<
<
<
<
<
<
<








57
58
59
60
61
62
63







64
65
66
67
68
69
70

:noname w @ 0 0 ; widget to hglue
:noname h @ 0 0 ; widget to vglue
:noname d @ 0 0 ; widget to dglue
' hglue widget to hglue@
' vglue widget to vglue@
' dglue widget to dglue@








tex: style-tex \ 8 x 8 subimages, each sized 128x128
style-tex 1024 dup rgba-newtex

\ tile widget

widget class
    field: frame#
︙︙
181
182
183
184
185
186
187



































































188

    style-i# @ 1 style-i# +! ;
: style: load-style Create , DOES> @ frame# ! ;

"button.png" style: button1
"button2.png" style: button2
"button3.png" style: button3




































































previous previous previous set-current








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248

    style-i# @ 1 style-i# +! ;
: style: load-style Create , DOES> @ frame# ! ;

"button.png" style: button1
"button2.png" style: button2
"button3.png" style: button3

\ boxes

widget class
    field: child-w
    field: act
    3 cells +field hglue-c
    3 cells +field dglue-c
    3 cells +field vglue-c
    method resized
    method !resized
    method map
end-class box

: @+ ( addr -- u addr' )  dup >r @ r> cell+ ;
: !- ( addr -- u addr' )  dup >r ! r> cell- ;
: glue@ ( addr -- t s a )  @+ @+ @ ;
: glue! ( t s a addr -- )  2 cells + !- !- ! ;
:noname hglue-c glue@ ; box to hglue@
:noname dglue-c glue@ ; box to dglue@
:noname vglue-c glue@ ; box to vglue@

:noname ( -- )
    hglue hglue-c glue!
    dglue dglue-c glue!
    vglue vglue-c glue! ; box to !resized 

box class end-class hbox \ horizontal alignment
box class end-class vbox \ vertical alignment
box class end-class zbox \ overlay alignment

: do-childs { xt -- .. }
    child-w @ >o
    BEGIN  xt execute  next-w @ o>  dup  WHILE  >o  REPEAT
    drop ;

\ glue arithmetics

: 0glue ( -- t s a ) 0 0 0 ;
: 1glue ( -- t s a ) 0 0 [ -1 1 rshift ]L ;

: glue+ { t1 s1 a1 t2 s2 a2 -- t3 s3 a3 }
    t1 t2 + s1 s2 + a1 a2 + ;
: glue* { t1 s1 a1 t2 s2 a2 -- t3 s3 a3 }
    t1 t2 max
    t1 s1 - t2 s2 - max over - 0 max
    t1 a1 + t2 a2 + min 2 pick - 0 max ;

: hglue+ 0glue [: hglue@ glue+ ;] do-childs ;
: dglue+ 0glue [: dglue@ glue+ ;] do-childs ;
: vglue+ 0glue [: vglue@ glue+ ;] do-childs ;

: hglue* 1glue [: hglue@ glue* ;] do-childs ;
: dglue* 1glue [: dglue@ glue* ;] do-childs ;
: vglue* 1glue [: vglue@ glue* ;] do-childs ;

' hglue+ hbox is hglue
' dglue* hbox is dglue
' vglue* hbox is vglue

' hglue* vbox is hglue
' dglue+ vbox is dglue
' vglue+ vbox is vglue

' hglue* zbox is hglue
' dglue* zbox is dglue
' vglue* zbox is vglue

previous previous previous set-current
Fossil version [611144ddd9] 2025-05-16 13:52:48