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

trails: use timers instead of threads.

factor-shell
John Benediktsson 2018-01-22 12:22:46 -08:00
parent b43c652f68
commit e9ab434dd4
1 changed files with 10 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
extra/trails/trails.factor
View File

@ -1,6 +1,6 @@
USING: accessors arrays calendar circular colors USING: accessors arrays calendar circular colors
colors.constants fry kernel locals math math.order math.vectors colors.constants fry kernel locals math math.order math.vectors
namespaces opengl processing.shapes sequences threads ui namespaces opengl processing.shapes sequences threads timers ui
ui.gadgets ui.gestures ui.render ; ui.gadgets ui.gestures ui.render ;
IN: trails IN: trails
@ -17,7 +17,13 @@ IN: trails
: dot ( pos percent -- ) percent->radius draw-circle ; : dot ( pos percent -- ) percent->radius draw-circle ;
TUPLE: trails-gadget < gadget paused points ; TUPLE: trails-gadget < gadget paused points timer ;
M: trails-gadget graft*
[ timer>> start-timer yield ] [ call-next-method ] bi ;
M: trails-gadget ungraft*
[ timer>> stop-timer ] [ t >>paused call-next-method ] bi ;
:: iterate-system ( GADGET -- ) :: iterate-system ( GADGET -- )
! Add a valid point if the mouse is in the gadget ! Add a valid point if the mouse is in the gadget
@ -25,20 +31,6 @@ TUPLE: trails-gadget < gadget paused points ;
hand-gadget get GADGET = [ mouse ] [ { -10 -10 } ] if hand-gadget get GADGET = [ mouse ] [ { -10 -10 } ] if
GADGET points>> circular-push ; GADGET points>> circular-push ;
:: start-trails-thread ( GADGET -- )
GADGET f >>paused drop
[
[
GADGET paused>>
[ f ]
[ GADGET iterate-system GADGET relayout-1 1 milliseconds sleep t ]
if
]
loop
] "trails" spawn drop ;
M: trails-gadget ungraft* t >>paused drop ;
M: trails-gadget pref-dim* drop { 500 500 } ; M: trails-gadget pref-dim* drop { 500 500 } ;
: each-percent ( seq quot -- ) : each-percent ( seq quot -- )
@ -54,7 +46,8 @@ M:: trails-gadget draw-gadget* ( GADGET -- )
trails-gadget new trails-gadget new
300 point-list >>points 300 point-list >>points
t >>clipped? t >>clipped?
dup start-trails-thread ; dup '[ _ dup iterate-system relayout-1 ]
f 10 milliseconds <timer> >>timer ;
MAIN-WINDOW: trails-window MAIN-WINDOW: trails-window
{ { title "Trails" } } { { title "Trails" } }