diff options
Diffstat (limited to 'stdlib/source/library/lux/data/color.lux')
| -rw-r--r-- | stdlib/source/library/lux/data/color.lux | 102 |
1 files changed, 18 insertions, 84 deletions
diff --git a/stdlib/source/library/lux/data/color.lux b/stdlib/source/library/lux/data/color.lux index a886acb79..2bfa5e5af 100644 --- a/stdlib/source/library/lux/data/color.lux +++ b/stdlib/source/library/lux/data/color.lux @@ -33,85 +33,19 @@ (def .public rgb (-> Color RGB) (|>> nominal.representation)) - - (def .public equivalence - (Equivalence Color) - (of equivalence.functor each ..rgb rgb.equivalence)) - - (def .public hash - (Hash Color) - (of hash.functor each ..rgb rgb.hash)) - - (with_template [<color> <rgb>] - [(def .public <color> - Color - (nominal.abstraction <rgb>))] - - [black rgb.black] - [white rgb.white] - ) - - (with_template [<color> <rgb>] - [(def .public <color> - (Monoid Color) - (implementation - (def identity - (nominal.abstraction - (of <rgb> identity))) - - (def (composite left right) - (nominal.abstraction - (of <rgb> composite - (nominal.representation left) - (nominal.representation right))))))] - - [addition rgb.addition] - [subtraction rgb.subtraction] - ) - - (def .public complement - (-> Color Color) - (|>> nominal.representation - rgb.complement - nominal.abstraction)) ) -(def (normal ratio) - (-> Frac Frac) - (cond (f.> +1.0 ratio) - (f.% +1.0 ratio) +(def (ratio it) + (-> Frac + Frac) + (cond (f.> +1.0 it) + (f.% +1.0 it) - (f.< +0.0 ratio) - (|> ratio (f.% +1.0) (f.+ +1.0)) + (f.< +0.0 it) + (|> it (f.% +1.0) (f.+ +1.0)) ... else - ratio)) - -(def .public (interpolated ratio end start) - (-> Frac Color Color Color) - (let [dS (..normal ratio) - dE (|> +1.0 (f.- dS)) - interpolated' (is (-> Nat Nat Nat) - (function (_ end start) - (|> (|> start .int int.frac (f.* dS)) - (f.+ (|> end .int int.frac (f.* dE))) - f.int - .nat))) - start (rgb start) - end (rgb end)] - (|> (rgb.rgb (interpolated' (rgb.red end) (rgb.red start)) - (interpolated' (rgb.green end) (rgb.green start)) - (interpolated' (rgb.blue end) (rgb.blue start))) - of_rgb))) - -(with_template [<name> <target>] - [(def .public (<name> ratio color) - (-> Frac Color Color) - (..interpolated ratio <target> color))] - - [darker ..black] - [brighter ..white] - ) + it)) (with_template [<op> <name>] [(def .public (<name> ratio it) @@ -120,7 +54,7 @@ (|> (hsl.hsl (hsl.hue it) (|> it hsl.saturation - (f.* (|> +1.0 (<op> (..normal ratio)))) + (f.* (|> +1.0 (<op> (..ratio ratio)))) (f.min +1.0)) (hsl.luminance it)) hsl.rgb @@ -147,12 +81,12 @@ saturation (hsl.saturation hsl) luminance (hsl.luminance hsl)] [color - (|> (hsl.hsl (|> hue (f.+ <1>) ..normal) + (|> (hsl.hsl (|> hue (f.+ <1>) ..ratio) saturation luminance) hsl.rgb of_rgb) - (|> (hsl.hsl (|> hue (f.+ <2>) ..normal) + (|> (hsl.hsl (|> hue (f.+ <2>) ..ratio) saturation luminance) hsl.rgb @@ -177,9 +111,9 @@ hsl.rgb ..of_rgb)))] [color - (|> hue (f.+ <1>) ..normal of_hue) - (|> hue (f.+ <2>) ..normal of_hue) - (|> hue (f.+ <3>) ..normal of_hue)])))] + (|> hue (f.+ <1>) ..ratio of_hue) + (|> hue (f.+ <2>) ..ratio of_hue) + (|> hue (f.+ <3>) ..ratio of_hue)])))] [square (|> +1.0 (f./ +4.0)) (|> +2.0 (f./ +4.0)) (|> +3.0 (f./ +4.0))] [tetradic (|> +2.0 (f./ +12.0)) (|> +6.0 (f./ +12.0)) (|> +8.0 (f./ +12.0))] @@ -197,9 +131,9 @@ hue (hsl.hue it) saturation (hsl.saturation it) luminance (hsl.luminance it) - spread (..normal spread)] + spread (..ratio spread)] (list#each (function (_ idx) - (|> (hsl.hsl (|> idx ++ .int int.frac (f.* spread) (f.+ hue) ..normal) + (|> (hsl.hsl (|> idx ++ .int int.frac (f.* spread) (f.+ hue) ..ratio) saturation luminance) hsl.rgb @@ -212,12 +146,12 @@ hue (hsb.hue it) saturation (hsb.saturation it) brightness (hsb.brightness it) - spread (..normal spread)] + spread (..ratio spread)] (|> (list.indices variations) (list#each (|>> ++ .int int.frac (f.* spread) (f.+ brightness) - ..normal + ..ratio (hsb.hsb hue saturation) hsb.rgb ..of_rgb))))) |