colors: moving some color definitions from extra/ to basis/.

[factor.git] / extra / colors / hsl / hsl.factor

diff --git a/extra/colors/hsl/hsl.factor b/extra/colors/hsl/hsl.factor
deleted file mode 100644 (file)
index f61bc6e..0000000
--- a/extra/colors/hsl/hsl.factor
+++ /dev/null
@@ -1,70 +0,0 @@
-! Copyright (C) 2012 John Benediktsson
-! See http://factorcode.org/license.txt for BSD license
-
-USING: accessors colors combinators kernel locals math
-math.order ;
-
-IN: colors.hsl
-
-TUPLE: hsla < color
-{ hue read-only }
-{ saturation read-only }
-{ lightness read-only }
-{ alpha read-only } ;
-
-C: <hsla> hsla
-
-<PRIVATE
-
-: value ( p q t -- value )
-    dup 0 < [ 1.0 + ] when
-    dup 1 > [ 1.0 - ] when
-    {
-        { [ dup 1/6 < ] [ [ over - ] dip * 6 * + ] }
-        { [ dup 1/2 < ] [ drop nip ] }
-        { [ dup 2/3 < ] [ [ over - ] dip 2/3 swap - * 6 * + ] }
-        [ 2drop ]
-    } cond ;
-
-PRIVATE>
-
-M: hsla >rgba
-    {
-        [ hue>> ] [ saturation>> ] [ lightness>> ] [ alpha>> ]
-    } cleave [| h s l |
-        s zero? [
-            l l l
-        ] [
-            l 0.5 < [ l s 1 + * ] [ l s + l s * - ] if :> q
-            l 2 * q - :> p
-            p q h 1/3 + value
-            p q h value
-            p q h 1/3 - value
-        ] if
-    ] dip <rgba> ; inline
-
-GENERIC: >hsla ( color -- hsla )
-
-M: object >hsla >rgba >hsla ;
-
-M: hsla >hsla ; inline
-
-M: rgba >hsla
-    >rgba-components [| r g b |
-        r g b min min :> min-c
-        r g b max max :> max-c
-        min-c max-c + 2 / :> l
-        max-c min-c - :> d
-        d zero? [ 0.0 0.0 ] [
-            max-c {
-                { r [ g b - d / g b < 6.0 0.0 ? + ] }
-                { g [ b r - d / 2.0 + ] }
-                { b [ r g - d / 4.0 + ] }
-            } case 6.0 /
-            l 0.5 > [
-                d 2 max-c - min-c - /
-            ] [
-                d max-c min-c + /
-            ] if
-        ] if l
-    ] dip <hsla> ;