Check-in [0ac9dc7f4c]
Not logged in
Home Timeline Branches Tags Tickets Wiki Login

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

Overview
Comment:More work on boxes, still untested
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 0ac9dc7f4c4dfb7cdb3a8474d7a7739c46638f9c
User & Date: bernd 2014-03-21 23:14:55.387
Context
2014-03-22
21:01
More work on boxes&glues check-in: 0d5c34deb0 user: bernd tags: trunk
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
Changes
Unified Diff Ignore Whitespace Patch
Changes to gles2/widgets.fs.
︙︙
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

: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








<
<
<
<





>
>
>
>
>




>
>
















>
>
>
>
>
>












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


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
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274

:noname vglue-c glue@ ; box to vglue@

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





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

:noname ( -- ) ['] draw do-childs ; box to draw

: +child ( o -- ) child-w @ over >o next-w ! o> child-w ! ;
: +childs ( o1 .. on n -- ) 0 +DO  +child  LOOP ;

\ glue arithmetics

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

: g3>2 ( t s a -- min a ) over + >r - r> ;

: 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 ;

box class end-class hbox \ horizontal alignment
box class
    field: baseline \ minimun skip per line
end-class vbox \ vertical alignment
box class end-class zbox \ overlay alignment

' 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

\ add glues up for hboxes

: hglue-step { gp ga rd rg rx -- gp ga rd' rg' rx' }
    gp ga  rx x !
    hglue@ g3>2 { xmin xa }
    rg xa + gp ga */ rd - dup rd + rg xa +
    rot xmin + ;

\ add glues up for vboxes

: vglue-step { gp ga rd rg ry td sd ad -- gp ga rd' rg' ry' td' sd' ad' }
    gp ga
    baseline @ 0 [ -1 1 rshift ]L
    vglue@ td sd ad glue+ glue* g3>2 { ymin ya }
    rg ya + gp ga */ rd - dup rd + rg ya +
    rot ymin +  dup ry !  dglue@ ;

previous previous previous set-current
Changes to widgets.fs.
︙︙
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

: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








<
<
<
<





>
>
>
>
>




>
>
















>
>
>
>
>
>












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


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
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274

:noname vglue-c glue@ ; box to vglue@

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





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

:noname ( -- ) ['] draw do-childs ; box to draw

: +child ( o -- ) child-w @ over >o next-w ! o> child-w ! ;
: +childs ( o1 .. on n -- ) 0 +DO  +child  LOOP ;

\ glue arithmetics

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

: g3>2 ( t s a -- min a ) over + >r - r> ;

: 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 ;

box class end-class hbox \ horizontal alignment
box class
    field: baseline \ minimun skip per line
end-class vbox \ vertical alignment
box class end-class zbox \ overlay alignment

' 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

\ add glues up for hboxes

: hglue-step { gp ga rd rg rx -- gp ga rd' rg' rx' }
    gp ga  rx x !
    hglue@ g3>2 { xmin xa }
    rg xa + gp ga */ rd - dup rd + rg xa +
    rot xmin + ;

\ add glues up for vboxes

: vglue-step { gp ga rd rg ry td sd ad -- gp ga rd' rg' ry' td' sd' ad' }
    gp ga
    baseline @ 0 [ -1 1 rshift ]L
    vglue@ td sd ad glue+ glue* g3>2 { ymin ya }
    rg ya + gp ga */ rd - dup rd + rg ya +
    rot ymin +  dup ry !  dglue@ ;

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