From 80a38f8990d473fa5bc63709ce44357c8df0413b Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Sat, 12 Jul 2008 15:48:20 -0500
Subject: [PATCH 01/11] 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
<handler> 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 <dharmatech@finkelstein.stackeffects.info>
Date: Sat, 12 Jul 2008 15:49:14 -0500
Subject: [PATCH 02/11] 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 <dharmatech@finkelstein.stackeffects.info>
Date: Sat, 12 Jul 2008 15:53:20 -0500
Subject: [PATCH 03/11] automata: no need for >array when using <clumps>
---
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 <dharmatech@finkelstein.stackeffects.info>
Date: Sat, 12 Jul 2008 16:46:50 -0500
Subject: [PATCH 04/11] 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 <frame>
+: 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
+ <frame>
-[ display ] closed-quot <slate> { 400 400 } over set-slate-dim dup >slate
-over @center grid-add
+ <shelf>
-{
-{ 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 <handler> 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 ] <slate>
+ { 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
+
+ <handler>
+
+ tuck set-gadget-delegate
+
+ "Automata" open-window ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
From e16aa9ead3c2873e3def98f8904d0f5f8238af18 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Sat, 12 Jul 2008 17:45:57 -0500
Subject: [PATCH 05/11] 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 <dharmatech@finkelstein.stackeffects.info>
Date: Sat, 12 Jul 2008 17:48:08 -0500
Subject: [PATCH 06/11] 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 <dharmatech@finkelstein.stackeffects.info>
Date: Sat, 12 Jul 2008 17:54:57 -0500
Subject: [PATCH 07/11] 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 <dharmatech@finkelstein.stackeffects.info>
Date: Sat, 12 Jul 2008 17:57:57 -0500
Subject: [PATCH 08/11] 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 <dharmatech@finkelstein.stackeffects.info>
Date: Sat, 12 Jul 2008 17:58:44 -0500
Subject: [PATCH 09/11] 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 <dharmatech@finkelstein.stackeffects.info>
Date: Sat, 12 Jul 2008 18:02:32 -0500
Subject: [PATCH 10/11] 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
From eda828169465529cb2bb05b21dbc1d237ad8470d Mon Sep 17 00:00:00 2001
From: erg <erg@k.internal.stack-effects.com>
Date: Sat, 12 Jul 2008 20:56:44 -0500
Subject: [PATCH 11/11] document conjoin
---
core/sets/sets-docs.factor | 12 ++++++++++++
1 file changed, 12 insertions(+)
diff --git a/core/sets/sets-docs.factor b/core/sets/sets-docs.factor
index 205d4d34bf..57d62f6480 100644
--- a/core/sets/sets-docs.factor
+++ b/core/sets/sets-docs.factor
@@ -38,6 +38,18 @@ HELP: adjoin
}
{ $side-effects "seq" } ;
+HELP: conjoin
+{ $values { "elt" object } { "assoc" "an assoc" } }
+{ $description "Stores a key/value pair, both equal to " { $snippet "elt" } ", into the assoc." }
+{ $examples
+ { $example
+ "USING: kernel prettyprint sets ;"
+ "H{ } clone 1 over conjoin ."
+ "H{ { 1 1 } }"
+ }
+}
+{ $side-effects "assoc" } ;
+
HELP: unique
{ $values { "seq" "a sequence" } { "assoc" "an assoc" } }
{ $description "Outputs a new assoc where the keys and values are equal." }