From 1c091ed24b04cc85f639616af2e0ba80d71aef1b Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 28 Jul 2008 00:48:29 -0500
Subject: [PATCH] processing.shapes: Factor out shape drawing code. It is not
 specific to processing.

---
 extra/processing/shapes/shapes.factor | 112 ++++++++++++++++++++++++++
 1 file changed, 112 insertions(+)
 create mode 100644 extra/processing/shapes/shapes.factor

diff --git a/extra/processing/shapes/shapes.factor b/extra/processing/shapes/shapes.factor
new file mode 100644
index 0000000000..6f680a87e6
--- /dev/null
+++ b/extra/processing/shapes/shapes.factor
@@ -0,0 +1,112 @@
+
+USING: kernel namespaces arrays sequences grouping
+       alien.c-types
+       math math.vectors math.geometry.rect
+       opengl.gl opengl.glu opengl generalizations vars
+       combinators.cleave  ;
+
+IN: processing.shapes
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+VAR: fill-color
+VAR: stroke-color
+
+{ 0 0 0 1 } stroke-color set-global
+{ 1 1 1 1 } fill-color   set-global
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: fill-mode ( -- )
+  GL_FRONT_AND_BACK GL_FILL glPolygonMode
+  fill-color> first4 glColor4d ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: stroke-mode ( -- )
+  GL_FRONT_AND_BACK GL_LINE glPolygonMode
+  stroke-color> first4 glColor4d ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: 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 ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: 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 ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+