steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

ui.gadgets: update children accessors

db4
Eduardo Cavazos 2008-07-12 17:48:08 -05:00
parent e16aa9ead3
commit a4678cc758
1 changed files with 8 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
extra/ui/gadgets/gadgets.factor
View File

@ -23,9 +23,9 @@ M: gadget hashcode* drop gadget hashcode* ;
M: gadget model-changed 2drop ; M: gadget model-changed 2drop ;
: gadget-child ( gadget -- child ) gadget-children first ; : gadget-child ( gadget -- child ) children>> first ;
: nth-gadget ( n gadget -- child ) gadget-children nth ; : nth-gadget ( n gadget -- child ) children>> nth ;
: new-gadget ( class -- gadget ) : new-gadget ( class -- gadget )
new new
@ -68,7 +68,7 @@ M: gadget user-input* 2drop t ;
GENERIC: children-on ( rect/point gadget -- seq ) GENERIC: children-on ( rect/point gadget -- seq )
M: gadget children-on nip gadget-children ; M: gadget children-on nip children>> ;
: (fast-children-on) ( dim axis gadgets -- i ) : (fast-children-on) ( dim axis gadgets -- i )
swapd [ rect-loc v- over v. 0 <=> ] binsearch nip ; swapd [ rect-loc v- over v. 0 <=> ] binsearch nip ;
@ -100,7 +100,7 @@ M: gadget children-on nip gadget-children ;
>r >r gadget-orientation r> r> [ pick set-axis ] 2map nip ; >r >r gadget-orientation r> r> [ pick set-axis ] 2map nip ;
: each-child ( gadget quot -- ) : each-child ( gadget quot -- )
>r gadget-children r> each ; inline >r children>> r> each ; inline
! Selection protocol ! Selection protocol
GENERIC: gadget-selection? ( gadget -- ? ) GENERIC: gadget-selection? ( gadget -- ? )
@ -124,7 +124,7 @@ M: gadget gadget-text-separator
[ dup % ] [ gadget-text* ] interleave drop ; [ dup % ] [ gadget-text* ] interleave drop ;
M: gadget gadget-text* M: gadget gadget-text*
dup gadget-children swap gadget-seq-text ; dup children>> swap gadget-seq-text ;
M: array gadget-text* M: array gadget-text*
[ gadget-text* ] each ; [ gadget-text* ] each ;
@ -273,7 +273,7 @@ SYMBOL: in-layout?
dup parent>> dup [ dup parent>> dup [
over (unparent) over (unparent)
[ unfocus-gadget ] 2keep [ unfocus-gadget ] 2keep
[ gadget-children delete ] keep [ children>> delete ] keep
relayout relayout
] [ ] [
2drop 2drop
@ -283,14 +283,14 @@ SYMBOL: in-layout?
: (clear-gadget) ( gadget -- ) : (clear-gadget) ( gadget -- )
dup [ (unparent) ] each-child dup [ (unparent) ] each-child
f over set-gadget-focus f over set-gadget-focus
f swap set-gadget-children ; f swap (>>children) ;
: clear-gadget ( gadget -- ) : clear-gadget ( gadget -- )
not-in-layout not-in-layout
dup (clear-gadget) relayout ; dup (clear-gadget) relayout ;
: ((add-gadget)) ( gadget box -- ) : ((add-gadget)) ( gadget box -- )
[ gadget-children ?push ] keep set-gadget-children ; [ children>> ?push ] keep (>>children) ;
: (add-gadget) ( gadget box -- ) : (add-gadget) ( gadget box -- )
over unparent over unparent