From 2b4c49c33abb391c9403e15c3fc69d2700867e56 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Wed, 29 Jun 2005 23:40:44 +0000
Subject: [PATCH] big cleanup of UI code

---
 library/math/math.factor        | 17 +++----
 library/test/gadgets.factor     | 10 ----
 library/ui/borders.factor       |  8 +--
 library/ui/checkboxes.factor    |  2 +-
 library/ui/frames.factor        |  2 +-
 library/ui/init-world.factor    |  4 +-
 library/ui/layouts.factor       | 87 ++++++++++++++++++++++++++++-----
 library/ui/load.factor          |  3 --
 library/ui/menus.factor         |  2 +-
 library/ui/piles.factor         | 49 -------------------
 library/ui/presentations.factor |  2 +
 library/ui/scrolling.factor     |  8 ---
 library/ui/shelves.factor       | 45 -----------------
 library/ui/splitters.factor     | 28 +++--------
 library/ui/stacks.factor        | 20 --------
 15 files changed, 101 insertions(+), 186 deletions(-)
 delete mode 100644 library/ui/piles.factor
 delete mode 100644 library/ui/shelves.factor
 delete mode 100644 library/ui/stacks.factor

diff --git a/library/math/math.factor b/library/math/math.factor
index bc962eb5f5..b1aab5208d 100644
--- a/library/math/math.factor
+++ b/library/math/math.factor
@@ -60,19 +60,16 @@ GENERIC: abs ( z -- |z| )
     2dup mod dup 0 number= [ 2drop ] [ - + ] ifte ;
 
 : (repeat) ( i n quot -- )
-    pick pick >= [
-        3drop
-    ] [
-        [ swap >r call 1 + r> ] keep (repeat)
-    ] ifte ; inline
+    pick pick >=
+    [ 3drop ] [ [ swap >r call 1 + r> ] keep (repeat) ] ifte ;
+    inline
 
-: repeat ( n quot -- )
-    #! Execute a quotation n times. The loop counter is kept on
-    #! the stack, and ranges from 0 to n-1.
+: repeat ( n quot -- | quot: n -- n )
+    #! The loop counter is kept on the stack, and ranges from
+    #! 0 to n-1.
     0 -rot (repeat) ; inline
 
-: times ( n quot -- )
-    #! Evaluate a quotation n times.
+: times ( n quot -- | quot: -- )
     swap [ >r dup slip r> ] repeat drop ; inline
 
 : 2repeat ( i j quot -- | quot: i j -- i j )
diff --git a/library/test/gadgets.factor b/library/test/gadgets.factor
index 8f0bf9f23c..ed9c9aca14 100644
--- a/library/test/gadgets.factor
+++ b/library/test/gadgets.factor
@@ -67,16 +67,6 @@ USING: gadgets kernel lists math namespaces test sequences ;
     ] with-scope
 ] unit-test
 
-[
-    300 620
-] [
-    0 { 10 10 10 } 0 <pile> "pile" set
-    0 0 100 100 <rectangle> <gadget> "pile" get add-gadget
-    0 0 200 200 <rectangle> <gadget> "pile" get add-gadget
-    0 0 300 300 <rectangle> <gadget> "pile" get add-gadget
-    "pile" get pref-size
-] unit-test
-
 [ ] [ "pile" get layout* ] unit-test
 
 [
diff --git a/library/ui/borders.factor b/library/ui/borders.factor
index a7205167a5..2898a4de3a 100644
--- a/library/ui/borders.factor
+++ b/library/ui/borders.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: errors generic hashtables kernel lists math namespaces
-sdl vectors ;
+USING: errors generic hashtables kernel lists math matrices
+namespaces sdl vectors ;
 
 ! A border lays out its children on top of each other, all with
 ! a 5-pixel padding.
@@ -34,8 +34,8 @@ C: border ( child delegate size -- border )
     gadget-child resize-gadget ;
 
 M: border pref-dim ( border -- dim )
-    [ border-size 2 * ] keep
-    gadget-child pref-size >r over + r> rot + 0 3vector ;
+    [ border-size dup dup 3vector 2 v*n ] keep
+    gadget-child pref-dim v+ ;
 
 M: border layout* ( border -- )
     dup layout-border-x/y layout-border-w/h ;
diff --git a/library/ui/checkboxes.factor b/library/ui/checkboxes.factor
index 1c66061f07..5c2b129c08 100644
--- a/library/ui/checkboxes.factor
+++ b/library/ui/checkboxes.factor
@@ -41,7 +41,7 @@ TUPLE: checkbox bevel selected? ;
     [ checkbox-bevel button-update ] [ mouse-enter ] set-action ;
 
 C: checkbox ( label -- checkbox )
-    <default-shelf> over set-delegate
+    <line-shelf> over set-delegate
     [ f line-border swap init-checkbox-bevel ] keep
     [ >r <label> r> add-gadget ] keep
     dup checkbox-actions
diff --git a/library/ui/frames.factor b/library/ui/frames.factor
index c298e0c2cf..bc12da66f6 100644
--- a/library/ui/frames.factor
+++ b/library/ui/frames.factor
@@ -113,4 +113,4 @@ SYMBOL: frame-bottom-run
     frame-bottom pos-frame-bottom ;
 
 M: frame layout* ( frame -- )
-    [ dup setup-frame  layout-frame ] with-layout ;
+    [ 0 x set 0 y set dup setup-frame layout-frame ] with-scope ;
diff --git a/library/ui/init-world.factor b/library/ui/init-world.factor
index f4f7a6566d..8474ff434f 100644
--- a/library/ui/init-world.factor
+++ b/library/ui/init-world.factor
@@ -18,9 +18,9 @@ global [
         [[ font-style plain ]]
     }} world get set-gadget-paint
     
-    1024 768 world get resize-gadget
+    { 1024 768 0 } world get set-gadget-dim
     
-    <plain-gadget> world get add-gadget
+    <plain-gadget> add-layer
 
     <console> "Stack display goes here" <label> <y-splitter>
     3/4 over set-splitter-split add-layer
diff --git a/library/ui/layouts.factor b/library/ui/layouts.factor
index 89227ad18f..daf7e91c5c 100644
--- a/library/ui/layouts.factor
+++ b/library/ui/layouts.factor
@@ -19,21 +19,84 @@ namespaces sdl sequences ;
         drop
     ] ifte ;
 
-: with-pref-size ( quot -- )
-    [
-        0 width set  0 height set  call  width get height get
-    ] with-scope ; inline
-
-: with-layout ( quot -- )
-    [ 0 x set 0 y set call ] with-scope ; inline
+GENERIC: alignment
+GENERIC: filling
+GENERIC: orientation
 
 : pref-dims ( gadget -- list )
     gadget-children [ pref-dim ] map ;
 
-: packed-pref-dim ( gadget gap axis -- dim )
+: packed-pref-dim ( gadget -- dim )
     #! The preferred size of the gadget, if all children are
     #! packed in the direction of the given axis.
-    >r
-    over length 0 max v*n >r pref-dims r>
-    2dup [ v+ ] reduce >r [ vmax ] reduce r>
-    r> set-axis ;
+    [
+        pref-dims
+        [ { 0 0 0 } [ vmax ] reduce ] keep
+        { 0 0 0 } [ v+ ] reduce
+    ] keep orientation set-axis ;
+
+: orient ( gadget list1 list2 -- list )
+    zip >r orientation r> [ uncons rot set-axis ] map-with ;
+
+: packed-dim-2 ( gadget sizes -- list )
+    [ over shape-dim over v- rot filling v*n v+ ] map-with ;
+
+: (packed-dims) ( gadget sizes -- list )
+    2dup packed-dim-2 swap orient ;
+
+: packed-dims ( gadget sizes -- list )
+    over gadget-children >r (packed-dims) r>
+    zip [ uncons set-gadget-dim ] each ;
+
+: packed-loc-1 ( sizes -- list )
+    { 0 0 0 } [ v+ ] accumulate ;
+
+: packed-loc-2 ( gadget sizes -- list )
+    >r dup shape-dim over r> packed-dim-2 [ v- ] map-with
+    >r dup alignment swap shape-dim r>
+    [ >r 2dup r> v- n*v ] map 2nip ;
+
+: (packed-locs) ( gadget sizes -- list )
+    dup packed-loc-1 >r dupd packed-loc-2 r> orient ;
+
+: packed-locs ( gadget sizes -- )
+    over gadget-children >r (packed-locs) r>
+    zip [ uncons set-gadget-loc ] each ;
+
+: packed-layout ( gadget sizes -- )
+    2dup packed-locs packed-dims ;
+
+TUPLE: pack align fill vector ;
+
+C: pack ( align fill vector -- pack )
+    #! align: 0 left aligns, 1/2 center, 1 right.
+    #! gap: between each child.
+    #! fill: 0 leaves default width, 1 fills to pack width.
+    [ <empty-gadget> swap set-delegate ] keep
+    [ set-pack-vector ] keep
+    [ set-pack-fill ] keep
+    [ set-pack-align ] keep ;
+
+: <pile> { 0 1 0 } <pack> ;
+
+: <line-pile> 0 1 <pile> ;
+
+: <shelf> { 1 0 0 } <pack> ;
+
+: <line-shelf> 0 1 <shelf> ;
+
+M: pack orientation pack-vector ;
+
+M: pack filling pack-fill ;
+
+M: pack alignment pack-align ;
+
+M: pack pref-dim packed-pref-dim ;
+
+M: pack layout* ( pack -- )
+    dup pref-dims packed-layout ;
+
+: <stack> ( list -- gadget )
+    #! A stack lays out all its children on top of each other.
+    0 1 { 0 0 1 } <pack>
+    swap [ over add-gadget ] each ;
diff --git a/library/ui/load.factor b/library/ui/load.factor
index f5fc285acd..8b5dd8d544 100644
--- a/library/ui/load.factor
+++ b/library/ui/load.factor
@@ -14,10 +14,7 @@ USING: kernel parser sequences io ;
     "/library/ui/gestures.factor"
     "/library/ui/hand.factor"
     "/library/ui/layouts.factor"
-    "/library/ui/piles.factor"
-    "/library/ui/shelves.factor"
     "/library/ui/borders.factor"
-    "/library/ui/stacks.factor"
     "/library/ui/frames.factor"
     "/library/ui/world.factor"
     "/library/ui/labels.factor"
diff --git a/library/ui/menus.factor b/library/ui/menus.factor
index d6eae16dd3..fb734e36b9 100644
--- a/library/ui/menus.factor
+++ b/library/ui/menus.factor
@@ -12,7 +12,7 @@ USING: generic kernel lists math namespaces sequences ;
     hide-menu
     world get
     2dup set-world-menu
-    2dup world-hand screen-pos >rect rot move-gadget
+    2dup world-hand screen-loc swap set-gadget-loc
     show-glass ;
 
 : menu-item-border ( child -- border )
diff --git a/library/ui/piles.factor b/library/ui/piles.factor
deleted file mode 100644
index b41cb4396b..0000000000
--- a/library/ui/piles.factor
+++ /dev/null
@@ -1,49 +0,0 @@
-! Copyright (C) 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: gadgets
-USING: errors generic hashtables kernel lists math namespaces
-sdl sequences vectors ;
-
-! pile-align
-!
-! if the component is smaller than its allocated space, where to
-! place the component inside the allocated space.
-!
-! pile-gap
-! 
-! amount of space, in pixels, between components.
-! 
-! pile-fill
-! 
-! if the component is smaller than its allocated space, how much
-! to scale the size, where a value of 0 represents no scaling, and
-! a value of 1 represents resizing to fully fill allocated space.
-TUPLE: pile align gap fill ;
-
-C: pile ( align gap fill -- pile )
-    #! align: 0 left aligns, 1/2 center, 1 right.
-    #! gap: between each child.
-    #! fill: 0 leaves default width, 1 fills to pile width.
-    [ <empty-gadget> swap set-delegate ] keep
-    [ set-pile-fill ] keep
-    [ set-pile-gap ] keep
-    [ set-pile-align ] keep ;
-
-: <line-pile> 0 { 0 0 0 } 1 <pile> ;
-
-M: pile pref-dim ( pile -- dim )
-    dup pile-gap { 0 1 0 } packed-pref-dim ;
-
-: w- swap shape-w swap pref-size drop - ;
-: pile-x/y ( pile gadget offset -- )
-    rot pile-align * >fixnum y get rot move-gadget ;
-: pile-w/h ( pile gadget offset -- )
-    rot dup pile-gap first y [ + ] change
-    pile-fill * >fixnum over pref-size dup y [ + ] change
-    >r + r> rot resize-gadget ;
-: vertically ( pile gadget -- ) 2dup w- 3dup pile-x/y pile-w/h ;
-
-M: pile layout* ( pile -- )
-    [
-        dup gadget-children [ vertically ] each-with
-    ] with-layout ;
diff --git a/library/ui/presentations.factor b/library/ui/presentations.factor
index 8c4267db08..1a41b7b9c3 100644
--- a/library/ui/presentations.factor
+++ b/library/ui/presentations.factor
@@ -4,6 +4,8 @@ IN: gadgets
 USING: hashtables io kernel lists namespaces parser prettyprint
 sequences ;
 
+DEFER: pane-eval
+
 : actions-menu ( pane actions -- menu )
     [ uncons rot [ pane-eval ] cons cons cons ] map-with <menu> ;
 
diff --git a/library/ui/scrolling.factor b/library/ui/scrolling.factor
index 78c691aadd..f378350b3f 100644
--- a/library/ui/scrolling.factor
+++ b/library/ui/scrolling.factor
@@ -13,8 +13,6 @@ TUPLE: viewport origin ;
 : set-viewport-x [ viewport-y 0 3vector ] keep set-viewport-origin ;
 : set-viewport-y [ viewport-x swap 0 3vector ] keep set-viewport-origin ;
 
-: viewport-h ( viewport -- h ) gadget-child pref-size nip ;
-
 : viewport-dim ( viewport -- h ) gadget-child pref-dim ;
 
 : fix-scroll ( origin viewport -- origin )
@@ -23,12 +21,6 @@ TUPLE: viewport origin ;
 : scroll ( origin viewport -- )
     [ fix-scroll ] keep [ set-viewport-origin ] keep relayout ;
 
-: scroll-viewport ( y viewport -- )
-    #! y is a number between -1 and 0..
-    [ viewport-h * >fixnum ] keep
-    [ viewport-x swap 0 3vector ] keep 
-    scroll ;
-
 C: viewport ( content -- viewport )
     [ <empty-gadget> swap set-delegate ] keep
     [ add-gadget ] keep
diff --git a/library/ui/shelves.factor b/library/ui/shelves.factor
deleted file mode 100644
index 0aaf0f9354..0000000000
--- a/library/ui/shelves.factor
+++ /dev/null
@@ -1,45 +0,0 @@
-! Copyright (C) 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: gadgets
-USING: errors generic hashtables kernel lists math namespaces
-sdl sequences vectors ;
-
-! A shelf is a box that lays out its contents horizontally.
-TUPLE: shelf gap align fill ;
-
-C: shelf ( align gap fill -- shelf )
-    #! align: 0 left aligns, 1/2 center, 1 right.
-    #! gap: between each child.
-    #! fill: 0 leaves default width, 1 fills to pile width.
-    <empty-gadget> over set-delegate
-    [ set-shelf-fill ] keep
-    [ set-shelf-gap ] keep
-    [ set-shelf-align ] keep ;
-
-: <default-shelf> 1/2 { 3 3 3 } 0 <shelf> ;
-: <line-shelf> 0 0 1 <shelf> ;
-
-M: shelf pref-dim ( pile -- dim )
-    [
-        dup shelf-gap swap gadget-children
-        [ length 1 - 0 max * width set ] keep
-        [
-            pref-size
-            height [ max ] change
-            width [ + ] change
-        ] each
-    ] with-pref-size 0 3vector ;
-
-: h- swap shape-h swap pref-size nip - ;
-: shelf-x/y rot shelf-align * >fixnum >r x get r> rot move-gadget ;
-: shelf-w/h ( shelf gadget offset -- )
-    rot dup shelf-gap x [ + ] change
-    shelf-fill * >fixnum >r dup pref-size over x [ + ] change
-    r> + rot resize-gadget ; 
-: horizontally ( shelf gadget -- )
-    2dup h- 3dup shelf-x/y shelf-w/h ;
-
-M: shelf layout* ( pile -- )
-    [
-        dup gadget-children [ horizontally ] each-with
-    ] with-layout ;
diff --git a/library/ui/splitters.factor b/library/ui/splitters.factor
index e9f8560d55..801d162d3f 100644
--- a/library/ui/splitters.factor
+++ b/library/ui/splitters.factor
@@ -43,8 +43,13 @@ C: splitter ( first second vector -- splitter )
 
 : <y-splitter> { 1 0 0 } <splitter> ;
 
-M: splitter pref-dim
-    { 0 0 0 } over splitter-vector packed-pref-dim ;
+M: splitter orientation splitter-vector ;
+
+M: splitter filling drop 1 ;
+
+M: splitter alignment drop 0 ;
+
+M: splitter pref-dim packed-pref-dim ;
 
 : splitter-part ( splitter -- vec )
     dup splitter-split swap shape-dim n*v divider-size 1/2 v*n v- ;
@@ -56,22 +61,5 @@ M: splitter pref-dim
         dup shape-dim swap splitter-part v- ,
     ] make-list ;
 
-: packed-locs ( axis sizes gadget -- )
-    >r
-    { 0 0 0 } [ v+ ] accumulate
-    [ { 0 0 0 } swap rot set-axis ] map-with
-    r> gadget-children zip [ uncons set-gadget-loc ] each ;
-
-: packed-dims ( axis sizes gadget -- dims )
-    [
-        shape-dim swap [ >r 2dup r> rot set-axis ] map 2nip
-    ] keep gadget-children zip [ uncons set-gadget-dim ] each ;
-
-: layout-divider ( assoc -- )
-    [ uncons set-gadget-dim ] each ;
-
-: packed-layout ( axis sizes gadgets -- )
-    3dup packed-locs packed-dims ;
-
 M: splitter layout* ( splitter -- )
-    dup splitter-vector over splitter-layout rot packed-layout ;
+    dup splitter-layout packed-layout ;
diff --git a/library/ui/stacks.factor b/library/ui/stacks.factor
deleted file mode 100644
index 7133200ca2..0000000000
--- a/library/ui/stacks.factor
+++ /dev/null
@@ -1,20 +0,0 @@
-! Copyright (C) 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: gadgets
-USING: errors generic hashtables kernel lists math matrices
-namespaces sdl sequences ;
-
-! A stack just lays out all its children on top of each other.
-TUPLE: stack ;
-C: stack ( list -- stack )
-    <empty-gadget> over set-delegate
-    swap [ over add-gadget ] each ;
-
-: max-dim ( shapelist -- dim )
-    { 0 0 0 } [ shape-dim vmax ] reduce ;
-
-M: stack pref-dim gadget-children max-dim ;
-
-M: stack layout* ( stack -- )
-    dup shape-dim swap gadget-children
-    [ set-gadget-dim ] each-with ;