layouts

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 385fa2a0082f5aa8011906e6bf27d8022e75e609..219225c5cce02c21c84e3b05c7344702d964e271 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -16,6 +16,9 @@
 - doc comments of generics\r
 - proper ordering for classes\r
 - tuples: in/out syntax\r
+- tuples: gracefully handle changing shape\r
+- keep a list of getter/setter words\r
+- default constructor\r
 \r
 + ffi:\r
 \r
@@ -31,6 +34,7 @@
 \r
 + listener/plugin:\r
 \r
+- command to turn repl session into a source file\r
 - update plugin docs\r
 - extract word keeps indent\r
 - word preview for remote words\r

diff --git a/library/bootstrap/boot-stage2.factor b/library/bootstrap/boot-stage2.factor
index 06e6201b406736c9791ffc20e7c7dfedb86779af..499a3b37b26fcf2ac93c79bc7671a98c643cf7cd 100644 (file)
--- a/library/bootstrap/boot-stage2.factor
+++ b/library/bootstrap/boot-stage2.factor
@@ -159,7 +159,8 @@ cpu "x86" = [
         "/library/ui/gestures.factor"\r
         "/library/ui/hand.factor"\r
         "/library/ui/world.factor"\r
-        "/library/ui/label.factor"\r
+        "/library/ui/labels.factor"\r
+        "/library/ui/piles.factor"\r
         "/library/ui/events.factor"\r
     ] [\r
         dup print\r

diff --git a/library/ui/boxes.factor b/library/ui/boxes.factor
index 62f79a8ebab3c0d8a2b0f86fe10498d507008335..37730747c7bbc83b39de5f198f11356b58f33c67 100644 (file)
--- a/library/ui/boxes.factor
+++ b/library/ui/boxes.factor
@@ -4,11 +4,13 @@ IN: gadgets
 USING: generic hashtables kernel lists namespaces ;
 
 ! A box is a gadget holding other gadgets.
-TUPLE: box contents delegate ;
+TUPLE: box children delegate ;
 
 C: box ( gadget -- box )
     [ set-box-delegate ] keep ;
 
+M: box gadget-children box-children ;
+
 M: general-list draw ( list -- )
     [ draw ] each ;
 
@@ -17,7 +19,7 @@ M: box draw ( box -- )
         dup [
             dup
             box-delegate draw
-            box-contents draw
+            box-children draw
         ] with-gadget
     ] with-translation ;
 
@@ -37,25 +39,23 @@ M: box pick-up* ( point box -- gadget )
     #! box, return f. Otherwise, see if the point is contained
     #! in any subgadget. If not, see if it is contained in the
     #! box delegate.
-    dup [
-        2dup inside? [
-            2dup box-contents pick-up dup [
-                2nip
-            ] [
-                drop box-delegate pick-up*
-            ] ifte
+    2dup inside? [
+        2dup [ translate ] keep box-children pick-up dup [
+            2nip
         ] [
-            2drop f
+            drop box-delegate pick-up*
         ] ifte
-    ] with-translation ;
+    ] [
+        2drop f
+    ] ifte ;
 
 : box- ( gadget box -- )
-    [ 2dup box-contents remq swap set-box-contents ] keep
-    redraw
+    [ 2dup box-children remq swap set-box-children ] keep
+    relayout
     f swap set-gadget-parent ;
 
 : (box+) ( gadget box -- )
-    [ box-contents cons ] keep set-box-contents ;
+    [ box-children cons ] keep set-box-children ;
 
 : unparent ( gadget -- )
     dup gadget-parent dup [ box- ] [ 2drop ] ifte ;
@@ -65,4 +65,4 @@ M: box pick-up* ( point box -- gadget )
     over unparent
     dup pick set-gadget-parent
     tuck (box+)
-    redraw ;
+    relayout ;

diff --git a/library/ui/gadgets.factor b/library/ui/gadgets.factor
index 06c0e661748a4538816bf04f8d0a969dde5aea5c..9423d328c43ebc2d4c4bba3db858bb7b167e16c2 100644 (file)
--- a/library/ui/gadgets.factor
+++ b/library/ui/gadgets.factor
@@ -3,6 +3,11 @@
 IN: gadgets
 USING: generic hashtables kernel lists namespaces ;
 
+! A gadget is a shape, a paint, a mapping of gestures to
+! actions, and a reference to the gadget's parent. A gadget
+! delegates to its shape.
+TUPLE: gadget paint gestures parent relayout? redraw? delegate ;
+
 ! Gadget protocol.
 GENERIC: pick-up* ( point gadget -- gadget/t )
 
@@ -11,15 +16,31 @@ GENERIC: pick-up* ( point gadget -- gadget/t )
     #! exposed facade issue.
     tuck pick-up* dup t = [ drop ] [ nip ] ifte ;
 
-! A gadget is a shape, a paint, a mapping of gestures to
-! actions, and a reference to the gadget's parent. A gadget
-! delegates to its shape.
-TUPLE: gadget paint gestures parent delegate ;
+GENERIC: gadget-children ( gadget -- list )
+M: gadget gadget-children drop f ;
+
+GENERIC: layout* ( gadget -- )
+M: gadget layout* drop ;
+
+: layout ( gadget -- )
+    #! Set the gadget's width and height to its preferred width
+    #! and height. The gadget's children are laid out first.
+    #! Note that nothing is done if the gadget does not need to
+    #! be laid out.
+    dup gadget-relayout? [
+        f over set-gadget-relayout?
+        dup gadget-children [ layout ] each
+        layout*
+    ] [
+        drop
+    ] ifte ;
 
 C: gadget ( shape -- gadget )
     [ set-gadget-delegate ] keep
     [ <namespace> swap set-gadget-paint ] keep
-    [ <namespace> swap set-gadget-gestures ] keep ;
+    [ <namespace> swap set-gadget-gestures ] keep
+    [ t swap set-gadget-relayout? ] keep
+    [ t swap set-gadget-redraw? ] keep ;
 
 : paint-property ( gadget key -- value )
     swap gadget-paint hash ;
@@ -43,7 +64,19 @@ M: gadget draw ( gadget -- ) drop ;
 
 M: gadget pick-up* inside? ;
 
-DEFER: redraw ( gadget -- )
+: redraw ( gadget -- )
+    #! Redraw a gadget before the next iteration of the event
+    #! loop.
+    t over set-gadget-redraw?
+    gadget-parent [ redraw ] when* ;
+
+: relayout ( gadget -- )
+    #! Relayout a gadget before the next iteration of the event
+    #! loop. Since relayout also implies the visual
+    #! representation changed, we redraw the gadget too.
+    t over set-gadget-redraw?
+    t over set-gadget-relayout?
+    gadget-parent [ relayout ] when* ;
 
 : move-gadget ( x y gadget -- )
     [ move-shape ] keep

diff --git a/library/ui/gestures.factor b/library/ui/gestures.factor
index 7c9999996b2a6cddfcff0d84622a24097620b046..844df6343e4d74efcab026b5711ba4288bda5f3e 100644 (file)
--- a/library/ui/gestures.factor
+++ b/library/ui/gestures.factor
@@ -24,10 +24,6 @@ USING: alien generic hashtables kernel lists sdl-event ;
         2drop
     ] ifte ;
 
-! Redraw gesture. Don't handle this yourself.
-: redraw ( gadget -- )
-    \ redraw swap handle-gesture ;
-
 ! Mouse gestures are lists where the first element is one of:
 SYMBOL: motion
 SYMBOL: button-up

diff --git a/library/ui/label.factor b/library/ui/label.factor
deleted file mode 100644 (file)
index 359ba0f..0000000
--- a/library/ui/label.factor
+++ /dev/null
@@ -1,29 +0,0 @@
-! Copyright (C) 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: gadgets
-USING: generic kernel lists math namespaces sdl ;
-
-! A label draws a text label, centered on the gadget's bounding
-! box.
-TUPLE: label text delegate ;
-
-: size-label ( label -- )
-    [
-        dup label-text swap gadget-paint
-        [ font get lookup-font ] bind
-        swap size-string
-    ] keep resize-gadget ;
-
-C: label ( text -- )
-    0 0 0 0 <rectangle> <gadget> over set-label-delegate
-    [ set-label-text ] keep
-    [ size-label ] keep ;
-
-M: label draw ( label -- )
-    dup shape-x x get +
-    over shape-y y get +
-    rot label-text
-    >r font get lookup-font r>
-    color get 3unlist make-color
-    white make-color
-    draw-string drop ;

diff --git a/library/ui/labels.factor b/library/ui/labels.factor
new file mode 100644 (file)
index 0000000..ce78627
--- /dev/null
+++ b/library/ui/labels.factor
@@ -0,0 +1,28 @@
+! Copyright (C) 2005 Slava Pestov.
+! See http://factor.sf.net/license.txt for BSD license.
+IN: gadgets
+USING: generic kernel lists math namespaces sdl ;
+
+! A label draws a text label, centered on the gadget's bounding
+! box.
+TUPLE: label text delegate ;
+
+C: label ( text -- )
+    0 0 0 0 <rectangle> <gadget> over set-label-delegate
+    [ set-label-text ] keep ;
+
+M: label layout* ( label -- )
+    [
+        dup label-text swap gadget-paint
+        [ font get lookup-font ] bind
+        swap size-string
+    ] keep resize-gadget ;
+
+M: label draw ( label -- )
+    dup shape-x x get +
+    over shape-y y get +
+    rot label-text
+    >r font get lookup-font r>
+    color get 3unlist make-color
+    white make-color
+    draw-string drop ;

diff --git a/library/ui/piles.factor b/library/ui/piles.factor
new file mode 100644 (file)
index 0000000..5e8c2f8
--- /dev/null
+++ b/library/ui/piles.factor
@@ -0,0 +1,17 @@
+! Copyright (C) 2005 Slava Pestov.
+! See http://factor.sf.net/license.txt for BSD license.
+IN: gadgets
+USING: generic hashtables kernel lists math namespaces ;
+
+! A pile is a box that lays out its contents vertically.
+TUPLE: pile delegate ;
+
+C: pile ( gadget -- pile )
+    [ >r <box> r> set-pile-delegate ] keep ;
+
+M: pile layout* ( pile -- )
+    dup gadget-children run-heights >r >r
+    dup gadget-children max-width r> pick resize-gadget
+    gadget-children r> zip [
+        uncons 0 swap rot move-gadget
+    ] each ;

diff --git a/library/ui/shapes.factor b/library/ui/shapes.factor
index 048ed402f2b6f5ac6bbb213358317c115f84417a..31a25e6bd19814fcd1fd120e5c4ef1517d1f469b 100644 (file)
--- a/library/ui/shapes.factor
+++ b/library/ui/shapes.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: generic kernel math namespaces ;
+USING: generic kernel lists math namespaces ;
 
 ! Shape protocol. Shapes are immutable; moving or resizing a
 ! shape makes a new shape.
@@ -33,6 +33,21 @@ GENERIC: resize-shape ( w h shape -- shape )
         r> call
     ] with-scope ; inline
 
+: translate ( point shape -- point )
+    #! Translate a point relative to the shape.
+    #! The rect>'ing of the given point won't be necessary as
+    #! soon as all generics delegate.
+    >r dup shape-x swap shape-y rect> r>
+    dup shape-x swap shape-y rect> - ;
+
+: max-width ( list -- n )
+    #! The width of the widest shape.
+    [ shape-w ] map [ > ] top ;
+
+: run-heights ( list -- h list )
+    #! Compute a list of accumilative sums of heights of shapes.
+    [ 0 swap [ over , shape-h + ] each ] make-list ;
+
 ! A point, represented as a complex number, is the simplest type
 ! of shape.
 M: number inside? = ;

diff --git a/library/ui/world.factor b/library/ui/world.factor
index 91c60135da02fa6b20276b03811b336151f112a0..326a7acb0a869a83d1639c2c5823ce32ccec2121 100644 (file)
--- a/library/ui/world.factor
+++ b/library/ui/world.factor
@@ -7,7 +7,7 @@ sdl-video ;
 ! The world gadget is the top level gadget that all (visible)
 ! gadgets are contained in. The current world is stored in the
 ! world variable.
-TUPLE: world running? hand delegate redraw? ;
+TUPLE: world running? hand delegate ;
 
 : <world-box> ( -- box )
     0 0 0 0 <rectangle> <everywhere> <stamp>
@@ -18,15 +18,14 @@ TUPLE: world running? hand delegate redraw? ;
 C: world ( -- world )
     <world-box> over set-world-delegate
     t over set-world-running?
-    t over set-world-redraw?
     dup <hand> over set-world-hand ;
 
 : my-hand ( -- hand ) world get world-hand ;
 
 : draw-world ( -- )
-    world get dup world-redraw? [
+    world get dup gadget-redraw? [
         [
-            f over set-world-redraw?
+            f over set-gadget-redraw?
             dup draw
             world-hand draw
         ] with-surface
@@ -36,10 +35,12 @@ C: world ( -- world )
 
 DEFER: handle-event
 
+: layout-world world get layout ;
+
 : run-world ( -- )
     world get world-running? [
         <event> dup SDL_WaitEvent 1 = [
-            handle-event draw-world run-world
+            handle-event draw-world layout-world run-world
         ] [
             drop
         ] ifte
@@ -47,8 +48,6 @@ DEFER: handle-event
 
 : init-world ( w h -- )
     t world get set-world-running?
-    t world get set-world-redraw?
-    world get [ t swap set-world-redraw? ] \ redraw set-action
     world get resize-gadget ;
 
 : world-flags SDL_HWSURFACE SDL_RESIZABLE bitor ;