ui.gadgets: make fast-children-on more flexible and take a quotation instead of alway...

diff --git a/basis/ui/gadgets/gadgets.factor b/basis/ui/gadgets/gadgets.factor
index 8eb11a7753c7ca8e802de6246bdd01c301b4e199..7e47bf627ba83b7652dab0a3cecddb772e5ffc20 100644 (file)
--- a/basis/ui/gadgets/gadgets.factor
+++ b/basis/ui/gadgets/gadgets.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2009 Slava Pestov.
+! Copyright (C) 2005, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays hashtables kernel math namespaces
 make sequences quotations math.vectors combinators sorting
@@ -62,18 +62,19 @@ M: gadget children-on nip children>> ;
 
 <PRIVATE
 
-: ((fast-children-on)) ( gadget dim axis -- <=> )
-    [ swap loc>> v- ] dip v. 0 <=> ;
-
-:: (fast-children-on) ( dim axis children -- i )
-    children [ dim axis ((fast-children-on)) ] search drop ;
+:: (fast-children-on) ( point axis children quot -- i )
+    children [
+        [ point ] dip
+        quot call( value -- loc ) v-
+        axis v. 0 <=>
+    ] search drop ; inline
 
 PRIVATE>
 
-: fast-children-on ( rect axis children -- from to )
-    [ [ loc>> ] 2dip (fast-children-on) 0 or ]
-    [ [ rect-bounds v+ ] 2dip (fast-children-on) ?1+ ]
-    3bi ;
+:: fast-children-on ( rect axis children quot -- slice )
+    rect loc>> axis children quot (fast-children-on) 0 or
+    rect rect-bounds v+ axis children quot (fast-children-on) ?1+
+    children <slice> ; inline
 
 M: gadget contains-rect? ( bounds gadget -- ? )
     dup visible?>> [ call-next-method ] [ 2drop f ] if ;

diff --git a/basis/ui/gadgets/grids/grids-tests.factor b/basis/ui/gadgets/grids/grids-tests.factor
index b83f1a700300d0b85962a185f8fc1b3644d670af..3dc0e6b862387aaa1dbe45e55c5b1bcdf86eef70 100644 (file)
--- a/basis/ui/gadgets/grids/grids-tests.factor
+++ b/basis/ui/gadgets/grids/grids-tests.factor
@@ -1,12 +1,14 @@
 USING: ui.gadgets ui.gadgets.grids tools.test kernel arrays
 namespaces math.rectangles accessors ui.gadgets.grids.private
-ui.gadgets.debug sequences ;
+ui.gadgets.debug sequences classes ;
 IN: ui.gadgets.grids.tests
 
 [ { 0 0 } ] [ { } <grid> pref-dim ] unit-test
 
 : 100x100 ( -- gadget ) <gadget> { 100 100 } >>dim ;
 
+: 200x200 ( -- gadget ) <gadget> { 200 200 } >>dim ;
+
 [ { 100 100 } ] [
     100x100
     1array 1array <grid> pref-dim
@@ -81,4 +83,22 @@ IN: ui.gadgets.grids.tests
     "g" get
     dup layout
     children>> [ loc>> ] map
-] unit-test
\ No newline at end of file
+] unit-test
+
+! children-on logic was insufficient
+[ ] [
+    100x100 dup "a" set 200x200 2array
+    100x100 dup "b" set 200x200 2array 2array <grid> f >>fill? "g" set
+] unit-test
+
+[ ] [ "g" get prefer ] unit-test
+[ ] [ "g" get layout ] unit-test
+
+[ { 0 50 } ] [ "a" get loc>> ] unit-test
+[ { 0 250 } ] [ "b" get loc>> ] unit-test
+
+[ gadget { 200 200 } ]
+[ { 120 20 } "g" get pick-up [ class ] [ dim>> ] bi ] unit-test
+
+[ gadget { 200 200 } ]
+[ { 120 220 } "g" get pick-up [ class ] [ dim>> ] bi ] unit-test
\ No newline at end of file

diff --git a/basis/ui/gadgets/grids/grids.factor b/basis/ui/gadgets/grids/grids.factor
index 9b5b737406a140bf4b73d6f2285a73a7412666a1..2e964b48b693a7b1b1cb40d81e26c1938e1993c1 100644 (file)
--- a/basis/ui/gadgets/grids/grids.factor
+++ b/basis/ui/gadgets/grids/grids.factor
@@ -1,7 +1,8 @@
-! Copyright (C) 2006, 2009 Slava Pestov.
+! Copyright (C) 2006, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel math math.order math.matrices namespaces make sequences words io
-math.vectors ui.gadgets ui.baseline-alignment columns accessors strings.tables
+USING: arrays kernel math math.order math.matrices namespaces
+make sequences words io math.vectors ui.gadgets
+ui.baseline-alignment columns accessors strings.tables
 math.rectangles fry ;
 IN: ui.gadgets.grids
 
@@ -115,8 +116,10 @@ M: grid layout* [ grid>> ] [ <grid-layout> ] bi grid-layout ;
 
 M: grid children-on ( rect gadget -- seq )
     dup children>> empty? [ 2drop f ] [
-        [ { 0 1 } ] dip grid>>
-        [ 0 <column> fast-children-on ] [ <slice> concat ] bi
+        [ { 0 1 } ] dip
+        [ grid>> ] [ dim>> ] bi
+        '[ _ [ loc>> vmin ] reduce ] fast-children-on
+        concat
     ] if ;
 
 M: grid gadget-text*

diff --git a/basis/ui/gadgets/packs/packs.factor b/basis/ui/gadgets/packs/packs.factor
index f47b374aeb30aad2559ff958d63b5bc92ef12866..5f21d74180409e70a3db3b9b94f16a6eae33b281 100644 (file)
--- a/basis/ui/gadgets/packs/packs.factor
+++ b/basis/ui/gadgets/packs/packs.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2009 Slava Pestov.
+! Copyright (C) 2005, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: sequences ui.gadgets ui.baseline-alignment
 ui.baseline-alignment.private kernel math math.functions math.vectors
@@ -100,5 +100,4 @@ M: pack layout*
     dup children>> pref-dims pack-layout ;
 
 M: pack children-on ( rect gadget -- seq )
-    [ orientation>> ] [ children>> ] bi
-    [ fast-children-on ] keep <slice> ;
+    [ orientation>> ] [ children>> ] bi [ loc>> ] fast-children-on ;

diff --git a/basis/ui/gadgets/panes/panes.factor b/basis/ui/gadgets/panes/panes.factor
index 50a609b89765317d95cb6ebc01497e30c52e15b9..8fec7e45ce02511a9156a958cb6d2a1543118f5e 100644 (file)
--- a/basis/ui/gadgets/panes/panes.factor
+++ b/basis/ui/gadgets/panes/panes.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2009 Slava Pestov.
+! Copyright (C) 2005, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays hashtables io kernel namespaces sequences
 strings quotations math opengl combinators memoize math.vectors
@@ -352,7 +352,8 @@ M: paragraph stream-format
 GENERIC: sloppy-pick-up* ( loc gadget -- n )
 
 M: pack sloppy-pick-up* ( loc gadget -- n )
-    [ orientation>> ] [ children>> ] bi (fast-children-on) ;
+    [ orientation>> ] [ children>> ] bi
+    [ loc>> ] (fast-children-on) ;
 
 M: gadget sloppy-pick-up*
     children>> [ contains-point? ] with find-last drop ;