processing: Update to use 'processing.shapes'

db4
Eduardo Cavazos 2008-07-28 12:54:21 -05:00
parent 4f10ed4aaf
commit ac23f41198
1 changed files with 128 additions and 146 deletions

View File

@ -10,7 +10,8 @@ USING: kernel namespaces threads combinators sequences arrays
combinators.cleave
rewrite-closures fry accessors newfx
processing.color
processing.gadget math.geometry.rect ;
processing.gadget math.geometry.rect
processing.shapes ;
IN: processing
@ -36,53 +37,34 @@ IN: processing
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
VAR: fill-color
VAR: stroke-color
! VAR: fill-color
! VAR: stroke-color
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
GENERIC: set-color ( value -- )
GENERIC: canonical-color-value ( obj -- color )
METHOD: set-color { number } dup dup glColor3d ;
METHOD: canonical-color-value { number } dup dup 1 4array ;
METHOD: set-color { array }
METHOD: canonical-color-value { array }
dup length
{
{ 2 [ first2 >r dup dup r> glColor4d ] }
{ 3 [ first3 glColor3d ] }
{ 4 [ first4 glColor4d ] }
{ 2 [ first2 >r dup dup r> 4array ] }
{ 3 [ 1 suffix ] }
{ 4 [ ] }
}
case ;
METHOD: set-color { rgba }
{ [ red>> ] [ green>> ] [ blue>> ] [ alpha>> ] } cleave glColor4d ;
METHOD: canonical-color-value { rgba }
{ [ red>> ] [ green>> ] [ blue>> ] [ alpha>> ] } cleave 4array ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: fill ( value -- ) >fill-color ;
: stroke ( value -- ) >stroke-color ;
: fill ( value -- ) canonical-color-value >fill-color ;
: stroke ( value -- ) canonical-color-value >stroke-color ;
: no-fill ( -- )
fill-color>
{
{ [ dup number? ] [ 0 2array fill ] }
{ [ t ]
[
[ drop 0 ] [ length 1- ] [ ] tri set-nth
] }
}
cond ;
: no-stroke ( -- )
stroke-color>
{
{ [ dup number? ] [ 0 2array stroke ] }
{ [ t ]
[
[ drop 0 ] [ length 1- ] [ ] tri set-nth
] }
}
cond ;
: no-fill ( -- ) 0 fill-color> set-fourth ;
: no-stroke ( -- ) 0 stroke-color> set-fourth ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -90,163 +72,163 @@ METHOD: set-color { rgba }
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: point* ( x y -- )
stroke-color> set-color
GL_POINTS glBegin
glVertex2d
glEnd ;
! : point* ( x y -- )
! stroke-color> set-color
! GL_POINTS glBegin
! glVertex2d
! glEnd ;
: point ( seq -- ) first2 point* ;
! : point ( seq -- ) first2 point* ;
: line ( x1 y1 x2 y2 -- )
stroke-color> set-color
GL_LINES glBegin
glVertex2d
glVertex2d
glEnd ;
! : line ( x1 y1 x2 y2 -- )
! stroke-color> set-color
! GL_LINES glBegin
! glVertex2d
! glVertex2d
! glEnd ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: triangle ( x1 y1 x2 y2 x3 y3 -- )
! : triangle ( x1 y1 x2 y2 x3 y3 -- )
GL_FRONT_AND_BACK GL_FILL glPolygonMode
fill-color> set-color
! GL_FRONT_AND_BACK GL_FILL glPolygonMode
! fill-color> set-color
6 ndup
! 6 ndup
GL_TRIANGLES glBegin
glVertex2d
glVertex2d
glVertex2d
glEnd
! GL_TRIANGLES glBegin
! glVertex2d
! glVertex2d
! glVertex2d
! glEnd
GL_FRONT_AND_BACK GL_LINE glPolygonMode
stroke-color> set-color
! GL_FRONT_AND_BACK GL_LINE glPolygonMode
! stroke-color> set-color
GL_TRIANGLES glBegin
glVertex2d
glVertex2d
glVertex2d
glEnd ;
! 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-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 -- )
! : quad ( x1 y1 x2 y2 x3 y3 x4 y4 -- )
8 ndup
! 8 ndup
GL_FRONT_AND_BACK GL_FILL glPolygonMode
fill-color> set-color
! GL_FRONT_AND_BACK GL_FILL glPolygonMode
! fill-color> set-color
quad-vertices
! quad-vertices
GL_FRONT_AND_BACK GL_LINE glPolygonMode
stroke-color> set-color
! GL_FRONT_AND_BACK GL_LINE glPolygonMode
! stroke-color> set-color
quad-vertices ;
! 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-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 -- )
! : rect ( x y width height -- )
4dup
! 4dup
GL_FRONT_AND_BACK GL_FILL glPolygonMode
fill-color> set-color
! GL_FRONT_AND_BACK GL_FILL glPolygonMode
! fill-color> set-color
rect-vertices
! rect-vertices
GL_FRONT_AND_BACK GL_LINE glPolygonMode
stroke-color> set-color
! GL_FRONT_AND_BACK GL_LINE glPolygonMode
! stroke-color> set-color
rect-vertices ;
! 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-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 -- )
! : ellipse-center ( x y width height -- )
4dup
! 4dup
GL_FRONT_AND_BACK GL_FILL glPolygonMode
stroke-color> set-color
! GL_FRONT_AND_BACK GL_FILL glPolygonMode
! stroke-color> set-color
ellipse-disk
! ellipse-disk
GL_FRONT_AND_BACK GL_FILL glPolygonMode
fill-color> set-color
! GL_FRONT_AND_BACK GL_FILL glPolygonMode
! fill-color> set-color
[ 2 - ] bi@ ! [ stroke-width 1+ - ] bi@
! [ 2 - ] bi@ ! [ stroke-width 1+ - ] bi@
ellipse-disk ;
! ellipse-disk ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SYMBOL: CENTER
SYMBOL: RADIUS
SYMBOL: CORNER
SYMBOL: CORNERS
! SYMBOL: CENTER
! SYMBOL: RADIUS
! SYMBOL: CORNER
! SYMBOL: CORNERS
SYMBOL: ellipse-mode-value
! SYMBOL: ellipse-mode-value
: ellipse-mode ( val -- ) ellipse-mode-value set ;
! : ellipse-mode ( val -- ) ellipse-mode-value set ;
: ellipse-radius ( x y hori vert -- ) [ 2 * ] bi@ ellipse-center ;
! : 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-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-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 ;
! : 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 ;
! : circle ( pos size -- ) [ first2 ] [ dup ] bi* ellipse ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -279,8 +261,8 @@ METHOD: background { array }
: mouse ( -- point ) hand-loc get ;
: mouse-x mouse first ;
: mouse-y mouse second ;
: mouse-x ( -- x ) mouse first ;
: mouse-y ( -- y ) mouse second ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -296,9 +278,9 @@ VAR: loop-flag
: defaults ( -- )
0.8 background
0 >stroke-color
1 >fill-color
CENTER ellipse-mode
! 0 >stroke-color
! 1 >fill-color
! CENTER ellipse-mode
60 frame-rate ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!