extra/trails/trails.factor

   1 USING: accessors arrays calendar circular colors kernel locals
   2 math math.order math.vectors namespaces opengl processing.shapes
   3 sequences timers ui ui.gadgets ui.gestures ui.render ;
   4
   5 IN: trails
   6
   7 ! Example 33-15 from the Processing book
   8
   9 : mouse ( -- point )
  10     ! Return the mouse location relative to the current gadget
  11     hand-loc get hand-gadget get screen-loc v- ;
  12
  13 : percent->radius ( percent -- radius ) neg 1 + 25 * 5 max ;
  14
  15 : dot ( pos percent -- )
  16     '[ _ percent->radius draw-circle ] when* ;
  17
  18 TUPLE: trails-gadget < gadget points timer ;
  19
  20 M: trails-gadget graft*
  21     [ timer>> start-timer ] [ call-next-method ] bi ;
  22
  23 M: trails-gadget ungraft*
  24     [ timer>> stop-timer ] [ call-next-method ] bi ;
  25
  26 :: iterate-system ( GADGET -- )
  27     ! Add a valid point if the mouse is in the gadget
  28     ! Otherwise, add an "invisible" point
  29     hand-gadget get GADGET = [ mouse ] [ f ] if
  30     GADGET points>> circular-push ;
  31
  32 M: trails-gadget pref-dim* drop { 500 500 } ;
  33
  34 : each-percent ( seq quot -- )
  35     [ dup length ] dip '[ 1 + _ / @ ] each-index ; inline
  36
  37 M:: trails-gadget draw-gadget* ( GADGET -- )
  38     T{ rgba f 1 1 1 0.4 } fill-color set   ! White, with some transparency
  39     T{ rgba f 0 0 0 0   } stroke-color set ! no stroke
  40     COLOR: black gl-clear
  41     GADGET points>> [ dot ] each-percent ;
  42
  43 : <trails-gadget> ( -- trails-gadget )
  44     trails-gadget new
  45         300 f <array> <circular> >>points
  46         t >>clipped?
  47         dup '[ _ dup iterate-system relayout-1 ]
  48         f 10 milliseconds <timer> >>timer ;
  49
  50 MAIN-WINDOW: trails-window
  51     { { title "Trails" } }
  52     <trails-gadget> >>gadgets ;