From 1b41f853954ace1129892361c8fb8f8efdfd49f0 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 15 Feb 2009 03:59:02 -0600
Subject: [PATCH] ui.gadgets.frames: any size frame now supported, arbitrary
 cell can be fill cell, gap supported

---
 basis/ui/gadgets/frames/frames-docs.factor  | 39 +++-------------
 basis/ui/gadgets/frames/frames-tests.factor | 31 +++++++++++--
 basis/ui/gadgets/frames/frames.factor       | 50 ++++++++++-----------
 basis/ui/gadgets/grids/grids-docs.factor    | 12 ++---
 basis/ui/gadgets/labeled/labeled.factor     | 14 +++++-
 5 files changed, 79 insertions(+), 67 deletions(-)

diff --git a/basis/ui/gadgets/frames/frames-docs.factor b/basis/ui/gadgets/frames/frames-docs.factor
index 52eef11d1c..5ba1512c4b 100644
--- a/basis/ui/gadgets/frames/frames-docs.factor
+++ b/basis/ui/gadgets/frames/frames-docs.factor
@@ -3,42 +3,17 @@ quotations classes.tuple ui.gadgets.grids parser ;
 IN: ui.gadgets.frames
 
 ARTICLE: "ui-frame-layout" "Frame layouts"
-"Frames resemble " { $link "ui-grid-layout" } " except the size of grid is fixed at 3x3, and the center gadget fills up any available space. Because frames inherit from grids, grid layout words can be used to add and remove children."
+"Frames extend " { $link "ui-grid-layout" } " with the ability to give all remaining space to a distinguished filled cell."
+$nl
+"The filled cell's column/row pair is stored in the frame gadget's " { $slot "filled-cell" } " slot. If the actual dimensions of a frame exceed it preferred dimensions, then the fill slot is resized appropriately, together with its row and column."
+$nl
+"Because frames inherit from grids, grid layout words can be used to add and remove children."
 { $subsection frame }
 "Creating empty frames:"
-{ $subsection <frame> }
-"A set of mnemonic words for the positions on a frame's 3x3 grid; these words push values which may be passed to " { $link grid-add } ":"
-{ $subsection @center }
-{ $subsection @left }
-{ $subsection @right }
-{ $subsection @top }
-{ $subsection @bottom }
-{ $subsection @top-left }
-{ $subsection @top-right }
-{ $subsection @bottom-left }
-{ $subsection @bottom-right } ;
-
-<<
-
-: ui-frame-constant
-    { $values { "value" pair } } parsed
-    { $description "Symbolic constant for a common input to " { $link grid-add } "." } parsed ;
-    parsing
-
->>
-
-HELP: @center ui-frame-constant ;
-HELP: @left ui-frame-constant ;
-HELP: @right ui-frame-constant ;
-HELP: @top ui-frame-constant ;
-HELP: @bottom ui-frame-constant ;
-HELP: @top-left ui-frame-constant ;
-HELP: @top-right ui-frame-constant ;
-HELP: @bottom-left ui-frame-constant ;
-HELP: @bottom-right ui-frame-constant ;
+{ $subsection <frame> } ;
 
 HELP: frame
-{ $class-description "A frame is a gadget which lays out its children in a 3x3 grid. If the frame is enlarged past its preferred size, the center gadget fills up available room."
+{ $class-description "A frame is a gadget which lays out its children in a grid, and assigns all remaining space to a distinguished filled cell. The " { $slot "filled-cell" } " slot stores a pair with shape " { $snippet "{ col row }" } "."
 $nl
 "Frames are constructed by calling " { $link <frame> } " and since they inherit from " { $link grid } ", children can be managed with " { $link grid-add } " and " { $link grid-remove } "." } ;
 
diff --git a/basis/ui/gadgets/frames/frames-tests.factor b/basis/ui/gadgets/frames/frames-tests.factor
index 27d511e10a..95e3c6b09a 100644
--- a/basis/ui/gadgets/frames/frames-tests.factor
+++ b/basis/ui/gadgets/frames/frames-tests.factor
@@ -2,12 +2,22 @@ USING: accessors kernel namespaces tools.test ui.gadgets
 ui.gadgets.frames ui.gadgets.grids ui.gadgets.labels ;
 IN: ui.gadgets.frames.tests
 
-[ ] [ <frame> layout ] unit-test
+[ ] [ 3 3 <frame> { 1 1 } >>filled-cell layout ] unit-test
+
+[ { 1000 1000 } ] [
+    1 1 <frame>
+    { 0 0 } >>filled-cell
+    <gadget> dup "c" set { 0 0 } grid-add
+    { 1000 1000 } >>dim
+    layout
+    "c" get dim>>
+] unit-test
 
 [ t ] [
-    <frame>
-        "Hello world" <label> @top grid-add
-        "Hello world" <label> @center grid-add
+    1 2 <frame>
+        { 0 0 } >>filled-cell
+        "Hello world" <label> { 0 0 } grid-add
+        "Hello world" <label> { 0 1 } grid-add
         dup pref-dim "dim1" set
         { 1000 1000 } >>dim
         dup layout*
@@ -15,3 +25,16 @@ IN: ui.gadgets.frames.tests
         drop
     "dim1" get "dim2" get =
 ] unit-test
+
+[ { 5 20 } { 20 20 } ] [
+    2 3 <frame>
+    { 0 1 } >>filled-cell
+    { 5 5 } >>gap
+    <gadget> { 10 10 } >>dim { 0 0 } grid-add
+    <gadget> { 10 10 } >>dim dup "c" set { 0 1 } grid-add
+    <gadget> { 10 20 } >>dim { 0 2 } grid-add
+    <gadget> { 30 10 } >>dim { 1 1 } grid-add
+    { 65 70 } >>dim
+    layout
+    "c" get [ loc>> ] [ dim>> ] bi
+] unit-test
\ No newline at end of file
diff --git a/basis/ui/gadgets/frames/frames.factor b/basis/ui/gadgets/frames/frames.factor
index 549d1de61f..10a2f34c90 100644
--- a/basis/ui/gadgets/frames/frames.factor
+++ b/basis/ui/gadgets/frames/frames.factor
@@ -2,21 +2,11 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays generic kernel math namespaces sequences
 words splitting grouping math.vectors ui.gadgets.grids
-ui.gadgets.grids.private ui.gadgets math.order math.rectangles ;
+ui.gadgets.grids.private ui.gadgets math.order math.rectangles
+fry ;
 IN: ui.gadgets.frames
 
-CONSTANT: @center { 1 1 }
-CONSTANT: @left { 0 1 }
-CONSTANT: @right { 2 1 }
-CONSTANT: @top { 1 0 }
-CONSTANT: @bottom { 1 2 }
-
-CONSTANT: @top-left { 0 0 }
-CONSTANT: @top-right { 2 0 }
-CONSTANT: @bottom-left { 0 2 }
-CONSTANT: @bottom-right { 2 2 }
-
-TUPLE: frame < grid ;
+TUPLE: frame < grid filled-cell ;
 
 <PRIVATE
 
@@ -26,24 +16,34 @@ M: glue pref-dim* drop { 0 0 } ;
 
 : <glue> ( -- glue ) glue new-gadget ;
 
-: <frame-grid> ( -- grid ) 9 [ <glue> ] replicate 3 group ;
+: <frame-grid> ( cols rows -- grid )
+    swap '[ _ [ <glue> ] replicate ] replicate ;
 
-: (fill-center) ( n seq -- )
-    [ [ first ] [ third ] bi + [-] ] keep set-second ;
+: (fill- ( frame grid-layout quot1 quot2 -- pref-dim gap filled-cell dims )
+    [ '[ [ dim>> ] [ gap>> ] [ filled-cell>> ] tri _ tri@ ] dip ] dip call ; inline
 
-: fill-center ( dim grid-layout -- )
-    [ [ first ] [ column-widths>> ] bi* ]
-    [ [ second ] [ row-heights>> ] bi* ] 2bi
-    [ (fill-center) ] 2bi@ ;
+: available-space ( pref-dim gap dims -- avail )
+    length 1+ * [-] ; inline
+
+: -center) ( pref-dim gap filled-cell dims -- )
+    [ nip available-space ] 2keep [ remove-nth sum [-] ] 2keep set-nth ; inline
+
+: (fill-center) ( frame grid-layout quot1 quot2 -- ) (fill- -center) ; inline
+
+: fill-center ( frame grid-layout -- )
+    [ [ first ] [ column-widths>> ] (fill-center) ]
+    [ [ second ] [ row-heights>> ] (fill-center) ] 2bi ;
+
+: <frame-layout> ( frame -- grid-layout )
+    dup <grid-layout> [ fill-center ] keep ;
 
 PRIVATE>
 
 M: frame layout*
-    [ grid>> ] [ dim>> ] [ <grid-layout> ] tri
-    [ fill-center ] keep grid-layout ;
+    [ grid>> ] [ <frame-layout> ] bi grid-layout ;
 
-: new-frame ( class -- frame )
-    <frame-grid> swap new-grid ; inline
+: new-frame ( cols rows class -- frame )
+    [ <frame-grid> ] dip new-grid ; inline
 
-: <frame> ( -- frame )
+: <frame> ( cols rows -- frame )
     frame new-frame ;
\ No newline at end of file
diff --git a/basis/ui/gadgets/grids/grids-docs.factor b/basis/ui/gadgets/grids/grids-docs.factor
index 2d1af445a3..66db44f524 100644
--- a/basis/ui/gadgets/grids/grids-docs.factor
+++ b/basis/ui/gadgets/grids/grids-docs.factor
@@ -25,22 +25,24 @@ $nl
 "The " { $link add-gadget } ", " { $link unparent } " and " { $link clear-gadget } " words should not be used to manage child gadgets of grids." } ;
 
 HELP: <grid>
-{ $values { "children" "a sequence of sequences of gadgets" } { "grid" "a new " { $link grid } } }
+{ $values { "children" "a sequence of sequences of gadgets, column-major" } { "grid" "a new " { $link grid } } }
 { $description "Creates a new " { $link grid } " gadget with the given children." } ;
 
 HELP: grid-child
-{ $values { "grid" grid } { "pair" "a pair with shape " { $snippet "{ i j }" } } { "gadget" gadget } }
-{ $description "Outputs the child gadget at the " { $snippet "i" } "," { $snippet "j" } "th position of the grid." }
+{ $values { "grid" grid } { "pair" "a pair with shape " { $snippet "{ col row }" } } { "gadget" gadget } }
+{ $description "Outputs the child gadget at the specified location." }
 { $errors "Throws an error if the indices are out of bounds." } ;
 
 HELP: grid-add
-{ $values { "grid" grid } { "child" gadget } { "pair" "a pair with shape " { $snippet "{ i j }" } } }
+{ $values { "grid" grid } { "child" gadget } { "pair" "a pair with shape " { $snippet "{ col row }" } } }
 { $description "Adds a child gadget at the specified location." }
+{ $errors "Throws an error if the indices are out of bounds." }
 { $side-effects "grid" } ;
 
 HELP: grid-remove
-{ $values { "grid" grid } { "pair" "a pair with shape " { $snippet "{ i j }" } } }
+{ $values { "grid" grid } { "pair" "a pair with shape " { $snippet "{ col row }" } } }
 { $description "Removes a child gadget from the specified location." }
+{ $errors "Throws an error if the indices are out of bounds." }
 { $side-effects "grid" } ;
 
 ABOUT: "ui-grid-layout"
diff --git a/basis/ui/gadgets/labeled/labeled.factor b/basis/ui/gadgets/labeled/labeled.factor
index 133b7bb519..4aae299ad6 100644
--- a/basis/ui/gadgets/labeled/labeled.factor
+++ b/basis/ui/gadgets/labeled/labeled.factor
@@ -9,6 +9,17 @@ TUPLE: labeled-gadget < frame content ;
 
 <PRIVATE
 
+CONSTANT: @center { 1 1 }
+CONSTANT: @left { 0 1 }
+CONSTANT: @right { 2 1 }
+CONSTANT: @top { 1 0 }
+CONSTANT: @bottom { 1 2 }
+
+CONSTANT: @top-left { 0 0 }
+CONSTANT: @top-right { 2 0 }
+CONSTANT: @bottom-left { 0 2 }
+CONSTANT: @bottom-right { 2 2 }
+
 : labeled-image ( name -- image )
     "labeled-block-" prepend theme-image ;
 
@@ -50,7 +61,8 @@ M: labeled-gadget focusable-child* content>> ;
 PRIVATE>
 
 : <labeled-gadget> ( gadget title -- newgadget )
-    labeled-gadget new-frame
+    3 3 labeled-gadget new-frame
+        { 1 1 } >>filled-cell
         /-FOO-\
         |-----|
         \-----/ ;