processing: Update to use 'processing.shapes'
Eduardo Cavazos
parent
4f10ed4aaf
commit
ac23f41198
extra/processing
|
|
@ -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 ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
|
|
|||
Loading…
Reference in New Issue