Factor out grid gadget from frame

TODO.FACTOR.txt

@@ -61,7 +61,6 @@
 - help search
 - automatically update help graph when adding/removing articles/words
 - document conventions
-- new turtle graphics tutorial
 
 + ui:
 

library/bootstrap/boot-stage1.factor

@@ -174,6 +174,7 @@ vectors words ;
         "/library/ui/gadgets.factor"
         "/library/ui/layouts.factor"
         "/library/ui/hierarchy.factor"
+        "/library/ui/gadgets/grids.factor"
         "/library/ui/gadgets/frames.factor"
         "/library/ui/world.factor"
         "/library/ui/paint.factor"

library/ui/gadgets/frames.factor

@@ -1,14 +1,13 @@
-! Copyright (C) 2005 Slava Pestov.
+! Copyright (C) 2005, 2006 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
+! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets
 USING: arrays generic kernel math namespaces sequences words ;
 
 ! A frame arranges gadgets in a 3x3 grid, where the center
 ! gadgets gets left-over space.
-TUPLE: frame grid ;
+TUPLE: frame ;
 
-: <frame-grid>
+: <frame-grid> 3 [ drop 3 f <array> ] map ;
-    { { f f f } { f f f } { f f f } } [ clone ] map ;
 
 : @center 1 1 ;
 : @left 0 1 ;
@@ -22,53 +21,10 @@ TUPLE: frame grid ;
 : @bottom-right 2 2 ;
 
 C: frame ( -- frame )
-    dup delegate>gadget <frame-grid> over set-frame-grid ;
+    <frame-grid> <grid> over set-gadget-delegate ;
 
 : delegate>frame ( tuple -- ) <frame> swap set-delegate ;
 
-: frame-child ( frame i j -- gadget ) rot frame-grid nth nth ;
-
-: frame-add ( gadget frame i j -- )
-    #! Add a gadget to a frame. Use this with frames instead
-    #! of add-gadget.
-    >r >r over [ over add-gadget ] when* r> r>
-    3dup frame-child unparent rot frame-grid nth set-nth ;
-
-: frame-remove ( frame i j -- )
-    #! Remove a gadget from a frame. Use this with frames
-    #! instead of unparent.
-    >r >r >r f r> r> r> frame-add ;
-
-: reduce-grid ( grid -- seq )
-    [ max-dim ] map ;
-
-: frame-pref-dim ( grid -- dim )
-    reduce-grid { 0 0 0 } [ v+ ] reduce ;
-
-: pref-dim-grid ( grid -- grid )
-    [ [ [ pref-dim ] [ { 0 0 0 } ] if* ] map ] map ;
-
-M: frame pref-dim* ( frame -- dim )
-    frame-grid pref-dim-grid
-    dup flip frame-pref-dim first
-    swap frame-pref-dim second
-    0 3array ;
-
-: frame-layout ( horiz vert -- grid )
-    [ swap [ swap 0 3array ] map-with ] map-with ;
-
-: do-grid ( dim-grid gadget-grid quot -- )
-    -rot [
-        [ dup [ pick call ] [ 2drop ] if ] 2each
-    ] 2each drop ; inline
-
-: position-grid ( gadgets horiz vert -- )
-    [ 0 [ + ] accumulate ] 2apply
-    frame-layout swap [ set-rect-loc ] do-grid ;
-
-: resize-grid ( gadgets horiz vert -- )
-    frame-layout swap [ set-gadget-dim ] do-grid ;
-
 : (fill-center) ( vec n -- )
     over first pick third + - 0 max 1 rot set-nth ;
 
@@ -76,12 +32,9 @@ M: frame pref-dim* ( frame -- dim )
     tuck second (fill-center) first (fill-center) ;
 
 M: frame layout* ( frame -- dim )
-    [
+    dup grid-children swap rect-dim
-        frame-grid dup pref-dim-grid
+    >r compute-grid 2dup r>
-        dup flip reduce-grid [ first ] map
+    fill-center grid-layout ;
-        swap reduce-grid [ second ] map
-        2dup
-    ] keep rect-dim fill-center 3dup position-grid resize-grid ;
 
 : frame-add-spec ( { quot setter loc } -- )
     first3 >r >r call

library/ui/gadgets/grids.factor

@@ -0,0 +1,67 @@
+! Copyright (C) 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: gadgets
+USING: arrays gadgets-panes kernel math sequences ;
+
+TUPLE: grid children ;
+
+: collapse-grid concat [ ] subset ;
+
+: set-grid-children* ( children grid -- )
+    [ set-grid-children ] 2keep
+    >r collapse-grid r> add-gadgets ;
+
+C: grid ( children -- grid )
+    dup delegate>gadget [ set-grid-children* ] keep ;
+
+: grid-child ( grid i j -- gadget ) rot grid-children nth nth ;
+
+: grid-add ( gadget grid i j -- )
+    >r >r over [ over add-gadget ] when* r> r>
+    3dup grid-child unparent rot grid-children nth set-nth ;
+
+: grid-remove ( grid i j -- )
+    >r >r >r f r> r> r> grid-add ;
+
+: reduce-grid [ max-dim ] map ;
+
+: grid-pref-dim ( dims -- dim )
+    reduce-grid { 0 0 0 } [ v+ ] reduce ;
+
+: pref-dim-grid ( children -- dims )
+    [ [ [ pref-dim ] [ { 0 0 0 } ] if* ] map ] map ;
+
+M: grid pref-dim* ( frame -- dim )
+    grid-children pref-dim-grid
+    dup flip grid-pref-dim first
+    swap grid-pref-dim second
+    0 3array ;
+
+: pair-up ( horiz vert -- dims )
+    [ swap [ swap 0 3array ] map-with ] map-with ;
+
+: do-grid ( children dims quot -- )
+    -rot swap [
+        [ dup [ pick call ] [ 2drop ] if ] 2each
+    ] 2each drop ; inline
+
+: position-grid ( children horiz vert -- )
+    [ 0 [ + ] accumulate ] 2apply
+    pair-up [ set-rect-loc ] do-grid ;
+
+: resize-grid ( children horiz vert -- )
+    pair-up [ set-gadget-dim ] do-grid ;
+
+: grid-layout ( children horiz vert -- )
+    3dup position-grid resize-grid ;
+
+: compute-grid ( children -- horiz vert )
+    pref-dim-grid
+    dup flip reduce-grid [ first ] map
+    swap reduce-grid [ second ] map ;
+
+M: grid layout* ( frame -- dim )
+    grid-children dup compute-grid grid-layout ;
+
+: pane-grid ( quot grid -- gadget )
+    [ [ swap make-pane ] map-with ] map-with <grid> ;

library/ui/layouts.factor

@@ -34,7 +34,6 @@ IN: gadgets
     dup gadget-relayout?
     [ drop ] [ dup invalidate add-invalid ] if ;
 
-
 : show-gadget t over set-gadget-visible? relayout-1 ;
 
 : hide-gadget f over set-gadget-visible? relayout-1 ;