diff --git a/basis/ui/gadgets/gadgets.factor b/basis/ui/gadgets/gadgets.factor index 8eb11a7753..7e47bf627b 100644 --- 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>> ; ) - [ 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 ; 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 b83f1a7003..3dc0e6b862 100644 --- 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 } ] [ { } pref-dim ] unit-test : 100x100 ( -- gadget ) { 100 100 } >>dim ; +: 200x200 ( -- gadget ) { 200 200 } >>dim ; + [ { 100 100 } ] [ 100x100 1array 1array 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 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 9b5b737406..2e964b48b6 100644 --- 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>> ] [ ] bi grid-layout ; M: grid children-on ( rect gadget -- seq ) dup children>> empty? [ 2drop f ] [ - [ { 0 1 } ] dip grid>> - [ 0 fast-children-on ] [ 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 f47b374aeb..5f21d74180 100644 --- 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 ; + [ orientation>> ] [ children>> ] bi [ loc>> ] fast-children-on ; diff --git a/basis/ui/gadgets/panes/panes.factor b/basis/ui/gadgets/panes/panes.factor index 50a609b897..8fec7e45ce 100644 --- 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 ;