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

ui.gadgets.sliders: refactor

db4
Eduardo Cavazos 2008-07-14 18:24:55 -05:00
parent 18d19fec92
commit c7ed4dd679
1 changed files with 13 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -138,10 +138,11 @@ M: elevator layout*
[ swap find-slider slide-by-line ] curry <repeat-button> [ swap find-slider slide-by-line ] curry <repeat-button>
[ set-gadget-orientation ] keep ; [ set-gadget-orientation ] keep ;
: elevator, ( orientation -- ) : elevator, ( gadget orientation -- gadget )
dup <elevator> g-> set-slider-elevator tuck <elevator> >>elevator
swap <thumb> g-> set-slider-thumb add-gadget swap <thumb> >>thumb
@center frame, ; dup elevator>> over thumb>> add-gadget
@center grid-add* ;
: <left-button> ( -- button ) : <left-button> ( -- button )
{ 0 1 } arrow-left -1 <slide-button> ; { 0 1 } arrow-left -1 <slide-button> ;
@ -149,26 +150,12 @@ M: elevator layout*
: <right-button> ( -- button ) : <right-button> ( -- button )
{ 0 1 } arrow-right 1 <slide-button> ; { 0 1 } arrow-right 1 <slide-button> ;
: build-x-slider ( slider -- slider )
[
<left-button> @left frame,
{ 0 1 } elevator,
<right-button> @right frame,
] make-gadget ; inline
: <up-button> ( -- button ) : <up-button> ( -- button )
{ 1 0 } arrow-up -1 <slide-button> ; { 1 0 } arrow-up -1 <slide-button> ;
: <down-button> ( -- button ) : <down-button> ( -- button )
{ 1 0 } arrow-down 1 <slide-button> ; { 1 0 } arrow-down 1 <slide-button> ;
: build-y-slider ( slider -- slider )
[
<up-button> @top frame,
{ 1 0 } elevator,
<down-button> @bottom frame,
] make-gadget ; inline
: <slider> ( range orientation -- slider ) : <slider> ( range orientation -- slider )
slider new-frame slider new-frame
swap >>orientation swap >>orientation
@ -176,10 +163,16 @@ M: elevator layout*
32 >>line ; 32 >>line ;
: <x-slider> ( range -- slider ) : <x-slider> ( range -- slider )
{ 1 0 } <slider> build-x-slider ; { 1 0 } <slider>
<left-button> @left grid-add*
{ 0 1 } elevator,
<right-button> @right grid-add* ;
: <y-slider> ( range -- slider ) : <y-slider> ( range -- slider )
{ 0 1 } <slider> build-y-slider ; { 0 1 } <slider>
<up-button> @top grid-add*
{ 1 0 } elevator,
<down-button> @bottom grid-add* ;
M: slider pref-dim* M: slider pref-dim*
dup call-next-method dup call-next-method