Merge branch 'master' of git://factorcode.org/git/factor

extra/processing/gallery/trails/trails.factor

@@ -1,47 +0,0 @@
-
-USING: kernel arrays sequences math math.order qualified
-       sequences.lib circular processing ui newfx processing.shapes ;
-
-IN: processing.gallery.trails
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! Example 33-15 from the Processing book
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: point-list ( n -- seq ) [ drop 0 0 2array ] map <circular> ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: dot ( pos percent -- ) 1 swap - 25 * 5 max circle ;
-
-: step ( seq -- )
-
-  no-stroke
-  { 1 0.4 } fill
-
-  0 background
-
-  mouse push-circular
-    [ dot ]
-  each-percent ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: go* ( -- )
-
-  500 500 size*
-
-  [
-    100 point-list
-      [ step ]
-    curry
-      draw
-  ] setup
-
-  run ;
-
-: go ( -- ) [ go* ] with-ui ;
-
-MAIN: go

extra/trails/trails.factor

@@ -0,0 +1,96 @@
+
+USING: kernel accessors locals namespaces sequences sequences.lib threads
+       math math.order math.vectors
+       calendar
+       colors opengl ui ui.gadgets ui.gestures ui.render
+       circular
+       processing.shapes ;
+
+IN: trails
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! Example 33-15 from the Processing book
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! Return the mouse location relative to the current gadget
+
+: mouse ( -- point ) hand-loc get  hand-gadget get screen-loc  v- ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: point-list ( n -- seq ) [ drop { 0 0 } ] map <circular> ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: percent->radius ( percent -- radius ) neg 1 + 25 * 5 max ;
+
+: dot ( pos percent -- ) percent->radius circle ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+TUPLE: <trails-gadget> < gadget paused points ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+:: iterate-system ( GADGET -- )
+
+  ! Add a valid point if the mouse is in the gadget
+  ! Otherwise, add an "invisible" point
+  
+  hand-gadget get GADGET =
+    [ mouse       GADGET points>> push-circular ]
+    [ { -10 -10 } GADGET points>> push-circular ]
+  if ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+:: start-trails-thread ( GADGET -- )
+  GADGET f >>paused drop
+  [
+    [
+      GADGET paused>>
+        [ f ]
+        [ GADGET iterate-system GADGET relayout-1 1 milliseconds sleep t ]
+      if
+    ]
+    loop
+  ]
+  in-thread ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+M: <trails-gadget> pref-dim* ( <trails-gadget> -- dim ) drop { 500 500 } ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+M:: <trails-gadget> draw-gadget* ( GADGET -- )
+  origin get
+  [
+    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
+    
+    black gl-clear
+
+    GADGET points>> [ dot ] each-percent
+  ]
+  with-translation ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: trails-gadget ( -- <trails-gadget> )
+
+  <trails-gadget> new-gadget
+
+    300 point-list >>points
+
+    t >>clipped?
+
+  dup start-trails-thread ;
+
+: trails-window ( -- ) [ trails-gadget "Trails" open-window ] with-ui ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+MAIN: trails-window