Commit 594f5eb0 authored by Bernd Paysan's avatar Bernd Paysan

Use stacks for child objects instead of list

parent 48a2966e
......@@ -805,6 +805,7 @@ Plugin do, ( -- do-token )
Plugin ?do, ( -- ?do-token )
Plugin +do, ( -- ?do-token )
Plugin -do, ( -- ?do-token )
Plugin u-do, ( -- ?do-token )
Plugin for, ( -- for-token )
Plugin loop, ( do-token / ?do-token -- )
Plugin +loop, ( do-token / ?do-token -- )
......@@ -1792,7 +1793,7 @@ T has? relocate H
>CROSS
Ghost (do) Ghost (?do) 2drop
Ghost (+do) Ghost (-do) 2drop
Ghost (+do) Ghost (-do) Ghost (u-do) 2drop drop
Ghost (for) drop
Ghost (loop) Ghost (+loop) Ghost (-loop) 2drop drop
Ghost (next) drop
......@@ -3738,6 +3739,10 @@ Cond: ENDCASE endcase, ;Cond
0 compile (-do) ?domark, (leave)
branchtomark, 2 to1 ; ' (-do,) plugin-of -do,
: (u-do,) ( -- target-addr )
0 compile (u-do) ?domark, (leave)
branchtomark, 2 to1 ; ' (u-do,) plugin-of u-do,
: (for,) ( -- target-addr )
compile (for) branchtomark, ; ' (for,) plugin-of for,
......@@ -3760,6 +3765,7 @@ Cond: DO do, ;Cond
Cond: ?DO ?do, ;Cond
Cond: +DO +do, ;Cond
Cond: -DO -do, ;Cond
Cond: U-DO u-do, ;Cond
Cond: FOR for, ;Cond
Cond: LOOP 1 ncontrols? loop, ;Cond
......
......@@ -115,7 +115,7 @@ Defer trace-recognizer ' drop is trace-recognizer
: recognize ( addr u rec-addr -- tokens table )
\G apply a recognizer stack to a string, delivering a token
$@ bounds cell- swap cell- -DO
$@ bounds cell- swap cell- U-DO
2dup I -rot 2>r
perform dup rectype-null <> IF
2rdrop I @ trace-recognizer UNLOOP EXIT THEN drop
......
......@@ -109,7 +109,6 @@ end-class actor
' noop actor is show-you
object class
value: next-w
value: parent-w
value: act
sfvalue: x
......@@ -441,7 +440,7 @@ Variable style-i#
\ boxes
glue class
value: child-w
field: childs[]
field: box-flags
method resized
method map
......@@ -449,9 +448,9 @@ end-class box
: do-childs { xt -- .. }
box-flags @ box-flip# and ?EXIT
child-w >o
BEGIN xt execute next-w o> dup WHILE >o REPEAT
drop ;
childs[] $@ bounds U+DO
xt I @ .execute
cell +LOOP ;
:noname ( -- )
['] !size do-childs
......@@ -472,9 +471,9 @@ end-class box
ELSE !size xywhd resize \ downwards
THEN ; widget to resized
: +child ( o -- )
child-w o 2 pick >o to parent-w to next-w o> to child-w ;
: +childs ( o1 .. on n -- ) 0 +DO +child LOOP ;
: +child ( o -- ) o over >o to parent-w o> childs[] >back ;
: +childs ( o1 .. on n -- ) childs[] set-stack
o [: dup to parent-w ;] do-childs drop ;
\ glue arithmetics
......@@ -649,7 +648,7 @@ box class
end-class viewport
:noname vp-w vp-h vp-tex >framebuffer
child-w .widget-draw
['] widget-draw do-childs
0>framebuffer ; viewport to draw-init
:noname ( -- )
1-bias set-color+ vp-tex
......
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