extra/trails/trails.factor

   1
   2 USING: kernel accessors locals namespaces sequences sequences.lib threads
   3        math math.order math.vectors
   4        calendar
   5        colors opengl ui ui.gadgets ui.gestures ui.render
   6        circular
   7        processing.shapes ;
   8
   9 IN: trails
  10
  11 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  12
  13 ! Example 33-15 from the Processing book
  14
  15 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  16
  17 ! Return the mouse location relative to the current gadget
  18
  19 : mouse ( -- point ) hand-loc get  hand-gadget get screen-loc  v- ;
  20
  21 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  22
  23 : point-list ( n -- seq ) [ drop { 0 0 } ] map <circular> ;
  24
  25 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  26
  27 : percent->radius ( percent -- radius ) neg 1 + 25 * 5 max ;
  28
  29 : dot ( pos percent -- ) percent->radius circle ;
  30
  31 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  32
  33 TUPLE: <trails-gadget> < gadget paused points ;
  34
  35 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  36
  37 :: iterate-system ( GADGET -- )
  38
  39   ! Add a valid point if the mouse is in the gadget
  40   ! Otherwise, add an "invisible" point
  41
  42   hand-gadget get GADGET =
  43     [ mouse       GADGET points>> push-circular ]
  44     [ { -10 -10 } GADGET points>> push-circular ]
  45   if ;
  46
  47 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  48
  49 :: start-trails-thread ( GADGET -- )
  50   GADGET f >>paused drop
  51   [
  52     [
  53       GADGET paused>>
  54         [ f ]
  55         [ GADGET iterate-system GADGET relayout-1 1 milliseconds sleep t ]
  56       if
  57     ]
  58     loop
  59   ]
  60   in-thread ;
  61
  62 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  63
  64 M: <trails-gadget> pref-dim* ( <trails-gadget> -- dim ) drop { 500 500 } ;
  65
  66 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  67
  68 M:: <trails-gadget> draw-gadget* ( GADGET -- )
  69   origin get
  70   [
  71     T{ rgba f 1 1 1 0.4 } \ fill-color set   ! White, with some transparency
  72     T{ rgba f 0 0 0 0   } \ stroke-color set ! no stroke
  73
  74     black gl-clear
  75
  76     GADGET points>> [ dot ] each-percent
  77   ]
  78   with-translation ;
  79
  80 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  81
  82 : trails-gadget ( -- <trails-gadget> )
  83
  84   <trails-gadget> new-gadget
  85
  86     300 point-list >>points
  87
  88     t >>clipped?
  89
  90   dup start-trails-thread ;
  91
  92 : trails-window ( -- ) [ trails-gadget "Trails" open-window ] with-ui ;
  93
  94 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  95
  96 MAIN: trails-window