]> gitweb.factorcode.org Git - factor.git/commitdiff
a bnit of UI work
authorSlava Pestov <slava@factorcode.org>
Thu, 23 Jun 2005 07:15:44 +0000 (07:15 +0000)
committerSlava Pestov <slava@factorcode.org>
Thu, 23 Jun 2005 07:15:44 +0000 (07:15 +0000)
library/ui/borders.factor
library/ui/editors.factor
library/ui/gadgets.factor
library/ui/load.factor
library/ui/menus.factor
library/ui/scrolling.factor
library/ui/shelves.factor
library/ui/splitters.factor [new file with mode: 0644]
library/ui/world.factor

index d1f3c2cf4f556797f80513af6fb5ebfb36d30241..56f27cd9a16dc56c63df22ac4d71f1578896d9ea 100644 (file)
@@ -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 ;
 
index f99e40c7e024df570028f0d4570a08f621d3e531..ba623768214262ccd43c42c3e7498bab2c0baa74 100644 (file)
@@ -66,8 +66,7 @@ TUPLE: editor line caret ;
     ] swap add-actions ;
 
 : <caret> ( -- caret )
-    0 0 0 0 <plain-rect> <gadget>
-    dup red background set-paint-prop ;
+    <plain-gadget> dup red background set-paint-prop ;
 
 C: editor ( text -- )
     <empty-gadget> over set-delegate
index 52e99c279151b2e4d5a010f09f7686f0ace19f71..ef13960c11234c096d9de163e0fcb71c34122b04 100644 (file)
@@ -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.
index 94c541dcd07e1e8eb340aa2669c99d67e23471f0..52b4f4ad37b38738805ddf01dde1b9a3429358d3 100644 (file)
@@ -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"
index ca9ca73cad867d008a770a4823d9057dcadf4065..52664ca3282320ea8f52ea943518f4db5b6b012e 100644 (file)
@@ -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 ;
index 00c066983bb42d2167e3ddf14b7e542134513739..127079ac88776d7fd29f24b649004e02af52b86c 100644 (file)
@@ -57,39 +57,35 @@ TUPLE: slider viewport thumb vector ;
 : >viewport ( pos slider -- pos )
     slider-viewport visible-portion v/ ;
 
-: slider-drag ( slider -- pos )
-    hand swap relative hand hand-click-rel v+ ;
+: slider-current ( slider -- pos )
+    dup slider-viewport viewport-origin
+    dup rot slider-vector v* v- ;
 
-: slider-motion ( slider -- )
-    dup slider-drag over >viewport
+: 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 -- )
+    hand hand-click-rel slider-click ;
+
 : thumb-actions ( thumb -- )
     dup [ drop ] [ button-down 1 ] set-action
     dup [ drop ] [ button-up 1 ] set-action
     [ 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
index 588ba9b3d18d1a1e11e981ba4ff04c1ca04e5884..157ad15bdd6ee6d17a89eb7bc188df203874568b 100644 (file)
@@ -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
diff --git a/library/ui/splitters.factor b/library/ui/splitters.factor
new file mode 100644 (file)
index 0000000..4cb3e31
--- /dev/null
@@ -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 -- )
+    
+    ;
index 85b2cb5fa8dfc626b6ab63b8c08f6b8dd4865300..68f41558d3c9e923945d793fd481404d06838682 100644 (file)
@@ -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