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 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 <rgb> >>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 <rgba> >>myc - 0 0 0 1 <rgba> >>mya ; + 0 0 0 1 rgba boa >>myc + 0 0 0 1 rgba boa >>mya ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/colors/colors.factor b/extra/colors/colors.factor index f8de326b4d..ae3695cf8b 100644 --- a/extra/colors/colors.factor +++ b/extra/colors/colors.factor @@ -1,8 +1,7 @@ -! Copyright (C) 2003, 2007 Slava Pestov. +! Copyright (C) 2003, 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel combinators sequences arrays - classes.tuple multi-methods accessors colors.hsv ; +USING: kernel combinators sequences arrays classes.tuple accessors colors.hsv ; IN: colors @@ -14,40 +13,38 @@ TUPLE: rgba < color red green blue alpha ; TUPLE: hsva < color hue saturation value alpha ; -TUPLE: grey < color grey alpha ; +TUPLE: gray < color gray alpha ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! GENERIC: >rgba ( object -- rgba ) -METHOD: >rgba { rgba } ; +M: rgba >rgba ( rgba -- rgba ) ; -METHOD: >rgba { hsva } +M: hsva >rgba ( hsva -- rgba ) { [ hue>> ] [ saturation>> ] [ value>> ] [ alpha>> ] } cleave 4array [ hsv>rgb ] [ peek ] bi suffix first4 rgba boa ; -METHOD: >rgba { grey } [ grey>> dup dup ] [ alpha>> ] bi rgba boa ; +M: gray >rgba ( gray -- rgba ) [ gray>> dup dup ] [ alpha>> ] bi rgba boa ; + +M: array >rgba ( array -- rgba ) first4 rgba boa ; + +M: color red>> ( color -- red ) >rgba red>> ; +M: color green>> ( color -- green ) >rgba green>> ; +M: color blue>> ( color -- blue ) >rgba blue>> ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -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 } ; -: 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 } ; 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 ; diff --git a/extra/opengl/opengl.factor b/extra/opengl/opengl.factor index 3964288666..29c2e5400a 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? [ @@ -126,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 ; 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 ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 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 ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 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 ( -- ) [ <gadget> - 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 ; : <page> ( list -- gadget ) 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> 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> 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 ; : <title-label> ( text -- label ) <label> dup title-theme ; diff --git a/extra/ui/gadgets/labels/labels.factor b/extra/ui/gadgets/labels/labels.factor index a3a5c1a0a6..24dbd04fde 100755 --- a/extra/ui/gadgets/labels/labels.factor +++ b/extra/ui/gadgets/labels/labels.factor @@ -35,7 +35,7 @@ M: label pref-dim* [ font>> open-font ] [ text>> ] bi text-dim ; M: label draw-gadget* - [ color>> gl-color ] + [ color>> set-color ] [ [ font>> ] [ text>> ] bi origin get draw-text ] bi ; M: label gadget-text* label-string % ; diff --git a/extra/ui/gadgets/lists/lists.factor b/extra/ui/gadgets/lists/lists.factor index c2539e146a..a4c313f944 100755 --- a/extra/ui/gadgets/lists/lists.factor +++ b/extra/ui/gadgets/lists/lists.factor @@ -4,13 +4,14 @@ USING: accessors ui.commands ui.gestures ui.render ui.gadgets ui.gadgets.labels ui.gadgets.scrollers kernel sequences models opengl math math.order namespaces ui.gadgets.presentations ui.gadgets.viewports ui.gadgets.packs -math.vectors classes.tuple math.geometry.rect ; +math.vectors classes.tuple math.geometry.rect colors ; + IN: ui.gadgets.lists TUPLE: list < pack index presenter color hook ; : list-theme ( list -- list ) - { 0.8 0.8 1.0 1.0 } >>color ; inline + T{ rgba f 0.8 0.8 1.0 1.0 } >>color ; inline : <list> ( hook presenter model -- gadget ) list new-gadget @@ -56,7 +57,7 @@ M: list model-changed M: list draw-gadget* origin get [ - dup list-color gl-color + dup list-color set-color selected-rect [ rect-extent gl-fill-rect ] when* ] with-translation ; diff --git a/extra/ui/gadgets/panes/panes.factor b/extra/ui/gadgets/panes/panes.factor index cca757e0eb..e7798404f4 100755 --- a/extra/ui/gadgets/panes/panes.factor +++ b/extra/ui/gadgets/panes/panes.factor @@ -68,7 +68,7 @@ M: node draw-selection ( loc node -- ) M: pane draw-gadget* dup gadget-selection? [ - dup pane-selection-color gl-color + dup pane-selection-color set-color origin get over rect-loc v- swap selected-children [ draw-selection ] with each ] [ diff --git a/extra/ui/gadgets/theme/theme.factor b/extra/ui/gadgets/theme/theme.factor index 68bd3b201a..20f560e309 100644 --- a/extra/ui/gadgets/theme/theme.factor +++ b/extra/ui/gadgets/theme/theme.factor @@ -18,41 +18,41 @@ IN: ui.gadgets.theme : plain-gradient T{ gradient f { - { 0.94 0.94 0.94 1.0 } - { 0.83 0.83 0.83 1.0 } - { 0.83 0.83 0.83 1.0 } - { 0.62 0.62 0.62 1.0 } + T{ rgba f 0.94 0.94 0.94 1.0 } + T{ rgba f 0.83 0.83 0.83 1.0 } + T{ rgba f 0.83 0.83 0.83 1.0 } + T{ rgba f 0.62 0.62 0.62 1.0 } } } ; : rollover-gradient T{ gradient f { - { 1.0 1.0 1.0 1.0 } - { 0.9 0.9 0.9 1.0 } - { 0.9 0.9 0.9 1.0 } - { 0.75 0.75 0.75 1.0 } + T{ rgba f 1.0 1.0 1.0 1.0 } + T{ rgba f 0.9 0.9 0.9 1.0 } + T{ rgba f 0.9 0.9 0.9 1.0 } + T{ rgba f 0.75 0.75 0.75 1.0 } } } ; : pressed-gradient T{ gradient f { - { 0.75 0.75 0.75 1.0 } - { 0.9 0.9 0.9 1.0 } - { 0.9 0.9 0.9 1.0 } - { 1.0 1.0 1.0 1.0 } + T{ rgba f 0.75 0.75 0.75 1.0 } + T{ rgba f 0.9 0.9 0.9 1.0 } + T{ rgba f 0.9 0.9 0.9 1.0 } + T{ rgba f 1.0 1.0 1.0 1.0 } } } ; : selected-gradient T{ gradient f { - { 0.65 0.65 0.65 1.0 } - { 0.8 0.8 0.8 1.0 } - { 0.8 0.8 0.8 1.0 } - { 1.0 1.0 1.0 1.0 } + T{ rgba f 0.65 0.65 0.65 1.0 } + T{ rgba f 0.8 0.8 0.8 1.0 } + T{ rgba f 0.8 0.8 0.8 1.0 } + T{ rgba f 1.0 1.0 1.0 1.0 } } } ; : lowered-gradient T{ gradient f { - { 0.37 0.37 0.37 1.0 } - { 0.43 0.43 0.43 1.0 } - { 0.5 0.5 0.5 1.0 } + T{ rgba f 0.37 0.37 0.37 1.0 } + T{ rgba f 0.43 0.43 0.43 1.0 } + T{ rgba f 0.5 0.5 0.5 1.0 } } } ; : sans-serif-font { "sans-serif" plain 12 } ; diff --git a/extra/ui/render/render.factor b/extra/ui/render/render.factor index 6e9a4778a7..a0a51b09da 100644 --- a/extra/ui/render/render.factor +++ b/extra/ui/render/render.factor @@ -35,7 +35,7 @@ SYMBOL: viewport-translation init-clip ! white gl-clear is broken w.r.t window resizing ! Linux/PPC Radeon 9200 - white gl-color + white set-color clip get rect-extent gl-fill-rect ; GENERIC: draw-gadget* ( gadget -- ) @@ -95,7 +95,7 @@ C: <solid> solid ! Solid pen : (solid) ( gadget paint -- loc dim ) - solid-color gl-color rect-dim >r origin get dup r> v+ ; + solid-color set-color rect-dim >r origin get dup r> v+ ; M: solid draw-interior (solid) gl-fill-rect ; @@ -121,7 +121,7 @@ C: <polygon> polygon : draw-polygon ( polygon quot -- ) origin get [ - >r dup polygon-color gl-color polygon-points r> call + >r dup polygon-color set-color polygon-points r> call ] with-translation ; inline M: polygon draw-boundary