steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

ui.gadgets.sliders: rewrite some words

db4
Eduardo Cavazos 2008-07-15 14:12:23 -05:00
parent 9e52e3f90d
commit d7d896205c
1 changed files with 15 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
extra/ui/gadgets/sliders/sliders.factor
View File

@ -9,26 +9,20 @@ IN: ui.gadgets.sliders
TUPLE: elevator < gadget direction ; TUPLE: elevator < gadget direction ;
: find-elevator ( gadget -- elevator/f ) : find-elevator ( gadget -- elevator/f ) [ elevator? ] find-parent ;
[ elevator? ] find-parent ;
TUPLE: slider < frame elevator thumb saved line ; TUPLE: slider < frame elevator thumb saved line ;
: find-slider ( gadget -- slider/f ) : find-slider ( gadget -- slider/f ) [ slider? ] find-parent ;
[ slider? ] find-parent ;
: elevator-length ( slider -- n ) : elevator-length ( slider -- n )
dup slider-elevator rect-dim [ elevator>> dim>> ] [ orientation>> ] bi v. ;
swap gadget-orientation v. ;
: min-thumb-dim 15 ; : min-thumb-dim 15 ;
: slider-value ( gadget -- n ) gadget-model range-value >fixnum ; : slider-value ( gadget -- n ) gadget-model range-value >fixnum ;
: slider-page ( gadget -- n ) gadget-model range-page-value ; : slider-page ( gadget -- n ) gadget-model range-page-value ;
: slider-max ( gadget -- n ) gadget-model range-max-value ; : slider-max ( gadget -- n ) gadget-model range-max-value ;
: slider-max* ( gadget -- n ) gadget-model range-max-value* ; : slider-max* ( gadget -- n ) gadget-model range-max-value* ;
: thumb-dim ( slider -- h ) : thumb-dim ( slider -- h )
@ -45,7 +39,6 @@ TUPLE: slider < frame elevator thumb saved line ;
swap slider-max* 1 max / ; swap slider-max* 1 max / ;
: slider>screen ( m scale -- n ) slider-scale * ; : slider>screen ( m scale -- n ) slider-scale * ;
: screen>slider ( m scale -- n ) slider-scale / ; : screen>slider ( m scale -- n ) slider-scale / ;
M: slider model-changed nip slider-elevator relayout-1 ; M: slider model-changed nip slider-elevator relayout-1 ;
@ -76,11 +69,9 @@ thumb H{
t >>root? t >>root?
thumb-theme ; thumb-theme ;
: slide-by ( amount slider -- ) : slide-by ( amount slider -- ) gadget-model move-by ;
gadget-model move-by ;
: slide-by-page ( amount slider -- ) : slide-by-page ( amount slider -- ) gadget-model move-by-page ;
gadget-model move-by-page ;
: compute-direction ( elevator -- -1/1 ) : compute-direction ( elevator -- -1/1 )
dup find-slider swap hand-click-rel dup find-slider swap hand-click-rel
@ -100,13 +91,10 @@ elevator H{
{ T{ button-down } [ elevator-click ] } { T{ button-down } [ elevator-click ] }
} set-gestures } set-gestures
: elevator-theme ( elevator -- )
lowered-gradient swap set-gadget-interior ;
: <elevator> ( vector -- elevator ) : <elevator> ( vector -- elevator )
elevator new-gadget elevator new-gadget
[ set-gadget-orientation ] keep swap >>orientation
dup elevator-theme ; lowered-gradient >>interior ;
: (layout-thumb) ( slider n -- n thumb ) : (layout-thumb) ( slider n -- n thumb )
over gadget-orientation n*v swap slider-thumb ; over gadget-orientation n*v swap slider-thumb ;
@ -144,17 +132,10 @@ M: elevator layout*
dup elevator>> over thumb>> add-gadget dup elevator>> over thumb>> add-gadget
@center grid-add* ; @center grid-add* ;
: <left-button> ( -- button ) : <left-button> ( -- button ) { 0 1 } arrow-left -1 <slide-button> ;
{ 0 1 } arrow-left -1 <slide-button> ; : <right-button> ( -- button ) { 0 1 } arrow-right 1 <slide-button> ;
: <up-button> ( -- button ) { 1 0 } arrow-up -1 <slide-button> ;
: <right-button> ( -- button ) : <down-button> ( -- button ) { 1 0 } arrow-down 1 <slide-button> ;
{ 0 1 } arrow-right 1 <slide-button> ;
: <up-button> ( -- button )
{ 1 0 } arrow-up -1 <slide-button> ;
: <down-button> ( -- button )
{ 1 0 } arrow-down 1 <slide-button> ;
: <slider> ( range orientation -- slider ) : <slider> ( range orientation -- slider )
slider new-frame slider new-frame