From fdef71d2b72ac4a2bc6d4bb3218a3b863061643e Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Thu, 28 Oct 2010 13:34:59 -0700
Subject: [PATCH] colors.hex vocab.

---
 basis/colors/hex/authors.txt      |  1 +
 basis/colors/hex/hex-docs.factor  | 38 +++++++++++++++++++++++++++++++
 basis/colors/hex/hex-tests.factor | 12 ++++++++++
 basis/colors/hex/hex.factor       | 16 +++++++++++++
 basis/colors/hex/summary.txt      |  1 +
 5 files changed, 68 insertions(+)
 create mode 100644 basis/colors/hex/authors.txt
 create mode 100644 basis/colors/hex/hex-docs.factor
 create mode 100644 basis/colors/hex/hex-tests.factor
 create mode 100644 basis/colors/hex/hex.factor
 create mode 100644 basis/colors/hex/summary.txt

diff --git a/basis/colors/hex/authors.txt b/basis/colors/hex/authors.txt
new file mode 100644
index 0000000000..e091bb8164
--- /dev/null
+++ b/basis/colors/hex/authors.txt
@@ -0,0 +1 @@
+John Benediktsson
diff --git a/basis/colors/hex/hex-docs.factor b/basis/colors/hex/hex-docs.factor
new file mode 100644
index 0000000000..ca49692200
--- /dev/null
+++ b/basis/colors/hex/hex-docs.factor
@@ -0,0 +1,38 @@
+! Copyright (C) 2010 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: colors help.markup help.syntax strings ;
+
+IN: colors.hex
+
+HELP: hex>rgba
+{ $values { "hex" string } { "rgba" color } }
+{ $description "Converts a hexadecimal string value into a " { $link color } "." }
+;
+
+HELP: rgba>hex
+{ $values { "rgba" color } { "hex" string } }
+{ $description "Converts a " { $link color } " into a hexadecimal string value." }
+;
+
+HELP: HEXCOLOR:
+{ $syntax "HEXCOLOR: value" }
+{ $description "Parses as a " { $link color } " object with the given hexadecimal value." }
+{ $examples
+  { $code
+    "USING: colors.hex io.styles ;"
+    "\"Hello!\" { { foreground HEXCOLOR: 336699 } } format nl"
+  }
+} ;
+
+ARTICLE: "colors.hex" "HEX colors"
+"The " { $vocab-link "colors.hex" } " vocabulary implements colors specified "
+"by their hexidecimal value."
+{ $subsections
+    hex>rgba
+    rgba>hex
+    POSTPONE: HEXCOLOR:
+}
+{ $see-also "colors" } ;
+
+ABOUT: "colors.hex"
diff --git a/basis/colors/hex/hex-tests.factor b/basis/colors/hex/hex-tests.factor
new file mode 100644
index 0000000000..0ab1fd5216
--- /dev/null
+++ b/basis/colors/hex/hex-tests.factor
@@ -0,0 +1,12 @@
+! Copyright (C) 2010 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: colors colors.hex tools.test ;
+
+IN: colors.hex.test
+
+[ HEXCOLOR: 000000 ] [ 0.0 0.0 0.0 1.0 <rgba> ] unit-test
+[ HEXCOLOR: FFFFFF ] [ 1.0 1.0 1.0 1.0 <rgba> ] unit-test
+[ HEXCOLOR: abcdef ] [ "abcdef" hex>rgba ] unit-test
+[ HEXCOLOR: abcdef ] [ "ABCDEF" hex>rgba ] unit-test
+[ "ABCDEF" ] [ HEXCOLOR: abcdef rgba>hex ] unit-test
diff --git a/basis/colors/hex/hex.factor b/basis/colors/hex/hex.factor
new file mode 100644
index 0000000000..a4b1aef7e5
--- /dev/null
+++ b/basis/colors/hex/hex.factor
@@ -0,0 +1,16 @@
+! Copyright (C) 2010 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: accessors colors formatting grouping kernel lexer math
+math.parser sequences ;
+
+IN: colors.hex
+
+: hex>rgba ( hex -- rgba )
+    2 group [ hex> 255 /f ] map first3 1.0 <rgba> ;
+
+: rgba>hex ( rgba -- hex )
+    [ red>> ] [ green>> ] [ blue>> ] tri
+    [ 255 * >integer ] tri@ "%02X%02X%02X" sprintf ;
+
+SYNTAX: HEXCOLOR: scan hex>rgba suffix! ;
diff --git a/basis/colors/hex/summary.txt b/basis/colors/hex/summary.txt
new file mode 100644
index 0000000000..37b6abaac4
--- /dev/null
+++ b/basis/colors/hex/summary.txt
@@ -0,0 +1 @@
+Hexadecimal colors