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

diff --git a/extra/processing/shapes/shapes.factor b/extra/processing/shapes/shapes.factor
new file mode 100644 (file)
index 0000000..accb47d
--- /dev/null
+++ b/extra/processing/shapes/shapes.factor
@@ -0,0 +1,125 @@
+
+USING: kernel namespaces arrays sequences grouping
+       alien.c-types
+       math math.vectors math.rectangles
+       opengl.gl opengl.glu opengl generalizations
+       combinators colors sequences.generalizations ;
+USE: shuffle
+IN: processing.shapes
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: do-state ( mode quot -- ) swap glBegin call glEnd ; inline
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+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
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: fill-mode ( -- )
+  GL_FRONT_AND_BACK GL_FILL glPolygonMode
+  fill-color get gl-color ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: stroke-mode ( -- )
+  GL_FRONT_AND_BACK GL_LINE glPolygonMode
+  stroke-color get gl-color ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: gl-vertex-2d ( vertex -- ) first2 glVertex2d ;
+
+: gl-vertices-2d ( vertices -- ) [ gl-vertex-2d ] each ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: point* ( x y    -- ) stroke-mode GL_POINTS [ glVertex2d     ] do-state ;
+: point  ( point  -- ) stroke-mode GL_POINTS [ gl-vertex-2d   ] do-state ;
+: points ( points -- ) stroke-mode GL_POINTS [ gl-vertices-2d ] do-state ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: line** ( x y x y -- )
+  stroke-mode GL_LINES [ glVertex2d glVertex2d ] do-state ;
+
+: line* ( a b -- ) stroke-mode GL_LINES [ [ gl-vertex-2d ] bi@ ] do-state ;
+
+: lines ( seq -- ) stroke-mode GL_LINES [ gl-vertices-2d ] do-state ;
+
+: line ( seq -- ) lines ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: line-strip ( seq -- ) stroke-mode GL_LINE_STRIP [ gl-vertices-2d ] do-state ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: triangles ( seq -- )
+  [ fill-mode   GL_TRIANGLES [ gl-vertices-2d ] do-state ]
+  [ stroke-mode GL_TRIANGLES [ gl-vertices-2d ] do-state ] bi ;
+
+: triangle ( seq -- ) triangles ;
+
+: triangle* ( a b c -- ) 3array triangles ;
+
+: triangle** ( x y x y x y -- ) 6 narray 2 group triangles ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: polygon ( seq -- )
+  [ fill-mode   GL_POLYGON [ gl-vertices-2d ] do-state ]
+  [ stroke-mode GL_POLYGON [ gl-vertices-2d ] do-state ] bi ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+:: 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 ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: gl-translate-2d ( pos -- ) first2 0 glTranslated ;
+
+: gl-scale-2d ( xy -- ) first2 1 glScaled ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: gl-ellipse ( center dim -- )
+  glPushMatrix
+    [ gl-translate-2d ] [ gl-scale-2d ] bi*
+    gluNewQuadric
+      dup 0 0.5 20 1 gluDisk
+    gluDeleteQuadric
+  glPopMatrix ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: gl-get-line-width ( -- width )
+  GL_LINE_WIDTH 0 double <ref> tuck glGetDoublev double deref ;
+
+: ellipse ( center dim -- )
+  GL_FRONT_AND_BACK GL_FILL glPolygonMode
+  [ stroke-color get gl-color                                 gl-ellipse ]
+  [ fill-color get gl-color gl-get-line-width 2 * dup 2array v- gl-ellipse ] 2bi ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: circle ( center size -- ) dup 2array ellipse ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+

diff --git a/extra/trails/trails.factor b/extra/trails/trails.factor
new file mode 100644 (file)
index 0000000..704648c
--- /dev/null
+++ b/extra/trails/trails.factor
@@ -0,0 +1,99 @@
+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
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! 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 ) [ { 0 0 } ] replicate <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>> circular-push ]
+    [ { -10 -10 } GADGET points>> circular-push ]
+  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 } ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: each-percent ( seq quot -- )
+  [
+    dup length
+    [ iota ] [ [ / ] curry ] bi
+    [ 1 + ] prepose
+  ] dip compose
+  2each ;                       inline
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+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
+
+    COLOR: black gl-clear
+
+    GADGET points>> [ dot ] each-percent ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: <trails-gadget> ( -- trails-gadget )
+
+  trails-gadget new
+
+    300 point-list >>points
+
+    t >>clipped?
+
+  dup start-trails-thread ;
+
+: trails-window ( -- ) [ <trails-gadget> "Trails" open-window ] with-ui ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+MAIN: trails-window

diff --git a/unmaintained/processing/shapes/shapes.factor b/unmaintained/processing/shapes/shapes.factor
deleted file mode 100644 (file)
index 51979dc..0000000
--- a/unmaintained/processing/shapes/shapes.factor
+++ /dev/null
@@ -1,120 +0,0 @@
-
-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 ;
-
-IN: processing.shapes
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: do-state ( mode quot -- ) swap glBegin call glEnd ; inline
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-VAR: fill-color
-VAR: stroke-color
-
-T{ rgba f 0 0 0 1 } stroke-color set-global
-T{ rgba f 1 1 1 1 } fill-color   set-global
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: fill-mode ( -- )
-  GL_FRONT_AND_BACK GL_FILL glPolygonMode
-  fill-color> gl-color ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: stroke-mode ( -- )
-  GL_FRONT_AND_BACK GL_LINE glPolygonMode
-  stroke-color> gl-color ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: gl-vertex-2d ( vertex -- ) first2 glVertex2d ;
-
-: gl-vertices-2d ( vertices -- ) [ gl-vertex-2d ] each ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: point* ( x y    -- ) stroke-mode GL_POINTS [ glVertex2d     ] do-state ;
-: point  ( point  -- ) stroke-mode GL_POINTS [ gl-vertex-2d   ] do-state ;
-: points ( points -- ) stroke-mode GL_POINTS [ gl-vertices-2d ] do-state ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: line** ( x y x y -- )
-  stroke-mode GL_LINES [ glVertex2d glVertex2d ] do-state ;
-
-: line* ( a b -- ) stroke-mode GL_LINES [ [ gl-vertex-2d ] bi@ ] do-state ;
-
-: lines ( seq -- ) stroke-mode GL_LINES [ gl-vertices-2d ] do-state ;
-
-: line ( seq -- ) lines ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: line-strip ( seq -- ) stroke-mode GL_LINE_STRIP [ gl-vertices-2d ] do-state ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: triangles ( seq -- )
-  [ fill-mode   GL_TRIANGLES [ gl-vertices-2d ] do-state ]
-  [ stroke-mode GL_TRIANGLES [ gl-vertices-2d ] do-state ] bi ;
-
-: triangle ( seq -- ) triangles ;
-
-: triangle* ( a b c -- ) 3array triangles ;
-
-: triangle** ( x y x y x y -- ) 6 narray 2 group triangles ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: polygon ( seq -- )
-  [ fill-mode   GL_POLYGON [ gl-vertices-2d ] do-state ]
-  [ stroke-mode GL_POLYGON [ gl-vertices-2d ] do-state ] bi ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: rectangle ( loc dim -- )
-  <rect>
-    { top-left top-right bottom-right bottom-left }
-  1arr
-  polygon ;
-
-: rectangle* ( x y width height -- ) [ 2array ] 2bi@ rectangle ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: gl-translate-2d ( pos -- ) first2 0 glTranslated ;
-
-: gl-scale-2d ( xy -- ) first2 1 glScaled ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: gl-ellipse ( center dim -- )
-  glPushMatrix
-    [ gl-translate-2d ] [ gl-scale-2d ] bi*
-    gluNewQuadric
-      dup 0 0.5 20 1 gluDisk
-    gluDeleteQuadric
-  glPopMatrix ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: gl-get-line-width ( -- width )
-  GL_LINE_WIDTH 0 <double> tuck glGetDoublev *double ;
-
-: 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 ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: circle ( center size -- ) dup 2array ellipse ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-

diff --git a/unmaintained/trails/trails.factor b/unmaintained/trails/trails.factor
deleted file mode 100644 (file)
index 15b8a68..0000000
--- a/unmaintained/trails/trails.factor
+++ /dev/null
@@ -1,106 +0,0 @@
-
-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 ;
-
-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 } ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: each-percent ( seq quot -- )
-  [
-    dup length
-    dup [ / ] curry
-    [ 1+ ] prepose
-  ] dip compose
-  2each ;                       inline
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-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
\ No newline at end of file