Verified Commit 594f5eb0 authored by Bernd Paysan's avatar Bernd Paysan
Browse files

Use stacks for child objects instead of list

parent 48a2966e

cross.fs

+7 −1
Original line number Diff line number Diff line
@@ -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

kernel/recognizer.fs

+1 −1
Original line number Diff line number Diff line
@@ -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

minos2/widgets.fs

+8 −9
Original line number Diff line number Diff line
@@ -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