From 148317846b7b32d88505cd989124521ecf438606 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 5 Feb 2009 22:17:15 -0600
Subject: [PATCH] Update various vocabularies for colors.constants

---
 basis/colors/colors-docs.factor           | 19 -------------------
 basis/colors/colors.factor                | 19 ++-----------------
 basis/colors/gray/gray.factor             |  2 +-
 basis/colors/hsv/hsv.factor               |  2 +-
 basis/help/stylesheet/stylesheet.factor   | 16 ++++++++--------
 basis/ui/gadgets/buttons/buttons.factor   | 14 +++++++-------
 basis/ui/gadgets/editors/editors.factor   | 15 +++++++--------
 basis/ui/gadgets/labelled/labelled.factor |  4 ++--
 basis/ui/gadgets/labels/labels.factor     |  4 ++--
 basis/ui/gadgets/menus/menus.factor       | 10 +++++-----
 basis/ui/gadgets/sliders/sliders.factor   |  6 +++---
 basis/ui/gadgets/theme/theme.factor       | 10 +++++-----
 basis/ui/render/render.factor             |  4 ++--
 basis/ui/text/core-text/core-text.factor  |  4 ++--
 14 files changed, 47 insertions(+), 82 deletions(-)

diff --git a/basis/colors/colors-docs.factor b/basis/colors/colors-docs.factor
index bd7da76234..c38b2cba33 100644
--- a/basis/colors/colors-docs.factor
+++ b/basis/colors/colors-docs.factor
@@ -11,24 +11,6 @@ HELP: >rgba
 { $values { "color" color } { "rgba" rgba } }
 { $contract "Converts a color to an RGBA color." } ;
 
-ARTICLE: "colors.standard" "Standard colors"
-"A few useful constants:"
-{ $subsection black }
-{ $subsection blue } 
-{ $subsection cyan } 
-{ $subsection gray } 
-{ $subsection dark-gray } 
-{ $subsection green } 
-{ $subsection light-gray } 
-{ $subsection light-purple } 
-{ $subsection medium-purple } 
-{ $subsection magenta } 
-{ $subsection orange } 
-{ $subsection purple } 
-{ $subsection red } 
-{ $subsection white } 
-{ $subsection yellow } ;
-
 ARTICLE: "colors.protocol" "Color protocol"
 "Abstract superclass for colors:"
 { $subsection color }
@@ -50,7 +32,6 @@ $nl
 { $subsection >rgba-components }
 "Further topics:"
 { $subsection "colors.protocol" }
-{ $subsection "colors.standard" }
 { $subsection "colors.gray" }
 { $vocab-subsection "HSV colors" "colors.hsv" } ;
 
diff --git a/basis/colors/colors.factor b/basis/colors/colors.factor
index 5a4e2134d5..bb91aeeba3 100644
--- a/basis/colors/colors.factor
+++ b/basis/colors/colors.factor
@@ -6,7 +6,7 @@ IN: colors
 
 TUPLE: color ;
 
-TUPLE: rgba < color red green blue alpha ;
+TUPLE: rgba < color { red read-only } { green read-only } { blue read-only } { alpha read-only } ;
 
 C: <rgba> rgba
 
@@ -23,19 +23,4 @@ M: color blue>> ( color -- blue ) >rgba blue>> ;
 
 : opaque? ( color -- ? ) alpha>> 1 number= ;
 
-CONSTANT: transparent T{ rgba f 0.0 0.0 0.0 0.0 }
-CONSTANT: black T{ rgba f 0.0 0.0 0.0 1.0 }
-CONSTANT: blue T{ rgba f 0.0 0.0 1.0 1.0 }
-CONSTANT: cyan T{ rgba f 0 0.941 0.941 1 }
-CONSTANT: gray T{ rgba f 0.6 0.6 0.6 1.0 }
-CONSTANT: dark-gray T{ rgba f 0.8 0.8 0.8 1.0 }
-CONSTANT: green T{ rgba f 0.0 1.0 0.0 1.0 }
-CONSTANT: light-gray T{ rgba f 0.95 0.95 0.95 0.95 }
-CONSTANT: light-purple T{ rgba f 0.8 0.8 1.0 1.0 }
-CONSTANT: medium-purple T{ rgba f 0.7 0.7 0.9 1.0 }
-CONSTANT: magenta T{ rgba f 0.941 0 0.941 1 }
-CONSTANT: orange T{ rgba f 0.941 0.627 0 1 }
-CONSTANT: purple T{ rgba f 0.627 0 0.941 1 }
-CONSTANT: red T{ rgba f 1.0 0.0 0.0 1.0 }
-CONSTANT: white T{ rgba f 1.0 1.0 1.0 1.0 }
-CONSTANT: yellow T{ rgba f 1.0 1.0 0.0 1.0 }
+CONSTANT: transparent T{ rgba f 0.0 0.0 0.0 0.0 }
\ No newline at end of file
diff --git a/basis/colors/gray/gray.factor b/basis/colors/gray/gray.factor
index da92a048ac..5d628dc409 100644
--- a/basis/colors/gray/gray.factor
+++ b/basis/colors/gray/gray.factor
@@ -3,7 +3,7 @@
 USING: colors kernel accessors ;
 IN: colors.gray
 
-TUPLE: gray < color gray alpha ;
+TUPLE: gray < color { gray read-only } { alpha read-only } ;
 
 C: <gray> gray
 
diff --git a/basis/colors/hsv/hsv.factor b/basis/colors/hsv/hsv.factor
index 6f658818a1..e4451fcb1c 100644
--- a/basis/colors/hsv/hsv.factor
+++ b/basis/colors/hsv/hsv.factor
@@ -6,7 +6,7 @@ IN: colors.hsv
 ! h [0,360)
 ! s [0,1]
 ! v [0,1]
-TUPLE: hsva < color hue saturation value alpha ;
+TUPLE: hsva < color { hue read-only } { saturation read-only } { value read-only } { alpha read-only } ;
 
 C: <hsva> hsva
 
diff --git a/basis/help/stylesheet/stylesheet.factor b/basis/help/stylesheet/stylesheet.factor
index c65fbe6ae4..9f7ff8739d 100644
--- a/basis/help/stylesheet/stylesheet.factor
+++ b/basis/help/stylesheet/stylesheet.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: io.styles namespaces colors ;
+USING: io.styles namespaces colors colors.constants ;
 IN: help.stylesheet
 
 SYMBOL: default-span-style
@@ -17,7 +17,7 @@ H{
 
 SYMBOL: link-style
 H{
-    { foreground T{ rgba f 0 0 0.3 1 } }
+    { foreground COLOR: dark-blue }
     { font-style bold }
 } link-style set-global
 
@@ -33,7 +33,7 @@ H{
     { font-size 18 }
     { font-style bold }
     { wrap-margin 500 }
-    { page-color T{ rgba f 0.8 0.8 0.8 1 } }
+    { page-color COLOR: light-gray }
     { border-width 5 }
 } title-style set-global
 
@@ -63,7 +63,7 @@ H{
 
 SYMBOL: code-style
 H{
-    { page-color T{ rgba f 0.8 0.8 0.8 0.5 } }
+    { page-color COLOR: gray80 }
     { border-width 5 }
     { wrap-margin f }
 } code-style set-global
@@ -74,13 +74,13 @@ H{ { font-style bold } } input-style set-global
 SYMBOL: url-style
 H{
     { font-name "monospace" }
-    { foreground T{ rgba f 0.0 0.0 1.0 1.0 } }
+    { foreground COLOR: blue }
 } url-style set-global
 
 SYMBOL: warning-style
 H{
-    { page-color T{ rgba f 0.95 0.95 0.95 1 } }
-    { border-color T{ rgba f 1 0 0 1 } }
+    { page-color COLOR: gray90 }
+    { border-color COLOR: red }
     { border-width 5 }
     { wrap-margin 500 }
 } warning-style set-global
@@ -93,7 +93,7 @@ H{
 SYMBOL: table-style
 H{
     { table-gap { 5 5 } }
-    { table-border T{ rgba f 0.8 0.8 0.8 1.0 } }
+    { table-border COLOR: light-gray }
 } table-style set-global
 
 SYMBOL: list-style
diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor
index ea652a4d7c..1cba406e0c 100644
--- a/basis/ui/gadgets/buttons/buttons.factor
+++ b/basis/ui/gadgets/buttons/buttons.factor
@@ -1,7 +1,7 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays kernel math models namespaces sequences
-strings quotations assocs combinators classes colors
+strings quotations assocs combinators classes colors colors.constants
 classes.tuple opengl opengl.gl math.vectors ui.commands ui.gadgets
 ui.gadgets.borders ui.gadgets.labels ui.gadgets.theme
 ui.gadgets.tracks ui.gadgets.packs ui.gadgets.worlds ui.gestures
@@ -70,7 +70,7 @@ M: button-paint draw-boundary
     { 0 1/2 } >>align ; inline
 
 : roll-button-theme ( button -- button )
-    f black <solid> dup f <button-paint> >>boundary
+    f COLOR: black <solid> dup f <button-paint> >>boundary
     f f pressed-gradient f <button-paint> >>interior
     align-left ; inline
 
@@ -137,10 +137,10 @@ M: checkmark-paint draw-interior
 : checkmark-theme ( gadget -- gadget )
     f
     f
-    black <solid>
-    black <checkmark-paint>
+    COLOR: black <solid>
+    COLOR: black <checkmark-paint>
     <button-paint> >>interior
-    black <solid> >>boundary ;
+    COLOR: black <solid> >>boundary ;
 
 : <checkmark> ( -- gadget )
     <gadget>
@@ -194,7 +194,7 @@ M: radio-paint draw-boundary
     GL_LINE_STRIP 0 circle-steps 1+ glDrawArrays ;
 
 :: radio-knob-theme ( gadget -- gadget )
-    black <radio-paint> :> radio-paint
+    COLOR: black <radio-paint> :> radio-paint
     gadget
     f f radio-paint radio-paint <button-paint> >>interior
     radio-paint >>boundary
diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor
index 03bb644290..c94f6ef583 100755
--- a/basis/ui/gadgets/editors/editors.factor
+++ b/basis/ui/gadgets/editors/editors.factor
@@ -3,12 +3,11 @@
 USING: accessors arrays documents documents.elements kernel math
 models models.filter namespaces locals fry make opengl opengl.gl
 sequences strings math.vectors math.functions sorting colors
-combinators assocs math.order fry calendar alarms continuations
-ui.clipboards ui.commands ui.gadgets ui.gadgets.borders
+colors.constants combinators assocs math.order fry calendar alarms
+continuations ui.clipboards ui.commands ui.gadgets ui.gadgets.borders
 ui.gadgets.buttons ui.gadgets.labels ui.gadgets.scrollers
 ui.gadgets.theme ui.gadgets.menus ui.gadgets.wrappers ui.render
-ui.text ui.gestures math.rectangles splitting unicode.categories
-fonts ;
+ui.text ui.gestures math.rectangles splitting unicode.categories fonts ;
 IN: ui.gadgets.editors
 
 TUPLE: editor < gadget
@@ -23,8 +22,8 @@ focused? blink blink-alarm ;
     <loc> >>mark ; inline
 
 : editor-theme ( editor -- editor )
-    black >>color
-    red >>caret-color
+    COLOR: black >>color
+    COLOR: red >>caret-color
     selection-color >>selection-color
     monospace-font >>font ; inline
 
@@ -508,7 +507,7 @@ editor "selection" f {
 } define-command-map
 
 : editor-menu ( editor -- )
-    { cut com-copy paste } show-commands-menu ;
+    { com-undo com-redo cut com-copy paste } show-commands-menu ;
 
 editor "misc" f {
     { T{ button-down f f 3 } editor-menu }
@@ -586,7 +585,7 @@ TUPLE: source-editor < multiline-editor ;
 TUPLE: field < wrapper editor min-width max-width ;
 
 : field-theme ( gadget -- gadget )
-    gray <solid> >>boundary ; inline
+    COLOR: gray <solid> >>boundary ; inline
 
 : <field-border> ( gadget -- border )
     { 2 2 } <border>
diff --git a/basis/ui/gadgets/labelled/labelled.factor b/basis/ui/gadgets/labelled/labelled.factor
index 6bcea200f3..8e59c132c9 100644
--- a/basis/ui/gadgets/labelled/labelled.factor
+++ b/basis/ui/gadgets/labelled/labelled.factor
@@ -5,7 +5,7 @@ ui.gadgets.labels ui.gadgets.panes ui.gadgets.scrollers
 ui.gadgets.tracks ui.gadgets.theme ui.gadgets.frames
 ui.gadgets.grids io kernel math models namespaces
 sequences sequences words classes.tuple ui.gadgets ui.render
-colors accessors ;
+colors colors.constants accessors ;
 IN: ui.gadgets.labelled
 
 TUPLE: labelled-gadget < track content ;
@@ -26,7 +26,7 @@ M: labelled-gadget focusable-child* content>> ;
     <labelled-scroller> ;
 
 : <close-box> ( quot -- button/f )
-    gray close-box <polygon-gadget> swap <bevel-button> ;
+    COLOR: gray close-box <polygon-gadget> swap <bevel-button> ;
 
 : title-theme ( gadget -- gadget )
     { 1 0 } >>orientation
diff --git a/basis/ui/gadgets/labels/labels.factor b/basis/ui/gadgets/labels/labels.factor
index 22d1607072..e71f29de46 100644
--- a/basis/ui/gadgets/labels/labels.factor
+++ b/basis/ui/gadgets/labels/labels.factor
@@ -3,7 +3,7 @@
 USING: accessors arrays hashtables io kernel math math.functions
 namespaces make opengl sequences strings splitting ui.gadgets
 ui.gadgets.tracks ui.gadgets.packs fonts ui.render ui.text
-colors models ;
+colors colors.constants models ;
 IN: ui.gadgets.labels
 
 ! A label gadget draws a string.
@@ -57,7 +57,7 @@ M: label-control model-changed
 
 : reverse-video-theme ( label -- label )
     sans-serif-font reverse-video-font >>font
-    black <solid> >>interior ;
+    COLOR: black <solid> >>interior ;
 
 GENERIC: >label ( obj -- gadget )
 M: string >label <label> ;
diff --git a/basis/ui/gadgets/menus/menus.factor b/basis/ui/gadgets/menus/menus.factor
index ad1b2098e2..ca6e1977c8 100644
--- a/basis/ui/gadgets/menus/menus.factor
+++ b/basis/ui/gadgets/menus/menus.factor
@@ -1,9 +1,9 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: locals accessors kernel math namespaces sequences
-math.vectors colors math.rectangles ui.commands ui.operations ui.gadgets
-ui.gadgets.buttons ui.gadgets.worlds ui.gestures ui.gadgets.theme
-ui.gadgets.packs ui.gadgets.glass ui.gadgets.borders ;
+USING: locals accessors kernel math namespaces sequences math.vectors
+colors colors.constants math.rectangles ui.commands ui.operations
+ui.gadgets ui.gadgets.buttons ui.gadgets.worlds ui.gestures
+ui.gadgets.theme ui.gadgets.packs ui.gadgets.glass ui.gadgets.borders ;
 IN: ui.gadgets.menus
 
 : menu-loc ( world menu -- loc )
@@ -20,7 +20,7 @@ IN: ui.gadgets.menus
     ] <roll-button> ;
 
 : menu-theme ( gadget -- gadget )
-    light-gray solid-interior
+    COLOR: light-gray solid-interior
     faint-boundary ;
 
 : <commands-menu> ( target hook commands -- menu )
diff --git a/basis/ui/gadgets/sliders/sliders.factor b/basis/ui/gadgets/sliders/sliders.factor
index e746fe3de9..1cc21beb1a 100644
--- a/basis/ui/gadgets/sliders/sliders.factor
+++ b/basis/ui/gadgets/sliders/sliders.factor
@@ -1,10 +1,10 @@
-! Copyright (C) 2005, 2007 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays ui.gestures ui.gadgets ui.gadgets.buttons
 ui.gadgets.frames ui.gadgets.grids math.order
 ui.gadgets.theme ui.render kernel math namespaces sequences
 vectors models models.range math.vectors math.functions
-quotations colors math.rectangles fry ;
+quotations colors colors.constants math.rectangles fry ;
 IN: ui.gadgets.sliders
 
 TUPLE: elevator < gadget direction ;
@@ -125,7 +125,7 @@ M: elevator layout*
 : slide-by-line ( amount slider -- ) [ line>> * ] keep slide-by ;
 
 : <slide-button> ( vector polygon amount -- button )
-    [ gray swap <polygon-gadget> ] dip
+    [ COLOR: gray swap <polygon-gadget> ] dip
     '[ _ swap find-slider slide-by-line ] <repeat-button>
     swap >>orientation ;
 
diff --git a/basis/ui/gadgets/theme/theme.factor b/basis/ui/gadgets/theme/theme.factor
index 965a699a83..0256140bb1 100644
--- a/basis/ui/gadgets/theme/theme.factor
+++ b/basis/ui/gadgets/theme/theme.factor
@@ -1,8 +1,8 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! Copyright (C) 2006, 2007 Alex Chapman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays kernel sequences ui.gadgets ui.render
-ui.text colors colors.gray accessors ;
+ui.text colors colors.gray colors.constants accessors ;
 QUALIFIED: colors
 IN: ui.gadgets.theme
 
@@ -13,11 +13,11 @@ IN: ui.gadgets.theme
     <solid> >>boundary ; inline
 
 : faint-boundary ( gadget -- gadget )
-    colors:gray solid-boundary ; inline
+    COLOR: gray solid-boundary ; inline
 
-: selection-color ( -- color ) light-purple ; inline
+: selection-color ( -- color ) COLOR: lavender ; inline
 
-: focus-border-color ( -- color ) medium-purple ; inline
+: focus-border-color ( -- color ) COLOR: dark-gray ; inline
 
 : plain-gradient ( -- gradient )
     {
diff --git a/basis/ui/render/render.factor b/basis/ui/render/render.factor
index d4212b72ba..054b65b219 100755
--- a/basis/ui/render/render.factor
+++ b/basis/ui/render/render.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.c-types arrays hashtables io kernel
 math namespaces opengl opengl.gl opengl.glu sequences strings
-vectors combinators math.vectors ui.gadgets colors
+vectors combinators math.vectors ui.gadgets colors colors.constants
 math.order math.rectangles locals specialized-arrays.float ;
 IN: ui.render
 
@@ -38,7 +38,7 @@ SYMBOL: viewport-translation
     init-clip
     ! white gl-clear is broken w.r.t window resizing
     ! Linux/PPC Radeon 9200
-    white gl-color
+    COLOR: white gl-color
     clip get dim>> gl-fill-rect ;
 
 GENERIC: draw-gadget* ( gadget -- )
diff --git a/basis/ui/text/core-text/core-text.factor b/basis/ui/text/core-text/core-text.factor
index 54fa2d40a8..228f2aba1a 100644
--- a/basis/ui/text/core-text/core-text.factor
+++ b/basis/ui/text/core-text/core-text.factor
@@ -4,7 +4,7 @@ USING: assocs accessors alien core-graphics.types core-text
 core-text.fonts kernel hashtables namespaces sequences
 ui.gadgets.worlds ui.text ui.text.private opengl opengl.gl destructors
 combinators core-foundation core-foundation.strings memoize math
-math.vectors init colors ;
+math.vectors init colors colors.constants ;
 IN: ui.text.core-text
 
 SINGLETON: core-text-renderer
@@ -19,7 +19,7 @@ TUPLE: rendered-line line texture display-list age disposed ;
         GL_TEXTURE_2D [
             GL_TEXTURE_BIT [
                 GL_TEXTURE_COORD_ARRAY [
-                    white gl-color
+                    COLOR: white gl-color
                     GL_TEXTURE_2D swap glBindTexture
                     init-texture rect-texture-coords
                     dim>> fill-rect-vertices (gl-fill-rect)