diff --git a/extra/colors/xyy/authors.txt b/extra/colors/xyy/authors.txt new file mode 100644 index 0000000000..e091bb8164 --- /dev/null +++ b/extra/colors/xyy/authors.txt @@ -0,0 +1 @@ +John Benediktsson diff --git a/extra/colors/xyy/summary.txt b/extra/colors/xyy/summary.txt new file mode 100644 index 0000000000..8d39db08b0 --- /dev/null +++ b/extra/colors/xyy/summary.txt @@ -0,0 +1 @@ +xyY colors diff --git a/extra/colors/xyy/xyy-docs.factor b/extra/colors/xyy/xyy-docs.factor new file mode 100644 index 0000000000..20238a42ef --- /dev/null +++ b/extra/colors/xyy/xyy-docs.factor @@ -0,0 +1,14 @@ +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 +} +{ $see-also "colors" } ; diff --git a/extra/colors/xyy/xyy-tests.factor b/extra/colors/xyy/xyy-tests.factor new file mode 100644 index 0000000000..4907ae68c2 --- /dev/null +++ b/extra/colors/xyy/xyy-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.xyy + +{ t } [ + 0.0 1.0 0.1 [| r | + 0.0 1.0 0.1 [| g | + 0.0 1.0 0.1 [| b | + r g b 1.0 dup >xyYa >rgba + [ >rgba-components 4array ] bi@ + [ 0.00001 ~ ] 2all? + ] all? + ] all? + ] all? +] unit-test diff --git a/extra/colors/xyy/xyy.factor b/extra/colors/xyy/xyy.factor new file mode 100644 index 0000000000..d4826bc933 --- /dev/null +++ b/extra/colors/xyy/xyy.factor @@ -0,0 +1,40 @@ +! 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 + +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 ; + +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 ;