a bnit of UI work

cvs
Slava Pestov 2005-06-23 07:15:44 +00:00
parent e9b142db4d
commit 50b0eee15f
9 changed files with 60 additions and 22 deletions

View 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 ;

View 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

View 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.

View 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"

View 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 ;

View File

@ -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

View 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

View File

@ -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 -- )
;

View 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