a bnit of UI work

library/ui/borders.factor

@@ -20,7 +20,7 @@ C: border ( child delegate size -- border )
     0 0 0 0 <etched-rect> <gadget> 5 <border> ;
 
 : filled-border ( child -- border )
-    0 0 0 0 <plain-rect> <gadget> 5 <border> ;
+    <plain-gadget> 5 <border> ;
 
 : gadget-child gadget-children car ;
 

library/ui/editors.factor

@@ -66,8 +66,7 @@ TUPLE: editor line caret ;
     ] swap add-actions ;
 
 : <caret> ( -- caret )
-    0 0 0 0 <plain-rect> <gadget>
+    <plain-gadget> dup red background set-paint-prop ;
-    dup red background set-paint-prop ;
 
 C: editor ( text -- )
     <empty-gadget> over set-delegate

library/ui/gadgets.factor

@@ -18,6 +18,8 @@ C: gadget ( shape -- gadget )
 
 : <empty-gadget> ( -- gadget ) 0 0 0 0 <rectangle> <gadget> ;
 
+: <plain-gadget> ( -- gadget ) 0 0 0 0 <plain-rect> <gadget> ;
+
 : redraw ( gadget -- )
     #! Redraw a gadget before the next iteration of the event
     #! loop.

library/ui/load.factor

@@ -28,6 +28,7 @@ USING: kernel parser sequences io ;
     "/library/ui/menus.factor"
     "/library/ui/presentations.factor"
     "/library/ui/tiles.factor"
+    "/library/ui/splitters.factor"
     "/library/ui/panes.factor"
     "/library/ui/dialogs.factor"
     "/library/ui/inspector.factor"

library/ui/menus.factor

@@ -15,7 +15,7 @@ USING: generic kernel lists math namespaces sequences ;
     add-gadget ;
 
 : menu-item-border ( child -- border )
-    0 0 0 0 <plain-rect> <gadget> 1 <border> ;
+    <plain-gadget> 1 <border> ;
 
 : <menu-item> ( label quot -- gadget )
     >r <label> menu-item-border dup r> button-gestures ;

library/ui/scrolling.factor

@@ -57,12 +57,19 @@ TUPLE: slider viewport thumb vector ;
 : >viewport ( pos slider -- pos )
     slider-viewport visible-portion v/ ;
 
-: slider-drag ( slider -- pos )
+: slider-current ( slider -- pos )
-    hand swap relative hand hand-click-rel v+ ;
+    dup slider-viewport viewport-origin
+    dup rot slider-vector v* v- ;
+
+: slider-pos ( slider pos -- pos )
+    hand pick relative v+ over slider-vector v* swap >viewport ;
+
+: slider-click ( slider pos -- )
+    dupd slider-pos over slider-current v+
+    over slider-viewport scroll relayout ;
 
 : slider-motion ( slider -- )
-    dup slider-drag over >viewport
+    hand hand-click-rel slider-click ;
-    over slider-viewport scroll relayout ;
 
 : thumb-actions ( thumb -- )
     dup [ drop ] [ button-down 1 ] set-action
@@ -70,26 +77,15 @@ TUPLE: slider viewport thumb vector ;
     [ gadget-parent slider-motion ] [ drag 1 ] set-action ;
 
 : <thumb> ( -- thumb )
-    0 0 0 0 <plain-rect> <gadget>
+    <plain-gadget>
     dup t reverse-video set-paint-prop
     dup thumb-actions ;
 
 : add-thumb ( thumb slider -- )
     2dup add-gadget set-slider-thumb ;
 
-: slider-current ( slider -- pos )
-    dup slider-viewport viewport-origin
-    dup rot slider-vector v* v- ;
-
-: slider-pos ( slider -- pos )
-    hand over relative over slider-vector v* swap >viewport ;
-
-: slider-click ( slider -- )
-    dup slider-pos over slider-current v+
-    swap slider-viewport scroll ;
-
 : slider-actions ( slider -- )
-    [ slider-click ] [ button-down 1 ] set-action ;
+    [ { 0 0 0 } slider-click ] [ button-down 1 ] set-action ;
 
 C: slider ( viewport vector -- slider )
     [ set-slider-vector ] keep

library/ui/shelves.factor

@@ -8,6 +8,9 @@ sdl sequences ;
 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

library/ui/splitters.factor

@@ -0,0 +1,37 @@
+! Copyright (C) 2005 Slava Pestov.
+! See http://factor.sf.net/license.txt for BSD license.
+IN: gadgets
+USING: generic kernel matrices sequences ;
+
+TUPLE: divider splitter ;
+
+C: divider ( splitter -- divider )
+    [ set-divider-splitter ] keep
+    <plain-gadget> over set-delegate
+    dup t reverse-video set-paint-prop ;
+
+M: divider pref-size drop 16 16 ;
+
+TUPLE: splitter vector first divider second ;
+
+C: splitter ( first second vector -- )
+    [ set-splitter-vector ] keep
+    [ set-splitter-second ] keep
+    [ set-splitter-first ] keep
+    [ dup <divider> swap set-splitter-divider ] keep ;
+
+: splitter-pref-dims ( splitter -- dim dim dim )
+    dup splitter-first pref-dim
+    over splitter-divider pref-dim
+    rot splitter-second pref-dim ;
+
+: set-axis ( x y axis -- v )
+    2dup v* >r >r drop dup r> v* v- r> v+ ;
+
+M: splitter pref-size ( splitter -- w h )
+    [ splitter-pref-dims 3dup vmax vmax >r v+ v+ r> ] keep
+    splitter-vector set-axis 3unseq drop ;
+
+M: splitter layout* ( splitter -- )
+    
+    ;

library/ui/world.factor

@@ -12,7 +12,7 @@ threads sequences ;
 TUPLE: world running? hand menu ;
 
 : <world-box> ( -- box )
-    0 0 0 0 <plain-rect> <gadget> ;
+    <plain-gadget> ;
 
 C: world ( -- world )
     <world-box> over set-delegate