Check-in [0d5c34deb0]
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&glues
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 0d5c34deb07944da8646a6b039ab4a93d5694701
User & Date: bernd 2014-03-22 21:01:18
Context
2014-03-23
16:25
A bit more work on widgets check-in: 5bd0eda37c user: bernd tags: trunk
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
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to gles2/widgets.fs. 

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
...
223
224
225
226
227
228
229



230
231
232
233



234
235
236
237
238
239
240
...
261
262
263
264
265
266
267
268
269
270
271
272
273
274

    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 





: 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

................................................................................

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








|


<
<



<
<
<
|





|
|
|

|
<
>
|
|
>
>
>
>






>
>
>
>
>
>







 







>
>
>


<
<
>
>
>







 







|
<






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
...
228
229
230
231
232
233
234
235
236
237
238
239


240
241
242
243
244
245
246
247
248
249
...
270
271
272
273
274
275
276
277

278
279
280
281
282

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

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

\ glues

widget class


    3 cells +field hglue-c
    3 cells +field dglue-c
    3 cells +field vglue-c



end-class glue

: @+ ( 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@ ; dup glue to hglue@ glue to hglue
:noname dglue-c glue@ ; dup glue to dglue@ glue to dglue
:noname vglue-c glue@ ; dup glue to vglue@ glue to vglue

\ boxes


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

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

:noname ( -- )
    ['] !size do-childs
    hglue hglue-c glue!
    dglue dglue-c glue!
    vglue vglue-c glue! ; box to !size

: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

................................................................................

: 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 ;
: baseglue ( -- b 0 max )
    baseline @ 0 [ -1 1 rshift ]L ;
: glue-drop ( t s a -- )  2drop drop ;

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


: dglue+ 0glue [: glue-drop dglue@ ;] do-childs ; \ last dglue
: vglue+ 0glue 0glue [: vglue@ glue+ baseglue glue* glue+ dglue@ ;] do-childs
    glue-drop ;

: 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
................................................................................
    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 baseglue

    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. 

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
...
223
224
225
226
227
228
229



230
231
232
233



234
235
236
237
238
239
240
...
261
262
263
264
265
266
267
268
269
270
271
272
273
274

    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 





: 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

................................................................................

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








|


<
<



<
<
<
|





|
|
|

|
<
>
|
|
>
>
>
>






>
>
>
>
>
>







 







>
>
>


<
<
>
>
>







 







|
<






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
...
228
229
230
231
232
233
234
235
236
237
238
239


240
241
242
243
244
245
246
247
248
249
...
270
271
272
273
274
275
276
277

278
279
280
281
282

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

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

\ glues

widget class


    3 cells +field hglue-c
    3 cells +field dglue-c
    3 cells +field vglue-c



end-class glue

: @+ ( 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@ ; dup glue to hglue@ glue to hglue
:noname dglue-c glue@ ; dup glue to dglue@ glue to dglue
:noname vglue-c glue@ ; dup glue to vglue@ glue to vglue

\ boxes


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

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

:noname ( -- )
    ['] !size do-childs
    hglue hglue-c glue!
    dglue dglue-c glue!
    vglue vglue-c glue! ; box to !size

: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

................................................................................

: 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 ;
: baseglue ( -- b 0 max )
    baseline @ 0 [ -1 1 rshift ]L ;
: glue-drop ( t s a -- )  2drop drop ;

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


: dglue+ 0glue [: glue-drop dglue@ ;] do-childs ; \ last dglue
: vglue+ 0glue 0glue [: vglue@ glue+ baseglue glue* glue+ dglue@ ;] do-childs
    glue-drop ;

: 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
................................................................................
    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 baseglue

    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 [c9eb81a550] 2019-08-28 10:41:56