 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: point* ( x y -- )
-  stroke-color> set-color
-  GL_POINTS glBegin
-    glVertex2d
-  glEnd ;
-
-: point ( seq -- ) first2 point* ;
-
-: line ( x1 y1 x2 y2 -- )
-  stroke-color> set-color
-  GL_LINES glBegin
-    glVertex2d
-    glVertex2d
-  glEnd ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: triangle ( x1 y1 x2 y2 x3 y3 -- )
-
-  GL_FRONT_AND_BACK GL_FILL glPolygonMode
-  fill-color> set-color
-
-  6 ndup
+! : point* ( x y -- )
+!   stroke-color> set-color
+!   GL_POINTS glBegin
+!     glVertex2d
+!   glEnd ;
+
+! : point ( seq -- ) first2 point* ;
+
+! : line ( x1 y1 x2 y2 -- )
+!   stroke-color> set-color
+!   GL_LINES glBegin
+!     glVertex2d
+!     glVertex2d
+!   glEnd ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! : triangle ( x1 y1 x2 y2 x3 y3 -- )
+
+!   GL_FRONT_AND_BACK GL_FILL glPolygonMode
+!   fill-color> set-color
+
+!   6 ndup
   
-  GL_TRIANGLES glBegin
-    glVertex2d
-    glVertex2d
-    glVertex2d
-  glEnd
-
-  GL_FRONT_AND_BACK GL_LINE glPolygonMode
-  stroke-color> set-color
-
-  GL_TRIANGLES glBegin
-    glVertex2d
-    glVertex2d
-    glVertex2d
-  glEnd ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: quad-vertices ( x1 y1 x2 y2 x3 y3 x4 y4 -- )
-  GL_POLYGON glBegin
-    glVertex2d
-    glVertex2d
-    glVertex2d
-    glVertex2d
-  glEnd ;
-
-: quad ( x1 y1 x2 y2 x3 y3 x4 y4 -- )
-
-  8 ndup
-
-  GL_FRONT_AND_BACK GL_FILL glPolygonMode
-  fill-color> set-color
-
-  quad-vertices
+!   GL_TRIANGLES glBegin
+!     glVertex2d
+!     glVertex2d
+!     glVertex2d
+!   glEnd
+
+!   GL_FRONT_AND_BACK GL_LINE glPolygonMode
+!   stroke-color> set-color
+
+!   GL_TRIANGLES glBegin
+!     glVertex2d
+!     glVertex2d
+!     glVertex2d
+!   glEnd ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! : quad-vertices ( x1 y1 x2 y2 x3 y3 x4 y4 -- )
+!   GL_POLYGON glBegin
+!     glVertex2d
+!     glVertex2d
+!     glVertex2d
+!     glVertex2d
+!   glEnd ;
+
+! : quad ( x1 y1 x2 y2 x3 y3 x4 y4 -- )
+
+!   8 ndup
+
+!   GL_FRONT_AND_BACK GL_FILL glPolygonMode
+!   fill-color> set-color
+
+!   quad-vertices
   
-  GL_FRONT_AND_BACK GL_LINE glPolygonMode
-  stroke-color> set-color
-
-  quad-vertices ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: rect-vertices ( x y width height -- )
-  GL_POLYGON glBegin
-    [ 2drop                      glVertex2d ] 4keep
-    [ drop swap >r + 1- r>       glVertex2d ] 4keep
-    [ >r swap >r + 1- r> r> + 1- glVertex2d ] 4keep
-    [ nip + 1-                   glVertex2d ] 4keep
-    4drop
-  glEnd ;
-
-: rect ( x y width height -- )
-
-  4dup
-
-  GL_FRONT_AND_BACK GL_FILL glPolygonMode
-  fill-color> set-color
-
-  rect-vertices
-
-  GL_FRONT_AND_BACK GL_LINE glPolygonMode
-  stroke-color> set-color
-
-  rect-vertices ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: ellipse-disk ( x y width height -- )
-  glPushMatrix
-    >r >r
-    0 glTranslated
-    r> r> 1 glScaled
-    gluNewQuadric
-      dup 0 0.5 20 1 gluDisk
-    gluDeleteQuadric
-  glPopMatrix ;
-
-: ellipse-center ( x y width height -- )
-
-  4dup
-
-  GL_FRONT_AND_BACK GL_FILL glPolygonMode
-  stroke-color> set-color
-
-  ellipse-disk
-
-  GL_FRONT_AND_BACK GL_FILL glPolygonMode
-  fill-color> set-color
-
-  [ 2 - ] bi@ ! [ stroke-width 1+ - ] bi@
-
-  ellipse-disk ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-SYMBOL: CENTER
-SYMBOL: RADIUS
-SYMBOL: CORNER
-SYMBOL: CORNERS
-
-SYMBOL: ellipse-mode-value
-
-: ellipse-mode ( val -- ) ellipse-mode-value set ;
-
-: ellipse-radius ( x y hori vert -- ) [ 2 * ] bi@ ellipse-center ;
-
-: ellipse-corner ( x y width height -- )
-  [ drop nip     2 / + ] 4keep
-  [ nip rot drop 2 / + ] 4keep
-  [ >r >r 2drop r> r>  ] 4keep
-  4drop
-  ellipse-center ;
-
-: ellipse-corners ( x1 y1 x2 y2 -- )
-  [ drop nip     + 2 /    ] 4keep
-  [ nip rot drop + 2 /    ] 4keep
-  [ drop nip     - abs 1+ ] 4keep
-  [ nip rot drop - abs 1+ ] 4keep
-  4drop
-  ellipse-center ;
-
-: ellipse ( a b c d -- )
-  ellipse-mode-value get
-    {
-      { CENTER  [ ellipse-center ] }
-      { RADIUS  [ ellipse-radius ] }
-      { CORNER  [ ellipse-corner ] }
-      { CORNERS [ ellipse-corners ] }
-    }
-  case ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: circle ( pos size -- ) [ first2 ] [ dup ] bi* ellipse ;
+!   GL_FRONT_AND_BACK GL_LINE glPolygonMode
+!   stroke-color> set-color
+
+!   quad-vertices ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! : rect-vertices ( x y width height -- )
+!   GL_POLYGON glBegin
+!     [ 2drop                      glVertex2d ] 4keep
+!     [ drop swap >r + 1- r>       glVertex2d ] 4keep
+!     [ >r swap >r + 1- r> r> + 1- glVertex2d ] 4keep
+!     [ nip + 1-                   glVertex2d ] 4keep
+!     4drop
+!   glEnd ;
+
+! : rect ( x y width height -- )
+
+!   4dup
+
+!   GL_FRONT_AND_BACK GL_FILL glPolygonMode
+!   fill-color> set-color
+
+!   rect-vertices
+
+!   GL_FRONT_AND_BACK GL_LINE glPolygonMode
+!   stroke-color> set-color
+
+!   rect-vertices ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! : ellipse-disk ( x y width height -- )
+!   glPushMatrix
+!     >r >r
+!     0 glTranslated
+!     r> r> 1 glScaled
+!     gluNewQuadric
+!       dup 0 0.5 20 1 gluDisk
+!     gluDeleteQuadric
+!   glPopMatrix ;
+
+! : ellipse-center ( x y width height -- )
+
+!   4dup
+
+!   GL_FRONT_AND_BACK GL_FILL glPolygonMode
+!   stroke-color> set-color
+
+!   ellipse-disk
+
+!   GL_FRONT_AND_BACK GL_FILL glPolygonMode
+!   fill-color> set-color
+
+!   [ 2 - ] bi@ ! [ stroke-width 1+ - ] bi@
+
+!   ellipse-disk ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! SYMBOL: CENTER
+! SYMBOL: RADIUS
+! SYMBOL: CORNER
+! SYMBOL: CORNERS
+
+! SYMBOL: ellipse-mode-value
+
+! : ellipse-mode ( val -- ) ellipse-mode-value set ;
+
+! : ellipse-radius ( x y hori vert -- ) [ 2 * ] bi@ ellipse-center ;
+
+! : ellipse-corner ( x y width height -- )
+!   [ drop nip     2 / + ] 4keep
+!   [ nip rot drop 2 / + ] 4keep
+!   [ >r >r 2drop r> r>  ] 4keep
+!   4drop
+!   ellipse-center ;
+
+! : ellipse-corners ( x1 y1 x2 y2 -- )
+!   [ drop nip     + 2 /    ] 4keep
+!   [ nip rot drop + 2 /    ] 4keep
+!   [ drop nip     - abs 1+ ] 4keep
+!   [ nip rot drop - abs 1+ ] 4keep
+!   4drop
+!   ellipse-center ;
+
+! : ellipse ( a b c d -- )
+!   ellipse-mode-value get
+!     {
+!       { CENTER  [ ellipse-center ] }
+!       { RADIUS  [ ellipse-radius ] }
+!       { CORNER  [ ellipse-corner ] }
+!       { CORNERS [ ellipse-corners ] }
+!     }
+!   case ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! : circle ( pos size -- ) [ first2 ] [ dup ] bi* ellipse ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 

       combinators.cleave
       rewrite-closures fry accessors newfx
       processing.color
       processing.gadget math.geometry.rect ;
       
IN: processing



! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

! VAR: fill-color
! VAR: stroke-color

! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

GENERIC: canonical-color-value ( obj -- color )

METHOD: canonical-color-value { number } dup dup 1 4array ;

METHOD: canonical-color-value { array }
   dup length
   {
     { 2 [ first2 >r dup dup r> 4array ] }
     { 3 [ 1 suffix ] }
     { 4 [ ] }
   }
   case ;

METHOD: canonical-color-value { rgba }
  { [ red>> ] [ green>> ] [ blue>> ] [ alpha>> ] } cleave 4array ;

! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

: fill   ( value -- ) canonical-color-value >fill-color   ;
: stroke ( value -- ) canonical-color-value >stroke-color ;

: no-fill   ( -- ) 0 fill-color>   set-fourth ;
: no-stroke ( -- ) 0 stroke-color> set-fourth ;

! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

