colors.ryb: adding RYB colors.

extra/colors/ryb/authors.txt

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

extra/colors/ryb/ryb-docs.factor

@@ -0,0 +1,14 @@
+USING: help.markup help.syntax ;
+IN: colors.ryb
+
+HELP: ryba
+{ $class-description "The class of RYB (Red, Yellow, Blue) colors with an alpha channel. All slots store values in the interval " { $snippet "[0,1]" } "." } ;
+
+ARTICLE: "colors.ryb" "RYB colors"
+"The " { $vocab-link "colors.ryb" } " vocabulary implements colors specified by their red, yellow, and blue components, together with an alpha channel."
+{ $subsections
+    ryba
+    <ryba>
+    rgba>ryba
+}
+{ $see-also "colors" } ;

extra/colors/ryb/ryb-tests.factor

@@ -0,0 +1,16 @@
+USING: assocs colors kernel tools.test ;
+IN: colors.ryb
+
+{ t } [
+    {
+        { T{ rgba f 1.0 0.0 0.0 } T{ ryba f 1.0 0.0 0.0 } }
+        { T{ rgba f 0.0 1.0 0.0 } T{ ryba f 0.0 1.0 1.0 } }
+        { T{ rgba f 0.0 0.0 1.0 } T{ ryba f 0.0 0.0 1.0 } }
+        { T{ rgba f 0.0 1.0 1.0 } T{ ryba f 0.0 0.5 1.0 } }
+        { T{ rgba f 1.0 0.0 1.0 } T{ ryba f 1.0 0.0 1.0 } }
+        { T{ rgba f 1.0 1.0 0.0 } T{ ryba f 0.0 1.0 0.0 } }
+        { T{ rgba f 0.0 0.0 0.0 } T{ ryba f 0.0 0.0 0.0 } }
+        { T{ rgba f 1.0 1.0 1.0 } T{ ryba f 1.0 1.0 1.0 } }
+    }
+    [ [ >rgba = ] [ swap rgba>ryba = ] 2bi and ] assoc-all?
+] unit-test

extra/colors/ryb/ryb.factor

@@ -0,0 +1,71 @@
+! Copyright (C) 2013 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: accessors colors kernel locals math math.order ;
+
+IN: colors.ryb
+
+TUPLE: ryba < color
+    { red read-only }
+    { yellow read-only }
+    { blue read-only }
+    { alpha read-only } ;
+
+C: <ryba> ryba
+
+<PRIVATE
+
+: normalized ( a b c quot: ( a b c -- a' b' c' ) -- a' b' c' )
+    [ 3dup min min ] dip over
+    [ [ - ] curry tri@ ]
+    [ call ]
+    [ [ + ] curry tri@ ] tri* ; inline
+
+:: ryb>rgb ( r! y! b! -- r g b )
+    r y b max max :> my
+
+    y b min :> g!
+    y g - y!
+    b g - b!
+
+    b g [ 0 > ] both? [
+        b 2 * b!
+        g 2 * g!
+    ] when
+
+    r y + r!
+    g y + g!
+
+    r g b 3dup max max [
+        my swap / [ * ] curry tri@
+    ] unless-zero ;
+
+:: rgb>ryb ( r! g! b! -- r y b )
+    r g b max max :> mg
+
+    r g min :> y!
+    r y - r!
+    g y - g!
+
+    b g [ 0 > ] both? [
+        b 2 /f b!
+        g 2 /f g!
+    ] when
+
+    y g + y!
+    b g + b!
+
+    r y b 3dup max max [
+        mg swap / [ * ] curry tri@
+    ] unless-zero ;
+
+PRIVATE>
+
+M: ryba >rgba ( ryba -- rgba )
+    [
+        [ red>> ] [ yellow>> ] [ blue>> ] tri
+        [ ryb>rgb ] normalized
+    ] [ alpha>> ] bi <rgba> ;
+
+: rgba>ryba ( rgba -- ryba )
+    >rgba-components [ [ rgb>ryb ] normalized ] [ <ryba> ] bi* ;

extra/colors/ryb/summary.txt

@@ -0,0 +1 @@
+RYB colors