unmaintained: restoring trails, which is a neat processing demo.

slavapestov · Oct 25, 2014 · e9c0fe0 · e9c0fe0
1 parent e9cdfcb
commit e9c0fe0
Show file tree

Hide file tree

Showing 2 changed files with 40 additions and 42 deletions.
diff --git a/unmaintained/processing/shapes/shapes.factor → extra/processing/shapes/shapes.factor b/unmaintained/processing/shapes/shapes.factor → extra/processing/shapes/shapes.factor
@@ -1,10 +1,10 @@
 
 USING: kernel namespaces arrays sequences grouping
        alien.c-types
-       math math.vectors math.geometry.rect
-       opengl.gl opengl.glu opengl generalizations vars
-       combinators.cleave colors ;
-
+       math math.vectors math.rectangles
+       opengl.gl opengl.glu opengl generalizations
+       combinators colors sequences.generalizations ;
+USE: shuffle
 IN: processing.shapes
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -13,8 +13,8 @@ IN: processing.shapes
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-VAR: fill-color
-VAR: stroke-color
+SYMBOL: fill-color
+SYMBOL: stroke-color
 
 T{ rgba f 0 0 0 1 } stroke-color set-global
 T{ rgba f 1 1 1 1 } fill-color   set-global
@@ -23,13 +23,13 @@ T{ rgba f 1 1 1 1 } fill-color   set-global
 
 : fill-mode ( -- )
   GL_FRONT_AND_BACK GL_FILL glPolygonMode
-  fill-color> gl-color ;
+  fill-color get gl-color ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : stroke-mode ( -- )
   GL_FRONT_AND_BACK GL_LINE glPolygonMode
-  stroke-color> gl-color ;
+  stroke-color get gl-color ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -78,11 +78,16 @@ T{ rgba f 1 1 1 1 } fill-color   set-global
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: rectangle ( loc dim -- )
-  <rect>
-    { top-left top-right bottom-right bottom-left }
-  1arr
-  polygon ;
+:: rectangle ( loc dim -- )
+    loc first2 :> ( x y )
+    dim first2 :> ( dx dy )
+
+    x y 2array
+    x dx + y 2array
+    x y dy + 2array
+    x dx + y dy + 2array
+    4array
+    polygon ;
 
 : rectangle* ( x y width height -- ) [ 2array ] 2bi@ rectangle ;
 
@@ -105,12 +110,12 @@ T{ rgba f 1 1 1 1 } fill-color   set-global
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : gl-get-line-width ( -- width )
-  GL_LINE_WIDTH 0 <double> tuck glGetDoublev *double ;
+  GL_LINE_WIDTH 0 double <ref> tuck glGetDoublev double deref ;
 
 : ellipse ( center dim -- )
   GL_FRONT_AND_BACK GL_FILL glPolygonMode
-  [ stroke-color> gl-color                                 gl-ellipse ]
-  [ fill-color> gl-color gl-get-line-width 2 * dup 2array v- gl-ellipse ] 2bi ;
+  [ stroke-color get gl-color                                 gl-ellipse ]
+  [ fill-color get gl-color gl-get-line-width 2 * dup 2array v- gl-ellipse ] 2bi ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 

diff --git a/unmaintained/trails/trails.factor → extra/trails/trails.factor b/unmaintained/trails/trails.factor → extra/trails/trails.factor
@@ -1,10 +1,7 @@
-
-USING: kernel accessors locals namespaces sequences threads
-       math math.order math.vectors
-       calendar
-       colors opengl ui ui.gadgets ui.gestures ui.render
-       circular
-       processing.shapes ;
+USING: accessors calendar circular colors colors.constants
+kernel locals math math.order math.vectors namespaces opengl
+processing.shapes sequences threads ui ui.gadgets ui.gestures
+ui.render ;
 
 IN: trails
 
@@ -20,7 +17,7 @@ IN: trails
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: point-list ( n -- seq ) [ drop { 0 0 } ] map <circular> ;
+: point-list ( n -- seq ) [ { 0 0 } ] replicate <circular> ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -30,7 +27,7 @@ IN: trails
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-TUPLE: <trails-gadget> < gadget paused points ;
+TUPLE: trails-gadget < gadget paused points ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -40,8 +37,8 @@ TUPLE: <trails-gadget> < gadget paused points ;
   ! Otherwise, add an "invisible" point
 
   hand-gadget get GADGET =
-    [ mouse       GADGET points>> push-circular ]
-    [ { -10 -10 } GADGET points>> push-circular ]
+    [ mouse       GADGET points>> circular-push ]
+    [ { -10 -10 } GADGET points>> circular-push ]
   if ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -61,46 +58,42 @@ TUPLE: <trails-gadget> < gadget paused points ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-M: <trails-gadget> pref-dim* ( <trails-gadget> -- dim ) drop { 500 500 } ;
+M: trails-gadget pref-dim* ( trails-gadget -- dim ) drop { 500 500 } ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : each-percent ( seq quot -- )
   [
     dup length
-    dup [ / ] curry
-    [ 1+ ] prepose
+    [ iota ] [ [ / ] curry ] bi
+    [ 1 + ] prepose
   ] dip compose
   2each ;                       inline
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-M:: <trails-gadget> draw-gadget* ( GADGET -- )
-  origin get
-  [
+M:: trails-gadget draw-gadget* ( GADGET -- )
     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 ;
+    COLOR: black gl-clear
+
+    GADGET points>> [ dot ] each-percent ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: trails-gadget ( -- <trails-gadget> )
+: <trails-gadget> ( -- trails-gadget )
 
-  <trails-gadget> new-gadget
+  trails-gadget new
 
     300 point-list >>points
 
     t >>clipped?
 
   dup start-trails-thread ;
 
-: trails-window ( -- ) [ trails-gadget "Trails" open-window ] with-ui ;
+: trails-window ( -- ) [ <trails-gadget> "Trails" open-window ] with-ui ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-MAIN: trails-window
+MAIN: trails-window