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

ui.gadgets: new effects for add-gadget, add-gadgets, and (add-gadget)

db4
Eduardo Cavazos 2008-07-13 01:24:43 -05:00
parent 16b85df5db
commit 54b24fd8b1
1 changed files with 18 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -285,22 +285,27 @@ SYMBOL: in-layout?
not-in-layout not-in-layout
dup (clear-gadget) relayout ; dup (clear-gadget) relayout ;
: ((add-gadget)) ( gadget box -- ) : ((add-gadget)) ( parent child -- parent )
[ children>> ?push ] keep (>>children) ; over children>> ?push >>children ;
: (add-gadget) ( gadget box -- ) : (add-gadget) ( parent child -- parent )
over unparent dup unparent
dup pick (>>parent) over >>parent
[ ((add-gadget)) ] 2keep tuck ((add-gadget))
graft-state>> second [ graft ] [ drop ] if ; tuck graft-state>> second
[ graft ]
[ drop ]
if ;
: add-gadget ( gadget parent -- ) : add-gadget ( parent child -- parent )
not-in-layout not-in-layout
[ (add-gadget) ] keep relayout ; (add-gadget)
dup relayout ;
: add-gadgets ( seq parent -- ) : add-gadgets ( parent children -- parent )
not-in-layout not-in-layout
swap [ over (add-gadget) ] each relayout ; [ (add-gadget) ] each
dup relayout ;
: parents ( gadget -- seq ) : parents ( gadget -- seq )
[ parent>> ] follow ; [ parent>> ] follow ;
@ -352,7 +357,7 @@ M: f request-focus-on 2drop ;
: focus-path ( world -- seq ) : focus-path ( world -- seq )
[ focus>> ] follow ; [ focus>> ] follow ;
: gadget, ( gadget -- ) gadget get add-gadget ; : gadget, ( gadget -- ) gadget get swap add-gadget drop ;
: g ( -- gadget ) gadget get ; : g ( -- gadget ) gadget get ;