colors.yuv: adding support for YUV colors.

extra/colors/yuv/authors.txt

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

extra/colors/yuv/summary.txt

@@ -0,0 +1 @@
+YUV colors

extra/colors/yuv/yuv-docs.factor

@@ -0,0 +1,14 @@
+USING: help.markup help.syntax ;
+IN: colors.yuv
+
+HELP: yuva
+{ $class-description "The class of YUV colors with an alpha channel." } ;
+
+ARTICLE: "colors.yuv" "YUV colors"
+"The " { $vocab-link "colors.yuv" } " vocabulary implements colors specified by their Y', U, and V components, together with an alpha channel."
+{ $subsections
+    yuva
+    <yuva>
+    rgba>yuva
+}
+{ $see-also "colors" } ;

extra/colors/yuv/yuv-tests.factor

@@ -0,0 +1,19 @@
+! Copyright (C) 2013 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.yuv
+
+{ 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 rgba>yuva >rgba
+                [ >rgba-components 4array ] bi@
+                [ 0.00000001 ~ ] 2all?
+            ] all?
+        ] all?
+    ] all?
+] unit-test

extra/colors/yuv/yuv.factor

@@ -0,0 +1,46 @@
+! Copyright (C) 2013 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: accessors colors combinators kernel locals math
+math.order ;
+
+IN: colors.yuv
+
+TUPLE: yuva < color
+{ y read-only }
+{ u read-only }
+{ v read-only }
+{ alpha read-only } ;
+
+C: <yuva> yuva
+
+<PRIVATE
+
+CONSTANT: Wr 0.299
+CONSTANT: Wb 0.114
+CONSTANT: Wg 0.587
+CONSTANT: Umax 0.436
+CONSTANT: Vmax 0.615
+
+PRIVATE>
+
+M: yuva >rgba
+    { [ y>> ] [ u>> ] [ v>> ] [ alpha>> ] } cleave
+    [| y u v |
+        y 1 Wr - Vmax / v * +
+
+        y
+        Wb 1 Wb - * Umax Wg * / neg u *
+        Wr 1 Wr - * Vmax Wg * / neg v * + +
+
+        y 1 Wb - Umax / u * +
+
+        [ 0.0 1.0 clamp ] tri@
+    ] dip <rgba> ; inline
+
+:: rgba>yuva ( rgba -- yuva )
+    rgba >rgba-components :> ( r g b a )
+    Wr r * Wg g * Wb b * + + :> y
+    Umax 1 Wb - / b y - * :> u
+    Vmax 1 Wr - / r y - * :> v
+    y u v a <yuva> ;