From ac23f41198acd8a786d24bac458425f4377b0f88 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 28 Jul 2008 12:54:21 -0500 Subject: [PATCH 01/16] 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 ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From fce11759e9e258843d11d7d170712e954d9ac58f Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 28 Jul 2008 12:54:47 -0500 Subject: [PATCH 02/16] processing.gallery.trails: Update for processing changes --- extra/processing/gallery/trails/trails.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/processing/gallery/trails/trails.factor b/extra/processing/gallery/trails/trails.factor index 5abe23bb90..a5b2b7b02a 100644 --- a/extra/processing/gallery/trails/trails.factor +++ b/extra/processing/gallery/trails/trails.factor @@ -1,6 +1,6 @@ USING: kernel arrays sequences math math.order qualified - sequences.lib circular processing ui newfx ; + sequences.lib circular processing ui newfx processing.shapes ; IN: processing.gallery.trails From 72344abf718dc39a2c6404f6cf7d6d94ff797c87 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 28 Jul 2008 12:55:08 -0500 Subject: [PATCH 03/16] bubble-chamber: Update for processing changes --- extra/bubble-chamber/particle/axion/axion.factor | 3 ++- extra/bubble-chamber/particle/hadron/hadron.factor | 2 +- extra/bubble-chamber/particle/muon/muon.factor | 1 + extra/bubble-chamber/particle/quark/quark.factor | 2 +- 4 files changed, 5 insertions(+), 3 deletions(-) diff --git a/extra/bubble-chamber/particle/axion/axion.factor b/extra/bubble-chamber/particle/axion/axion.factor index 54865894c6..2dafc36cde 100644 --- a/extra/bubble-chamber/particle/axion/axion.factor +++ b/extra/bubble-chamber/particle/axion/axion.factor @@ -1,7 +1,8 @@ USING: kernel sequences random accessors multi-methods math math.constants math.ranges math.points combinators.cleave - processing bubble-chamber.common bubble-chamber.particle ; + processing processing.shapes + bubble-chamber.common bubble-chamber.particle ; IN: bubble-chamber.particle.axion diff --git a/extra/bubble-chamber/particle/hadron/hadron.factor b/extra/bubble-chamber/particle/hadron/hadron.factor index 9eecf2dd93..10a5431e57 100644 --- a/extra/bubble-chamber/particle/hadron/hadron.factor +++ b/extra/bubble-chamber/particle/hadron/hadron.factor @@ -1,6 +1,6 @@ USING: kernel random math math.constants math.points accessors multi-methods - processing + processing processing.shapes processing.color bubble-chamber.common bubble-chamber.particle ; diff --git a/extra/bubble-chamber/particle/muon/muon.factor b/extra/bubble-chamber/particle/muon/muon.factor index a61526fdf7..c5ee71c1b0 100644 --- a/extra/bubble-chamber/particle/muon/muon.factor +++ b/extra/bubble-chamber/particle/muon/muon.factor @@ -7,6 +7,7 @@ USING: kernel arrays sequences random multi-methods accessors combinators.cleave processing + processing.shapes bubble-chamber.common bubble-chamber.particle bubble-chamber.particle.muon.colors ; diff --git a/extra/bubble-chamber/particle/quark/quark.factor b/extra/bubble-chamber/particle/quark/quark.factor index 595c3b5329..194b97a9cd 100644 --- a/extra/bubble-chamber/particle/quark/quark.factor +++ b/extra/bubble-chamber/particle/quark/quark.factor @@ -1,6 +1,6 @@ USING: kernel arrays sequences random math accessors multi-methods - processing + processing processing.shapes bubble-chamber.common bubble-chamber.particle ; From e10507e9ad146c342aec1fabdb1b2c557389466d Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 28 Jul 2008 12:58:30 -0500 Subject: [PATCH 04/16] processing: Minor cleanups --- extra/processing/processing.factor | 81 ------------------------------ 1 file changed, 81 deletions(-) diff --git a/extra/processing/processing.factor b/extra/processing/processing.factor index bcfe314d45..f365f80d78 100644 --- a/extra/processing/processing.factor +++ b/extra/processing/processing.factor @@ -37,11 +37,6 @@ IN: processing ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! VAR: fill-color -! VAR: stroke-color - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - GENERIC: canonical-color-value ( obj -- color ) METHOD: canonical-color-value { number } dup dup 1 4array ; @@ -72,47 +67,6 @@ METHOD: canonical-color-value { rgba } ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! : 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 @@ -137,31 +91,6 @@ METHOD: canonical-color-value { rgba } ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! : 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 @@ -228,14 +157,6 @@ METHOD: canonical-color-value { rgba } ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! : circle ( pos size -- ) [ first2 ] [ dup ] bi* ellipse ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -USING: multi-methods ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - GENERIC: background ( value -- ) METHOD: background { number } @@ -278,8 +199,6 @@ VAR: loop-flag : defaults ( -- ) 0.8 background - ! 0 >stroke-color - ! 1 >fill-color ! CENTER ellipse-mode 60 frame-rate ; From e9e1313b6cbdaa2e5edad6179136149b6a3eeb63 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 28 Jul 2008 14:19:11 -0500 Subject: [PATCH 05/16] colors: Add color tuples --- extra/colors/colors.factor | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) diff --git a/extra/colors/colors.factor b/extra/colors/colors.factor index 911f3d0b59..f8de326b4d 100644 --- a/extra/colors/colors.factor +++ b/extra/colors/colors.factor @@ -1,7 +1,43 @@ ! Copyright (C) 2003, 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. + +USING: kernel combinators sequences arrays + classes.tuple multi-methods accessors colors.hsv ; + IN: colors +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +TUPLE: color ; + +TUPLE: rgba < color red green blue alpha ; + +TUPLE: hsva < color hue saturation value alpha ; + +TUPLE: grey < color grey alpha ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +GENERIC: >rgba ( object -- rgba ) + +METHOD: >rgba { rgba } ; + +METHOD: >rgba { hsva } + { [ hue>> ] [ saturation>> ] [ value>> ] [ alpha>> ] } cleave 4array + [ hsv>rgb ] [ peek ] bi suffix first4 rgba boa ; + +METHOD: >rgba { grey } [ grey>> dup dup ] [ alpha>> ] bi rgba boa ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +USE: syntax + +M: color red>> >rgba red>> ; +M: color green>> >rgba green>> ; +M: color blue>> >rgba blue>> ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + : black { 0.0 0.0 0.0 1.0 } ; : blue { 0.0 0.0 1.0 1.0 } ; : cyan { 0 0.941 0.941 1 } ; From 47d8a56dc01bbcd2cc0c5861f8060261001d9a1b Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 28 Jul 2008 14:19:35 -0500 Subject: [PATCH 06/16] opengl: Add words to work with color objects --- extra/opengl/opengl.factor | 20 +++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) diff --git a/extra/opengl/opengl.factor b/extra/opengl/opengl.factor index be70b1e176..3964288666 100755 --- a/extra/opengl/opengl.factor +++ b/extra/opengl/opengl.factor @@ -2,10 +2,12 @@ ! Portions copyright (C) 2007 Eduardo Cavazos. ! Portions copyright (C) 2008 Joe Groff. ! See http://factorcode.org/license.txt for BSD license. + USING: alien alien.c-types continuations kernel libc math macros -namespaces math.vectors math.constants math.functions -math.parser opengl.gl opengl.glu combinators arrays sequences -splitting words byte-arrays assocs ; + namespaces math.vectors math.constants math.functions + math.parser opengl.gl opengl.glu combinators arrays sequences + splitting words byte-arrays assocs colors accessors ; + IN: opengl : coordinates ( point1 point2 -- x1 y2 x2 y2 ) @@ -14,6 +16,8 @@ IN: opengl : fix-coordinates ( point1 point2 -- x1 y2 x2 y2 ) [ first2 [ >fixnum ] bi@ ] bi@ ; + + : gl-color ( color -- ) first4 glColor4d ; inline : gl-clear-color ( color -- ) @@ -22,6 +26,16 @@ IN: opengl : gl-clear ( color -- ) gl-clear-color GL_COLOR_BUFFER_BIT glClear ; +: color>raw ( object -- 4array ) + >rgba + { [ red>> ] [ green>> ] [ blue>> ] [ alpha>> ] } cleave + 4array ; + +: set-color ( object -- ) color>raw first4 glColor4d ; +: set-clear-color ( object -- ) color>raw first4 glClearColor ; + + + : gl-error ( -- ) glGetError dup zero? [ "GL error: " over gluErrorString append throw From 4f4edfee30ff29f54f0d13b627686cde165efc8f Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 28 Jul 2008 14:47:51 -0500 Subject: [PATCH 07/16] opengl: color>raw word --- extra/opengl/opengl.factor | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/extra/opengl/opengl.factor b/extra/opengl/opengl.factor index 3964288666..6e6302b305 100755 --- a/extra/opengl/opengl.factor +++ b/extra/opengl/opengl.factor @@ -16,7 +16,7 @@ IN: opengl : fix-coordinates ( point1 point2 -- x1 y2 x2 y2 ) [ first2 [ >fixnum ] bi@ ] bi@ ; - +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : gl-color ( color -- ) first4 glColor4d ; inline @@ -26,15 +26,13 @@ IN: opengl : gl-clear ( color -- ) gl-clear-color GL_COLOR_BUFFER_BIT glClear ; -: color>raw ( object -- 4array ) - >rgba - { [ red>> ] [ green>> ] [ blue>> ] [ alpha>> ] } cleave - 4array ; - -: set-color ( object -- ) color>raw first4 glColor4d ; -: set-clear-color ( object -- ) color>raw first4 glClearColor ; +: color>raw ( object -- r g b a ) + >rgba { [ red>> ] [ green>> ] [ blue>> ] [ alpha>> ] } cleave ; +: set-color ( object -- ) color>raw glColor4d ; +: set-clear-color ( object -- ) color>raw glClearColor ; +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : gl-error ( -- ) glGetError dup zero? [ From 19feaebb19b615083cdc8bd6bb43b29700a539ea Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 28 Jul 2008 14:49:20 -0500 Subject: [PATCH 08/16] processing.shapes: use color objects --- extra/processing/shapes/shapes.factor | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/extra/processing/shapes/shapes.factor b/extra/processing/shapes/shapes.factor index 16530c5414..d92da8c869 100644 --- a/extra/processing/shapes/shapes.factor +++ b/extra/processing/shapes/shapes.factor @@ -3,7 +3,7 @@ USING: kernel namespaces arrays sequences grouping alien.c-types math math.vectors math.geometry.rect opengl.gl opengl.glu opengl generalizations vars - combinators.cleave ; + combinators.cleave colors ; IN: processing.shapes @@ -12,20 +12,20 @@ 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 +T{ rgba f 0 0 0 1 } stroke-color set-global +T{ rgba f 1 1 1 1 } fill-color set-global ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : fill-mode ( -- ) GL_FRONT_AND_BACK GL_FILL glPolygonMode - fill-color> gl-color ; + fill-color> set-color ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : stroke-mode ( -- ) GL_FRONT_AND_BACK GL_LINE glPolygonMode - stroke-color> gl-color ; + stroke-color> set-color ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -101,8 +101,8 @@ VAR: stroke-color : 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 ; + [ stroke-color> set-color gl-ellipse ] + [ fill-color> set-color gl-get-line-width 2 * dup 2array v- gl-ellipse ] 2bi ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From 1324f6e096380a6a57dec15938918a5e7ffeadb2 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 28 Jul 2008 14:49:41 -0500 Subject: [PATCH 09/16] processing: use color objects --- extra/processing/processing.factor | 25 +++++++++++++++---------- 1 file changed, 15 insertions(+), 10 deletions(-) diff --git a/extra/processing/processing.factor b/extra/processing/processing.factor index f365f80d78..07b92fa8fd 100644 --- a/extra/processing/processing.factor +++ b/extra/processing/processing.factor @@ -9,9 +9,9 @@ USING: kernel namespaces threads combinators sequences arrays combinators.lib combinators.cleave rewrite-closures fry accessors newfx - processing.color processing.gadget math.geometry.rect - processing.shapes ; + processing.shapes + colors ; IN: processing @@ -39,27 +39,32 @@ IN: processing GENERIC: canonical-color-value ( obj -- color ) -METHOD: canonical-color-value { number } dup dup 1 4array ; +METHOD: canonical-color-value { number } dup dup 1 rgba boa ; METHOD: canonical-color-value { array } dup length { - { 2 [ first2 >r dup dup r> 4array ] } - { 3 [ 1 suffix ] } - { 4 [ ] } + { 2 [ first2 >r dup dup r> rgba boa ] } + { 3 [ first3 1 rgba boa ] } + { 4 [ first4 rgba boa ] } } case ; -METHOD: canonical-color-value { rgba } - { [ red>> ] [ green>> ] [ blue>> ] [ alpha>> ] } cleave 4array ; +! METHOD: canonical-color-value { rgba } +! { [ red>> ] [ green>> ] [ blue>> ] [ alpha>> ] } cleave 4array ; + +METHOD: canonical-color-value { color } ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : 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 ; +! : no-fill ( -- ) 0 fill-color> set-fourth ; +! : no-stroke ( -- ) 0 stroke-color> set-fourth ; + +: no-fill ( -- ) fill-color> 0 >>alpha drop ; +: no-stroke ( -- ) stroke-color> 0 >>alpha drop ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From 4c9c8ede6fbc3b5f396f0c67137de79133f30bf1 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 28 Jul 2008 14:49:54 -0500 Subject: [PATCH 10/16] bubble-chamber: use color objects --- extra/bubble-chamber/particle/hadron/hadron.factor | 5 ++--- extra/bubble-chamber/particle/muon/colors/colors.factor | 2 +- extra/bubble-chamber/particle/particle.factor | 8 ++++---- 3 files changed, 7 insertions(+), 8 deletions(-) diff --git a/extra/bubble-chamber/particle/hadron/hadron.factor b/extra/bubble-chamber/particle/hadron/hadron.factor index 10a5431e57..910df97789 100644 --- a/extra/bubble-chamber/particle/hadron/hadron.factor +++ b/extra/bubble-chamber/particle/hadron/hadron.factor @@ -1,9 +1,8 @@ USING: kernel random math math.constants math.points accessors multi-methods processing processing.shapes - processing.color bubble-chamber.common - bubble-chamber.particle ; + bubble-chamber.particle colors ; IN: bubble-chamber.particle.hadron @@ -26,7 +25,7 @@ METHOD: collide { hadron } [ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] [ ] while - 0 1 0 >>myc + 0 1 0 1 rgba boa >>myc drop ; diff --git a/extra/bubble-chamber/particle/muon/colors/colors.factor b/extra/bubble-chamber/particle/muon/colors/colors.factor index e68fff5efd..644bed833b 100644 --- a/extra/bubble-chamber/particle/muon/colors/colors.factor +++ b/extra/bubble-chamber/particle/muon/colors/colors.factor @@ -1,7 +1,7 @@ USING: kernel sequences math math.constants math.order accessors processing - processing.color ; + colors ; IN: bubble-chamber.particle.muon.colors diff --git a/extra/bubble-chamber/particle/particle.factor b/extra/bubble-chamber/particle/particle.factor index 755a414b71..8b13e9b4b7 100644 --- a/extra/bubble-chamber/particle/particle.factor +++ b/extra/bubble-chamber/particle/particle.factor @@ -1,8 +1,8 @@ USING: kernel sequences combinators math math.vectors math.functions multi-methods - accessors combinators.cleave processing processing.color - bubble-chamber.common ; + accessors combinators.cleave processing + bubble-chamber.common colors ; IN: bubble-chamber.particle @@ -28,8 +28,8 @@ TUPLE: particle pos vel speed speed-d theta theta-d theta-dd myc mya ; 0 >>theta-d 0 >>theta-dd - 0 0 0 1 >>myc - 0 0 0 1 >>mya ; + 0 0 0 1 rgba boa >>myc + 0 0 0 1 rgba boa >>mya ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From 4e8ac9d7be361774018c159fc9b277d5f93df44a Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 28 Jul 2008 14:59:29 -0500 Subject: [PATCH 11/16] golden-section: use color objects --- extra/golden-section/golden-section.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/golden-section/golden-section.factor b/extra/golden-section/golden-section.factor index a83dc988fd..807ef1355a 100644 --- a/extra/golden-section/golden-section.factor +++ b/extra/golden-section/golden-section.factor @@ -27,7 +27,7 @@ IN: golden-section : radius ( i -- radius ) pi * 720 / sin 10 * ; -: color ( i -- i ) dup 360.0 / dup 0.25 1 4array >fill-color ; +: color ( i -- i ) dup 360.0 / dup 0.25 1 rgba boa >fill-color ; : line-width ( i -- i ) dup radius 0.5 * 1 max glLineWidth ; From 86d2cd4066776e0177687f1d5e47be037f53c2a9 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 28 Jul 2008 14:59:40 -0500 Subject: [PATCH 12/16] boids.ui: use color objects --- extra/boids/ui/ui.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/boids/ui/ui.factor b/extra/boids/ui/ui.factor index 38dd9b4f78..cd73c67a71 100755 --- a/extra/boids/ui/ui.factor +++ b/extra/boids/ui/ui.factor @@ -41,7 +41,7 @@ IN: boids.ui : draw-boids ( -- ) boids> [ draw-boid ] each ; -: boid-color ( -- color ) { 1.0 0 0 0.3 } ; +: boid-color ( -- color ) T{ rgba f 1.0 0 0 0.3 } ; : display ( -- ) boid-color >fill-color From 2216486578242873e32cce400d96239d24a2e7d8 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 28 Jul 2008 16:59:05 -0500 Subject: [PATCH 13/16] colors: Basic colors are now objects. Add the >rgba method on arrays (kludge). --- extra/colors/colors.factor | 28 +++++++++++++++------------- 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/extra/colors/colors.factor b/extra/colors/colors.factor index f8de326b4d..02ad3ac778 100644 --- a/extra/colors/colors.factor +++ b/extra/colors/colors.factor @@ -28,6 +28,8 @@ METHOD: >rgba { hsva } METHOD: >rgba { grey } [ grey>> dup dup ] [ alpha>> ] bi rgba boa ; +METHOD: >rgba { array } first4 rgba boa ; + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! USE: syntax @@ -38,16 +40,16 @@ M: color blue>> >rgba blue>> ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: black { 0.0 0.0 0.0 1.0 } ; -: blue { 0.0 0.0 1.0 1.0 } ; -: cyan { 0 0.941 0.941 1 } ; -: gray { 0.6 0.6 0.6 1.0 } ; -: green { 0.0 1.0 0.0 1.0 } ; -: light-gray { 0.95 0.95 0.95 0.95 } ; -: light-purple { 0.8 0.8 1.0 1.0 } ; -: magenta { 0.941 0 0.941 1 } ; -: orange { 0.941 0.627 0 1 } ; -: purple { 0.627 0 0.941 1 } ; -: red { 1.0 0.0 0.0 1.0 } ; -: white { 1.0 1.0 1.0 1.0 } ; -: yellow { 1.0 1.0 0.0 1.0 } ; +: black T{ rgba f 0.0 0.0 0.0 1.0 } ; +: blue T{ rgba f 0.0 0.0 1.0 1.0 } ; +: cyan T{ rgba f 0 0.941 0.941 1 } ; +: gray T{ rgba f 0.6 0.6 0.6 1.0 } ; +: green T{ rgba f 0.0 1.0 0.0 1.0 } ; +: light-gray T{ rgba f 0.95 0.95 0.95 0.95 } ; +: light-purple T{ rgba f 0.8 0.8 1.0 1.0 } ; +: magenta T{ rgba f 0.941 0 0.941 1 } ; +: orange T{ rgba f 0.941 0.627 0 1 } ; +: purple T{ rgba f 0.627 0 0.941 1 } ; +: red T{ rgba f 1.0 0.0 0.0 1.0 } ; +: white T{ rgba f 1.0 1.0 1.0 1.0 } ; +: yellow T{ rgba f 1.0 1.0 0.0 1.0 } ; From 57f8f811b938da2cbcf3a7e264f75818b851e965 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 28 Jul 2008 17:00:30 -0500 Subject: [PATCH 14/16] opengl: Change gl-gradient to handle color objects --- extra/opengl/opengl.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/opengl/opengl.factor b/extra/opengl/opengl.factor index 6e6302b305..29c2e5400a 100755 --- a/extra/opengl/opengl.factor +++ b/extra/opengl/opengl.factor @@ -124,7 +124,7 @@ MACRO: all-enabled-client-state ( seq quot -- ) GL_QUAD_STRIP [ swap >r prepare-gradient r> [ length dup 1- v/n ] keep [ - >r >r 2dup r> r> gl-color v*n + >r >r 2dup r> r> set-color v*n dup gl-vertex v+ gl-vertex ] 2each 2drop ] do-state ; From 4643501ba6f79986a96f940eef6a2784e43be0d6 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 28 Jul 2008 17:01:08 -0500 Subject: [PATCH 15/16] slides: Update for color objects --- extra/slides/slides.factor | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/extra/slides/slides.factor b/extra/slides/slides.factor index e73da15296..c3c105143e 100755 --- a/extra/slides/slides.factor +++ b/extra/slides/slides.factor @@ -23,14 +23,14 @@ IN: slides H{ { font "monospace" } { font-size 36 } - { page-color { 0.4 0.4 0.4 0.3 } } + { page-color T{ rgba f 0.4 0.4 0.4 0.3 } } } } { snippet-style H{ { font "monospace" } { font-size 36 } - { foreground { 0.1 0.1 0.4 1 } } + { foreground T{ rgba f 0.1 0.1 0.4 1 } } } } { table-content-style @@ -48,14 +48,19 @@ IN: slides : $divider ( -- ) [ - T{ gradient f { { 0.25 0.25 0.25 1.0 } { 1.0 1.0 1.0 0.0 } } } >>interior + T{ gradient f + { + T{ rgba f 0.25 0.25 0.25 1.0 } + T{ rgba f 1.0 1.0 1.0 0.0 } + } + } >>interior { 800 10 } >>dim { 1 0 } >>orientation gadget. ] ($block) ; : page-theme ( gadget -- ) - T{ gradient f { { 0.8 0.8 1.0 1.0 } { 0.8 1.0 1.0 1.0 } } } + T{ gradient f { T{ rgba f 0.8 0.8 1.0 1.0 } T{ rgba f 0.8 1.0 1.0 1.0 } } } swap set-gadget-interior ; : ( list -- gadget ) From 20ee2dd2a7951f621647d4b5043cdb1c89c5fbf3 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 28 Jul 2008 17:01:24 -0500 Subject: [PATCH 16/16] Update lot's of ui vocabularies for color objects --- extra/ui/gadgets/buttons/buttons.factor | 6 +-- extra/ui/gadgets/editors/editors.factor | 6 +-- extra/ui/gadgets/grid-lines/grid-lines.factor | 2 +- extra/ui/gadgets/labelled/labelled.factor | 4 +- extra/ui/gadgets/labels/labels.factor | 2 +- extra/ui/gadgets/lists/lists.factor | 7 ++-- extra/ui/gadgets/panes/panes.factor | 2 +- extra/ui/gadgets/theme/theme.factor | 38 +++++++++---------- extra/ui/render/render.factor | 6 +-- 9 files changed, 37 insertions(+), 36 deletions(-) diff --git a/extra/ui/gadgets/buttons/buttons.factor b/extra/ui/gadgets/buttons/buttons.factor index e9475495bf..c5a5e8bad8 100755 --- a/extra/ui/gadgets/buttons/buttons.factor +++ b/extra/ui/gadgets/buttons/buttons.factor @@ -106,7 +106,7 @@ TUPLE: checkmark-paint color ; C: checkmark-paint M: checkmark-paint draw-interior - checkmark-paint-color gl-color + checkmark-paint-color set-color origin get [ rect-dim { 0 0 } over gl-line @@ -152,11 +152,11 @@ TUPLE: radio-paint color ; C: radio-paint M: radio-paint draw-interior - radio-paint-color gl-color + radio-paint-color set-color origin get { 4 4 } v+ swap rect-dim { 8 8 } v- 12 gl-fill-circle ; M: radio-paint draw-boundary - radio-paint-color gl-color + radio-paint-color set-color origin get { 1 1 } v+ swap rect-dim { 2 2 } v- 12 gl-circle ; : radio-knob-theme ( gadget -- ) diff --git a/extra/ui/gadgets/editors/editors.factor b/extra/ui/gadgets/editors/editors.factor index 8b0244900a..301121cdcc 100755 --- a/extra/ui/gadgets/editors/editors.factor +++ b/extra/ui/gadgets/editors/editors.factor @@ -129,7 +129,7 @@ M: editor ungraft* : draw-caret ( -- ) editor get editor-focused? [ editor get - dup editor-caret-color gl-color + dup editor-caret-color set-color dup caret-loc origin get v+ swap caret-dim over v+ [ { 0.5 -0.5 } v+ ] bi@ gl-line @@ -173,7 +173,7 @@ M: editor ungraft* : draw-lines ( -- ) \ first-visible-line get [ - editor get dup editor-color gl-color + editor get dup editor-color set-color dup visible-lines [ draw-line 1 translate-lines ] with each ] with-editor-translation ; @@ -192,7 +192,7 @@ M: editor ungraft* (draw-selection) ; : draw-selection ( -- ) - editor get editor-selection-color gl-color + editor get editor-selection-color set-color editor get selection-start/end over first [ 2dup [ diff --git a/extra/ui/gadgets/grid-lines/grid-lines.factor b/extra/ui/gadgets/grid-lines/grid-lines.factor index d0cedc985b..3f08425e95 100755 --- a/extra/ui/gadgets/grid-lines/grid-lines.factor +++ b/extra/ui/gadgets/grid-lines/grid-lines.factor @@ -25,7 +25,7 @@ SYMBOL: grid-dim M: grid-lines draw-boundary origin get [ -0.5 -0.5 0.0 glTranslated - grid-lines-color gl-color [ + grid-lines-color set-color [ dup grid set dup rect-dim half-gap v- grid-dim set compute-grid diff --git a/extra/ui/gadgets/labelled/labelled.factor b/extra/ui/gadgets/labelled/labelled.factor index bd775a2d39..dd5b1124e1 100755 --- a/extra/ui/gadgets/labelled/labelled.factor +++ b/extra/ui/gadgets/labelled/labelled.factor @@ -31,8 +31,8 @@ M: labelled-gadget focusable-child* labelled-gadget-content ; : title-theme ( gadget -- ) { 1 0 } over set-gadget-orientation T{ gradient f { - { 0.65 0.65 1.0 1.0 } - { 0.65 0.45 1.0 1.0 } + T{ rgba f 0.65 0.65 1.0 1.0 } + T{ rgba f 0.65 0.45 1.0 1.0 } } } swap set-gadget-interior ; : ( text -- label )