From 80a38f8990d473fa5bc63709ce44357c8df0413b Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sat, 12 Jul 2008 15:48:20 -0500 Subject: [PATCH 01/10] boids.ui: use newfx --- extra/boids/ui/ui.factor | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/extra/boids/ui/ui.factor b/extra/boids/ui/ui.factor index ab1f8e5f80..b1f594b8c2 100755 --- a/extra/boids/ui/ui.factor +++ b/extra/boids/ui/ui.factor @@ -20,7 +20,8 @@ USING: combinators.short-circuit kernel namespaces ui.gadgets.grids ui.gestures assocs.lib vars rewrite-closures boids accessors - math.geometry.rect ; + math.geometry.rect + newfx ; IN: boids.ui @@ -145,20 +146,20 @@ VARS: population-label cohesion-label alignment-label separation-label ; slate> over @center grid-add H{ } clone - T{ key-down f f "1" } C[ drop randomize ] put-at - T{ key-down f f "2" } C[ drop sub-10-boids ] put-at - T{ key-down f f "3" } C[ drop add-10-boids ] put-at + T{ key-down f f "1" } C[ drop randomize ] is + T{ key-down f f "2" } C[ drop sub-10-boids ] is + T{ key-down f f "3" } C[ drop add-10-boids ] is - T{ key-down f f "q" } C[ drop inc-cohesion-weight ] put-at - T{ key-down f f "a" } C[ drop dec-cohesion-weight ] put-at + T{ key-down f f "q" } C[ drop inc-cohesion-weight ] is + T{ key-down f f "a" } C[ drop dec-cohesion-weight ] is - T{ key-down f f "w" } C[ drop inc-alignment-weight ] put-at - T{ key-down f f "s" } C[ drop dec-alignment-weight ] put-at + T{ key-down f f "w" } C[ drop inc-alignment-weight ] is + T{ key-down f f "s" } C[ drop dec-alignment-weight ] is - T{ key-down f f "e" } C[ drop inc-separation-weight ] put-at - T{ key-down f f "d" } C[ drop dec-separation-weight ] put-at + T{ key-down f f "e" } C[ drop inc-separation-weight ] is + T{ key-down f f "d" } C[ drop dec-separation-weight ] is - T{ key-down f f "ESC" } C[ drop toggle-loop ] put-at + T{ key-down f f "ESC" } C[ drop toggle-loop ] is tuck set-gadget-delegate "Boids" open-window ; : boids-window ( -- ) [ [ boids-window* ] with-scope ] with-ui ; From 44c2b9823de331a9ab3e97cf63704693d0108904 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sat, 12 Jul 2008 15:49:14 -0500 Subject: [PATCH 02/10] assocs.lib: remove old code --- extra/assocs/lib/lib.factor | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/extra/assocs/lib/lib.factor b/extra/assocs/lib/lib.factor index 14632df771..5036a13d78 100755 --- a/extra/assocs/lib/lib.factor +++ b/extra/assocs/lib/lib.factor @@ -1,13 +1,8 @@ USING: arrays assocs kernel vectors sequences namespaces -random math.parser math fry ; + random math.parser math fry ; + IN: assocs.lib -: ref-at ( table key -- value ) swap at ; - -: put-at* ( table key value -- ) swap rot set-at ; - -: put-at ( table key value -- table ) swap pick set-at ; - : set-assoc-stack ( value key seq -- ) dupd [ key? ] with find-last nip set-at ; From 2374b4293d0c35cad3137a5ac086f781fd5ae2ca Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sat, 12 Jul 2008 15:53:20 -0500 Subject: [PATCH 03/10] automata: no need for >array when using --- extra/automata/automata.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/automata/automata.factor b/extra/automata/automata.factor index a70eaa063d..979a733692 100644 --- a/extra/automata/automata.factor +++ b/extra/automata/automata.factor @@ -32,7 +32,7 @@ dup >rule-number rule-values rule-keys [ rule> set-at ] 2each ; ! step-wrapped-line ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: pattern>state ( {_a_b_c_} -- state ) >array rule> at ; +: pattern>state ( {_a_b_c_} -- state ) rule> at ; : cap-line ( line -- 0-line-0 ) { 0 } prepend { 0 } append ; From 5decac30d2861c4649c8c08ca131cd9c32f206ea Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sat, 12 Jul 2008 16:46:50 -0500 Subject: [PATCH 04/10] automata.ui: new automata-window* --- extra/automata/ui/ui.factor | 65 +++++++++++++++++++++++++------------ 1 file changed, 44 insertions(+), 21 deletions(-) diff --git a/extra/automata/ui/ui.factor b/extra/automata/ui/ui.factor index cfec6597c2..5678a6f06b 100644 --- a/extra/automata/ui/ui.factor +++ b/extra/automata/ui/ui.factor @@ -14,13 +14,25 @@ USING: kernel namespaces math quotations arrays hashtables sequences threads ui.gadgets.packs ui.gadgets.grids ui.gadgets.theme + accessors + qualified namespaces.lib assocs.lib vars - rewrite-closures automata math.geometry.rect ; + rewrite-closures automata math.geometry.rect newfx ; IN: automata.ui ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +QUALIFIED: ui.gadgets +QUALIFIED: ui.gadgets.grids + +: add-gadget ( parent child -- parent ) over ui.gadgets:add-gadget ; + +: grid-add ( grid child i j -- grid ) + >r >r dupd swap r> r> ui.gadgets.grids:grid-add ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + : draw-point ( y x value -- ) 1 = [ swap glVertex2i ] [ 2drop ] if ; : draw-line ( y line -- ) 0 swap [ >r 2dup r> draw-point 1+ ] each 2drop ; @@ -57,29 +69,40 @@ slate> relayout-1 ; DEFER: automata-window -: automata-window* ( -- ) init-rule set-interesting +: automata-window* ( -- ) + init-rule + set-interesting -{ -[ "1 - Center" [ start-center ] view-button ] -[ "2 - Random" [ start-random ] view-button ] -[ "3 - Continue" [ run-rule ] view-button ] -[ "5 - Random Rule" [ random-rule ] view-button ] -[ "n - New" [ automata-window ] view-button ] -} make* -[ [ gadget, ] curry ] map concat ! Hack -make-shelf over @top grid-add + -[ display ] closed-quot { 400 400 } over set-slate-dim dup >slate -over @center grid-add + -{ -{ T{ key-down f f "1" } [ [ start-center ] view-action ] } -{ T{ key-down f f "2" } [ [ start-random ] view-action ] } -{ T{ key-down f f "3" } [ [ run-rule ] view-action ] } -{ T{ key-down f f "5" } [ [ random-rule ] view-action ] } -{ T{ key-down f f "n" } [ [ automata-window ] view-action ] } -} [ make* ] map >hashtable tuck set-gadget-delegate -"Automata" open-window ; + "1 - Center" [ start-center ] view-button add-gadget + "2 - Random" [ start-random ] view-button add-gadget + "3 - Continue" [ run-rule ] view-button add-gadget + "5 - Random Rule" [ random-rule ] view-button add-gadget + "n - New" [ automata-window ] view-button add-gadget + + @top grid-add + + C[ display ] + { 400 400 } >>dim + dup >slate + + @center grid-add + + H{ } + T{ key-down f f "1" } [ start-center ] view-action is + T{ key-down f f "2" } [ start-random ] view-action is + T{ key-down f f "3" } [ run-rule ] view-action is + T{ key-down f f "5" } [ random-rule ] view-action is + T{ key-down f f "n" } [ automata-window ] view-action is + + + + tuck set-gadget-delegate + + "Automata" open-window ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From e16aa9ead3c2873e3def98f8904d0f5f8238af18 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sat, 12 Jul 2008 17:45:57 -0500 Subject: [PATCH 05/10] ui.gadgets: update parent accessors --- extra/ui/gadgets/gadgets.factor | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/extra/ui/gadgets/gadgets.factor b/extra/ui/gadgets/gadgets.factor index a274dc2392..fcb6c765a3 100755 --- a/extra/ui/gadgets/gadgets.factor +++ b/extra/ui/gadgets/gadgets.factor @@ -12,10 +12,10 @@ SYMBOL: ui-notify-flag : notify-ui-thread ( -- ) ui-notify-flag get-global raise-flag ; TUPLE: gadget < rect -pref-dim parent children orientation focus -visible? root? clipped? layout-state graft-state graft-node -interior boundary -model ; + pref-dim parent children orientation focus + visible? root? clipped? layout-state graft-state graft-node + interior boundary + model ; M: gadget equal? 2drop f ; @@ -58,7 +58,7 @@ M: gadget model-changed 2drop ; 2drop { 0 0 } ] [ over rect-loc >r - >r gadget-parent r> relative-loc + >r parent>> r> relative-loc r> v+ ] if ; @@ -150,7 +150,7 @@ DEFER: relayout \ invalidate* over set-gadget-layout-state dup forget-pref-dim dup gadget-root? - [ layout-later ] [ gadget-parent [ relayout ] when* ] if ; + [ layout-later ] [ parent>> [ relayout ] when* ] if ; : relayout ( gadget -- ) dup gadget-layout-state \ invalidate* eq? @@ -255,7 +255,7 @@ M: gadget ungraft* drop ; : (unparent) ( gadget -- ) dup ungraft dup forget-pref-dim - f swap set-gadget-parent ; + f swap (>>parent) ; : unfocus-gadget ( child gadget -- ) tuck gadget-focus eq? @@ -270,7 +270,7 @@ SYMBOL: in-layout? : unparent ( gadget -- ) not-in-layout [ - dup gadget-parent dup [ + dup parent>> dup [ over (unparent) [ unfocus-gadget ] 2keep [ gadget-children delete ] keep @@ -294,7 +294,7 @@ SYMBOL: in-layout? : (add-gadget) ( gadget box -- ) over unparent - dup pick set-gadget-parent + dup pick (>>parent) [ ((add-gadget)) ] 2keep gadget-graft-state second [ graft ] [ drop ] if ; @@ -307,7 +307,7 @@ SYMBOL: in-layout? swap [ over (add-gadget) ] each relayout ; : parents ( gadget -- seq ) - [ gadget-parent ] follow ; + [ parent>> ] follow ; : each-parent ( gadget quot -- ? ) >r parents r> all? ; inline @@ -319,7 +319,7 @@ SYMBOL: in-layout? parents { 0 0 } [ rect-loc v+ ] reduce ; : (screen-rect) ( gadget -- loc ext ) - dup gadget-parent [ + dup parent>> [ >r rect-extent r> (screen-rect) >r tuck v+ r> vmin >r v+ r> ] [ @@ -333,7 +333,7 @@ SYMBOL: in-layout? { { [ 2dup eq? ] [ 2drop t ] } { [ dup not ] [ 2drop f ] } - [ gadget-parent child? ] + [ parent>> child? ] } cond ; GENERIC: focusable-child* ( gadget -- child/t ) @@ -346,7 +346,7 @@ M: gadget focusable-child* drop t ; GENERIC: request-focus-on ( child gadget -- ) -M: gadget request-focus-on gadget-parent request-focus-on ; +M: gadget request-focus-on parent>> request-focus-on ; M: f request-focus-on 2drop ; @@ -371,7 +371,7 @@ M: f request-focus-on 2drop ; ! Deprecated : set-gadget-delegate ( gadget tuple -- ) over [ - dup pick [ set-gadget-parent ] with each-child + dup pick [ (>>parent) ] with each-child ] when set-delegate ; : construct-gadget ( class -- tuple ) From a4678cc758d0813e4502badedaad9a20755230f1 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sat, 12 Jul 2008 17:48:08 -0500 Subject: [PATCH 06/10] ui.gadgets: update children accessors --- extra/ui/gadgets/gadgets.factor | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/extra/ui/gadgets/gadgets.factor b/extra/ui/gadgets/gadgets.factor index fcb6c765a3..62d01d844b 100755 --- a/extra/ui/gadgets/gadgets.factor +++ b/extra/ui/gadgets/gadgets.factor @@ -23,9 +23,9 @@ M: gadget hashcode* drop gadget hashcode* ; 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 @@ -68,7 +68,7 @@ M: gadget user-input* 2drop t ; 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 ) 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 ; : each-child ( gadget quot -- ) - >r gadget-children r> each ; inline + >r children>> r> each ; inline ! Selection protocol GENERIC: gadget-selection? ( gadget -- ? ) @@ -124,7 +124,7 @@ M: gadget gadget-text-separator [ dup % ] [ gadget-text* ] interleave drop ; M: gadget gadget-text* - dup gadget-children swap gadget-seq-text ; + dup children>> swap gadget-seq-text ; M: array gadget-text* [ gadget-text* ] each ; @@ -273,7 +273,7 @@ SYMBOL: in-layout? dup parent>> dup [ over (unparent) [ unfocus-gadget ] 2keep - [ gadget-children delete ] keep + [ children>> delete ] keep relayout ] [ 2drop @@ -283,14 +283,14 @@ SYMBOL: in-layout? : (clear-gadget) ( gadget -- ) dup [ (unparent) ] each-child f over set-gadget-focus - f swap set-gadget-children ; + f swap (>>children) ; : clear-gadget ( gadget -- ) not-in-layout dup (clear-gadget) relayout ; : ((add-gadget)) ( gadget box -- ) - [ gadget-children ?push ] keep set-gadget-children ; + [ children>> ?push ] keep (>>children) ; : (add-gadget) ( gadget box -- ) over unparent From 33da43aa907b7d392bab6551d31137b552dd8010 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sat, 12 Jul 2008 17:54:57 -0500 Subject: [PATCH 07/10] ui.gadgets: more accessor updates --- extra/ui/gadgets/gadgets.factor | 46 ++++++++++++++++----------------- 1 file changed, 23 insertions(+), 23 deletions(-) diff --git a/extra/ui/gadgets/gadgets.factor b/extra/ui/gadgets/gadgets.factor index 62d01d844b..6f49791164 100755 --- a/extra/ui/gadgets/gadgets.factor +++ b/extra/ui/gadgets/gadgets.factor @@ -37,7 +37,7 @@ M: gadget model-changed 2drop ; gadget new-gadget ; : activate-control ( gadget -- ) - dup gadget-model dup [ + dup model>> dup [ 2dup add-connection swap model-changed ] [ @@ -45,13 +45,13 @@ M: gadget model-changed 2drop ; ] if ; : deactivate-control ( gadget -- ) - dup gadget-model dup [ 2dup remove-connection ] when 2drop ; + dup model>> dup [ 2dup remove-connection ] when 2drop ; : control-value ( control -- value ) - gadget-model model-value ; + model>> model-value ; : set-control-value ( value control -- ) - gadget-model set-model ; + model>> set-model ; : relative-loc ( fromgadget togadget -- loc ) 2dup eq? [ @@ -83,7 +83,7 @@ M: gadget children-on nip children>> ; r> ; : inside? ( bounds gadget -- ? ) - dup gadget-visible? [ intersects? ] [ 2drop f ] if ; + dup visible?>> [ intersects? ] [ 2drop f ] if ; : (pick-up) ( point gadget -- gadget ) dupd children-on [ inside? ] with find-last nip ; @@ -97,7 +97,7 @@ M: gadget children-on nip children>> ; : dim-sum ( seq -- dim ) { 0 0 } [ v+ ] reduce ; : orient ( gadget seq1 seq2 -- seq ) - >r >r gadget-orientation r> r> [ pick set-axis ] 2map nip ; + >r >r orientation>> r> r> [ pick set-axis ] 2map nip ; : each-child ( gadget quot -- ) >r children>> r> each ; inline @@ -117,7 +117,7 @@ GENERIC: gadget-text* ( gadget -- ) GENERIC: gadget-text-separator ( gadget -- str ) M: gadget gadget-text-separator - gadget-orientation { 0 1 } = "\n" "" ? ; + orientation>> { 0 1 } = "\n" "" ? ; : gadget-seq-text ( seq gadget -- ) gadget-text-separator swap @@ -132,9 +132,9 @@ M: array gadget-text* : gadget-text ( gadget -- string ) [ gadget-text* ] "" make ; : invalidate ( gadget -- ) - \ invalidate swap set-gadget-layout-state ; + \ invalidate swap (>>layout-state) ; -: forget-pref-dim ( gadget -- ) f swap set-gadget-pref-dim ; +: forget-pref-dim ( gadget -- ) f swap (>>pref-dim) ; : layout-queue ( -- queue ) \ layout-queue get ; @@ -147,22 +147,22 @@ M: array gadget-text* DEFER: relayout : invalidate* ( gadget -- ) - \ invalidate* over set-gadget-layout-state + \ invalidate* over (>>layout-state) dup forget-pref-dim dup gadget-root? [ layout-later ] [ parent>> [ relayout ] when* ] if ; : relayout ( gadget -- ) - dup gadget-layout-state \ invalidate* eq? + dup layout-state>> \ invalidate* eq? [ drop ] [ invalidate* ] if ; : relayout-1 ( gadget -- ) - dup gadget-layout-state + dup layout-state>> [ drop ] [ dup invalidate layout-later ] if ; -: show-gadget ( gadget -- ) t swap set-gadget-visible? ; +: show-gadget ( gadget -- ) t swap (>>visible?) ; -: hide-gadget ( gadget -- ) f swap set-gadget-visible? ; +: hide-gadget ( gadget -- ) f swap (>>visible?) ; : (set-rect-dim) ( dim gadget quot -- ) >r 2dup rect-dim = @@ -178,11 +178,11 @@ DEFER: relayout GENERIC: pref-dim* ( gadget -- dim ) : ?set-gadget-pref-dim ( dim gadget -- ) - dup gadget-layout-state - [ 2drop ] [ set-gadget-pref-dim ] if ; + dup layout-state>> + [ 2drop ] [ (>>pref-dim) ] if ; : pref-dim ( gadget -- dim ) - dup gadget-pref-dim [ ] [ + dup pref-dim>> [ ] [ [ pref-dim* dup ] keep ?set-gadget-pref-dim ] ?if ; @@ -196,10 +196,10 @@ M: gadget layout* drop ; : prefer ( gadget -- ) dup pref-dim swap set-layout-dim ; -: validate ( gadget -- ) f swap set-gadget-layout-state ; +: validate ( gadget -- ) f swap (>>layout-state) ; : layout ( gadget -- ) - dup gadget-layout-state [ + dup layout-state>> [ dup validate dup layout* dup [ layout ] each-child @@ -258,8 +258,8 @@ M: gadget ungraft* drop ; f swap (>>parent) ; : unfocus-gadget ( child gadget -- ) - tuck gadget-focus eq? - [ f swap set-gadget-focus ] [ drop ] if ; + tuck focus>> eq? + [ f swap (>>focus) ] [ drop ] if ; SYMBOL: in-layout? @@ -282,7 +282,7 @@ SYMBOL: in-layout? : (clear-gadget) ( gadget -- ) dup [ (unparent) ] each-child - f over set-gadget-focus + f over (>>focus) f swap (>>children) ; : clear-gadget ( gadget -- ) @@ -354,7 +354,7 @@ M: f request-focus-on 2drop ; [ focusable-child ] keep request-focus-on ; : focus-path ( world -- seq ) - [ gadget-focus ] follow ; + [ focus>> ] follow ; : gadget, ( gadget -- ) gadget get add-gadget ; From 80783019c2773a0416d304baac7b4ce32b11a3cd Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sat, 12 Jul 2008 17:57:57 -0500 Subject: [PATCH 08/10] ui.gadgets: cleaner fast-children-on --- extra/ui/gadgets/gadgets.factor | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/extra/ui/gadgets/gadgets.factor b/extra/ui/gadgets/gadgets.factor index 6f49791164..f5e1f35081 100755 --- a/extra/ui/gadgets/gadgets.factor +++ b/extra/ui/gadgets/gadgets.factor @@ -74,13 +74,9 @@ M: gadget children-on nip children>> ; swapd [ rect-loc v- over v. 0 <=> ] binsearch nip ; : fast-children-on ( rect axis children -- from to ) - 3dup - >r >r dup rect-loc swap rect-dim v+ - r> r> (fast-children-on) ?1+ - >r - >r >r rect-loc - r> r> (fast-children-on) 0 or - r> ; + [ >r >r rect-loc r> r> (fast-children-on) 0 or ] + [ >r >r dup rect-loc swap rect-dim v+ r> r> (fast-children-on) ?1+ ] + 3bi ; : inside? ( bounds gadget -- ? ) dup visible?>> [ intersects? ] [ 2drop f ] if ; From 49f58ce15b30a06c5cc6eda1a67f40bdd2b1fed5 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sat, 12 Jul 2008 17:58:44 -0500 Subject: [PATCH 09/10] ui.gadgets: proper indentation --- extra/ui/gadgets/gadgets.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/ui/gadgets/gadgets.factor b/extra/ui/gadgets/gadgets.factor index f5e1f35081..59041c6115 100755 --- a/extra/ui/gadgets/gadgets.factor +++ b/extra/ui/gadgets/gadgets.factor @@ -74,9 +74,9 @@ M: gadget children-on nip children>> ; swapd [ rect-loc v- over v. 0 <=> ] binsearch nip ; : fast-children-on ( rect axis children -- from to ) - [ >r >r rect-loc r> r> (fast-children-on) 0 or ] - [ >r >r dup rect-loc swap rect-dim v+ r> r> (fast-children-on) ?1+ ] - 3bi ; + [ >r >r rect-loc r> r> (fast-children-on) 0 or ] + [ >r >r dup rect-loc swap rect-dim v+ r> r> (fast-children-on) ?1+ ] + 3bi ; : inside? ( bounds gadget -- ? ) dup visible?>> [ intersects? ] [ 2drop f ] if ; From 32ca39ce8580590003da788d5f35c49d8d0d0e9e Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sat, 12 Jul 2008 18:02:32 -0500 Subject: [PATCH 10/10] ui.gadgets: more accessors updates --- extra/ui/gadgets/gadgets.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/ui/gadgets/gadgets.factor b/extra/ui/gadgets/gadgets.factor index 59041c6115..3fc185a10e 100755 --- a/extra/ui/gadgets/gadgets.factor +++ b/extra/ui/gadgets/gadgets.factor @@ -219,7 +219,7 @@ M: gadget layout* drop ; { t f } (queue-graft) ; : graft-later ( gadget -- ) - dup gadget-graft-state { + dup graft-state>> { { { f t } [ drop ] } { { t t } [ drop ] } { { t f } [ unqueue-graft ] } @@ -227,7 +227,7 @@ M: gadget layout* drop ; } case ; : ungraft-later ( gadget -- ) - dup gadget-graft-state { + dup graft-state>> { { { f f } [ drop ] } { { t f } [ drop ] } { { f t } [ unqueue-graft ] } @@ -292,7 +292,7 @@ SYMBOL: in-layout? over unparent dup pick (>>parent) [ ((add-gadget)) ] 2keep - gadget-graft-state second [ graft ] [ drop ] if ; + graft-state>> second [ graft ] [ drop ] if ; : add-gadget ( gadget parent -- ) not-in-layout