extra/trails/trails.factor

   1
   2 USING: kernel accessors locals namespaces sequences 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 : each-percent ( seq quot -- )
  69   [
  70     dup length
  71     dup [ / ] curry
  72     [ 1+ ] prepose
  73   ] dip compose
  74   2each ;                       inline
  75
  76 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  77
  78 M:: <trails-gadget> draw-gadget* ( GADGET -- )
  79   origin get
  80   [
  81     T{ rgba f 1 1 1 0.4 } \ fill-color set   ! White, with some transparency
  82     T{ rgba f 0 0 0 0   } \ stroke-color set ! no stroke
  83
  84     black gl-clear
  85
  86     GADGET points>> [ dot ] each-percent
  87   ]
  88   with-translation ;
  89
  90 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  91
  92 : trails-gadget ( -- <trails-gadget> )
  93
  94   <trails-gadget> new-gadget
  95
  96     300 point-list >>points
  97
  98     t >>clipped?
  99
 100   dup start-trails-thread ;
 101
 102 : trails-window ( -- ) [ trails-gadget "Trails" open-window ] with-ui ;
 103
 104 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 105
 106 MAIN: trails-window