a bnit of UI work
parent
e9b142db4d
commit
50b0eee15f
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -57,12 +57,19 @@ 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-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
|
||||
over slider-viewport scroll relayout ;
|
||||
hand hand-click-rel slider-click ;
|
||||
|
||||
: 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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 -- )
|
||||
|
||||
;
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue