From ac23f41198acd8a786d24bac458425f4377b0f88 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 28 Jul 2008 12:54:21 -0500 Subject: [PATCH] processing: Update to use 'processing.shapes' --- extra/processing/processing.factor | 274 ++++++++++++++--------------- 1 file changed, 128 insertions(+), 146 deletions(-) diff --git a/extra/processing/processing.factor b/extra/processing/processing.factor index f786628c79..bcfe314d45 100644 --- a/extra/processing/processing.factor +++ b/extra/processing/processing.factor @@ -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 ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!