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 ;
] 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
: <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/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"
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 ;
: >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
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
--- /dev/null
+! 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 -- )
+
+ ;
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