--- /dev/null
+John Benediktsson
--- /dev/null
+xyY colors
--- /dev/null
+USING: help.markup help.syntax ;
+IN: colors.xyy
+
+HELP: xyYa
+{ $class-description "The class of CIE xyY colors with an alpha channel." } ;
+
+ARTICLE: "colors.xyy" "xyY colors"
+"The " { $vocab-link "colors.xyy" } " vocabulary implements CIE xyY colors, together with an alpha channel."
+{ $subsections
+ xyYa
+ <xyYa>
+ >xyYa
+}
+{ $see-also "colors" } ;
--- /dev/null
+! 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.xyy
+
+{ 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 >xyYa >rgba
+ [ >rgba-components 4array ] bi@
+ [ 0.00001 ~ ] 2all?
+ ] all?
+ ] all?
+ ] all?
+] unit-test
--- /dev/null
+! Copyright (C) 2014 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: accessors colors colors.xyz kernel locals math ;
+
+IN: colors.xyy
+
+TUPLE: xyYa x y Y alpha ;
+
+C: <xyYa> xyYa
+
+M: xyYa >rgba
+ >xyza >rgba ;
+
+M: xyYa >xyza
+ [
+ [let
+ [ x>> ] [ y>> ] [ Y>> ] tri :> ( x y Y )
+ x y / Y *
+ Y
+ 1 x - y - y / Y *
+ ]
+ ] [ alpha>> ] bi <xyza> ;
+
+GENERIC: >xyYa ( color -- xyYa )
+
+M: object >xyYa >xyza >xyYa ;
+
+M: xyYa >xyYa ; inline
+
+M: xyza >xyYa
+ [
+ [let
+ [ x>> ] [ y>> ] [ z>> ] tri :> ( x y z )
+ x y z + +
+ [ x swap / ]
+ [ y swap / ] bi
+ y
+ ]
+ ] [ alpha>> ] bi <xyYa> ;