extra/trails/trails.factor

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