factor/extra/trails/trails.factor

54 lines
1.6 KiB
Factor
Raw Normal View History

2017-01-22 18:06:01 -05:00
USING: accessors arrays calendar circular colors
colors.constants fry kernel locals math math.order math.vectors
2019-04-21 12:53:47 -04:00
namespaces opengl processing.shapes sequences timers ui
2017-01-22 18:06:01 -05:00
ui.gadgets ui.gestures ui.render ;
2008-12-08 22:30:10 -05:00
IN: trails
! Example 33-15 from the Processing book
2017-01-22 18:06:01 -05:00
: mouse ( -- point )
! Return the mouse location relative to the current gadget
hand-loc get hand-gadget get screen-loc v- ;
2008-12-08 22:30:10 -05:00
: percent->radius ( percent -- radius ) neg 1 + 25 * 5 max ;
: dot ( pos percent -- )
'[ _ percent->radius draw-circle ] when* ;
2008-12-08 22:30:10 -05:00
2018-01-22 15:27:46 -05:00
TUPLE: trails-gadget < gadget points timer ;
2018-01-22 15:22:46 -05:00
M: trails-gadget graft*
2019-04-21 14:07:28 -04:00
[ timer>> start-timer ] [ call-next-method ] bi ;
2018-01-22 15:22:46 -05:00
M: trails-gadget ungraft*
2018-01-22 15:27:46 -05:00
[ timer>> stop-timer ] [ call-next-method ] bi ;
2008-12-08 22:30:10 -05:00
:: iterate-system ( GADGET -- )
2017-01-22 18:06:01 -05:00
! Add a valid point if the mouse is in the gadget
! Otherwise, add an "invisible" point
hand-gadget get GADGET = [ mouse ] [ f ] if
2017-01-22 18:06:01 -05:00
GADGET points>> circular-push ;
2008-12-08 22:30:10 -05:00
2017-01-22 18:06:01 -05:00
M: trails-gadget pref-dim* drop { 500 500 } ;
2008-12-08 22:30:10 -05:00
: each-percent ( seq quot -- )
2017-01-22 18:06:01 -05:00
[ dup length ] dip '[ 1 + _ / @ ] each-index ; inline
M:: trails-gadget draw-gadget* ( GADGET -- )
T{ rgba f 1 1 1 0.4 } fill-color set ! White, with some transparency
T{ rgba f 0 0 0 0 } stroke-color set ! no stroke
COLOR: black gl-clear
GADGET points>> [ dot ] each-percent ;
2008-12-08 22:30:10 -05:00
: <trails-gadget> ( -- trails-gadget )
2017-01-22 18:06:01 -05:00
trails-gadget new
300 f <array> <circular> >>points
2017-01-22 18:06:01 -05:00
t >>clipped?
2018-01-22 15:22:46 -05:00
dup '[ _ dup iterate-system relayout-1 ]
f 10 milliseconds <timer> >>timer ;
2008-12-08 22:30:10 -05:00
2016-04-21 20:00:06 -04:00
MAIN-WINDOW: trails-window
{ { title "Trails" } }
<trails-gadget> >>gadgets ;