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

ui.gadgets.scrollers: rewrite new-scroller

db4
Eduardo Cavazos 2008-07-14 17:48:59 -05:00
parent 779dbb9ee6
commit 199a7580d6
1 changed files with 11 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
extra/ui/gadgets/scrollers/scrollers.factor
View File

@ -29,30 +29,22 @@ scroller H{
{ T{ mouse-scroll } [ do-mouse-scroll ] } { T{ mouse-scroll } [ do-mouse-scroll ] }
} set-gestures } set-gestures
: viewport, ( child -- )
g model>> <viewport>
g-> set-scroller-viewport @center frame, ;
: <scroller-model> ( -- model ) : <scroller-model> ( -- model )
0 0 0 0 <range> 0 0 0 0 <range> 2array <compose> ; 0 0 0 0 <range> 0 0 0 0 <range> 2array <compose> ;
: x-model ( -- model ) g model>> dependencies>> first ;
: y-model ( -- model ) g model>> dependencies>> second ;
: new-scroller ( gadget class -- scroller ) : new-scroller ( gadget class -- scroller )
new-frame new-frame
t >>root? t >>root?
<scroller-model> >>model <scroller-model> >>model
faint-boundary faint-boundary
[
x-model <x-slider> g-> set-scroller-x @bottom frame,
y-model <y-slider> g-> set-scroller-y @right frame,
viewport,
] make-gadget ;
: <scroller> ( gadget -- scroller ) dup model>> dependencies>> first <x-slider> >>x dup x>> @bottom grid-add*
scroller new-scroller ; dup model>> dependencies>> second <y-slider> >>y dup y>> @right grid-add*
swap over model>> <viewport> >>viewport
dup viewport>> @center grid-add* ;
: <scroller> ( gadget -- scroller ) scroller new-scroller ;
: scroll ( value scroller -- ) : scroll ( value scroller -- )
[ [