colors.xyz: implement CIE XYZ colors.

extra/colors/xyz/authors.txt

@@ -0,0 +1 @@
+John Benediktsson

extra/colors/xyz/summary.txt

@@ -0,0 +1 @@
+XYZ colors

extra/colors/xyz/xyz-docs.factor

@@ -0,0 +1,14 @@
+USING: help.markup help.syntax ;
+IN: colors.xyz
+
+HELP: xyza
+{ $class-description "The class of CIE XYZ colors with an alpha channel." } ;
+
+ARTICLE: "colors.xyz" "XYZ colors"
+"The " { $vocab-link "colors.xyz" } " vocabulary implements CIE XYZ colors, together with an alpha channel."
+{ $subsections
+    xyza
+    <xyza>
+    >xyza
+}
+{ $see-also "colors" } ;

extra/colors/xyz/xyz-tests.factor

@@ -0,0 +1,19 @@
+! Copyright (C) 2014 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: arrays colors kernel locals math.functions math.ranges
+sequences tools.test ;
+
+IN: colors.xyz
+
+{ t } [
+    0.0 1.0 0.1 <range> [| r |
+        0.0 1.0 0.1 <range> [| g |
+            0.0 1.0 0.1 <range> [| b |
+                r g b 1.0 <rgba> dup >xyza >rgba
+                [ >rgba-components 4array ] bi@
+                [ 0.00001 ~ ] 2all?
+            ] all?
+        ] all?
+    ] all?
+] unit-test

extra/colors/xyz/xyz.factor

@@ -0,0 +1,53 @@
+! Copyright (C) 2014 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: accessors colors kernel locals math math.functions
+math.order ;
+
+IN: colors.xyz
+
+TUPLE: xyza x y z alpha ;
+
+C: <xyza> xyza
+
+<PRIVATE
+
+: srgb-compand ( v -- v' )
+    dup 0.0031308 <= [ 12.92 * ] [ 2.4 recip ^ 1.055 * 0.055 - ] if ;
+
+PRIVATE>
+
+M: xyza >rgba
+    [
+        [let
+            [ x>> ] [ y>> ] [ z>> ] tri :> ( x y z )
+            x 3.2404542 * y -1.5371385 * z -0.4985314 * + +
+            x -0.9692660 * y 1.8760108 * z 0.0415560 * + +
+            x 0.0556434 * y -0.2040259 * z 1.0572252 * + +
+            [ srgb-compand 0.0 1.0 clamp ] tri@
+        ]
+    ] [ alpha>> ] bi <rgba> ;
+
+GENERIC: >xyza ( color -- xyza )
+
+M: object >xyza >rgba >xyza ;
+
+M: xyza >xyza ; inline
+
+<PRIVATE
+
+: invert-rgb-compand ( v -- v' )
+    dup 0.04045 <= [ 12.92 / ] [ 0.055 + 1.055 / 2.4 ^ ] if ;
+
+PRIVATE>
+
+M: rgba >xyza
+    [
+        [let
+            [ red>> ] [ green>> ] [ blue>> ] tri
+            [ invert-rgb-compand ] tri@ :> ( r g b )
+            r 0.4124564 * g 0.3575761 * b 0.1804375 * + +
+            r 0.2126729 * g 0.7151522 * b 0.0721750 * + +
+            r 0.0193339 * g 0.1191920 * b 0.9503041 * + +
+        ]
+    ] [ alpha>> ] bi <xyza> ;