diff options
Diffstat (limited to 'stdlib/source/lux/data/color.lux')
| -rw-r--r-- | stdlib/source/lux/data/color.lux | 140 |
1 files changed, 70 insertions, 70 deletions
diff --git a/stdlib/source/lux/data/color.lux b/stdlib/source/lux/data/color.lux index 8ff70f96c..e070ced40 100644 --- a/stdlib/source/lux/data/color.lux +++ b/stdlib/source/lux/data/color.lux @@ -8,7 +8,7 @@ [type abstract]]) -(def: rgb Nat +256) +(def: rgb Nat 256) (def: top Nat (dec rgb)) (def: rgb-factor Frac (|> top .int int-to-frac)) @@ -53,62 +53,62 @@ blue (scale-down blue) max ($_ f/max red green blue) min ($_ f/min red green blue) - luminance (|> (f/+ max min) (f// 2.0))] + luminance (|> (f/+ max min) (f// +2.0))] (if (f/= max min) ## Achromatic - [0.0 0.0 luminance] + [+0.0 +0.0 luminance] ## Chromatic (let [diff (|> max (f/- min)) saturation (|> diff - (f// (if (f/> 0.5 luminance) - (|> 2.0 (f/- max) (f/- min)) + (f// (if (f/> +0.5 luminance) + (|> +2.0 (f/- max) (f/- min)) (|> max (f/+ min))))) hue' (cond (f/= red max) (|> green (f/- blue) (f// diff) - (f/+ (if (f/< blue green) 6.0 0.0))) + (f/+ (if (f/< blue green) +6.0 +0.0))) (f/= green max) (|> blue (f/- red) (f// diff) - (f/+ 2.0)) + (f/+ +2.0)) ## (f/= blue max) (|> red (f/- green) (f// diff) - (f/+ 4.0)))] - [(|> hue' (f// 6.0)) + (f/+ +4.0)))] + [(|> hue' (f// +6.0)) saturation luminance])))) (def: (hue-to-rgb p q t) (-> Frac Frac Frac Frac) - (let [t (cond (f/< 0.0 t) (f/+ 1.0 t) - (f/> 1.0 t) (f/- 1.0 t) + (let [t (cond (f/< +0.0 t) (f/+ +1.0 t) + (f/> +1.0 t) (f/- +1.0 t) ## else t) - f2/3 (f// 3.0 2.0)] - (cond (f/< (f// 6.0 1.0) t) - (|> q (f/- p) (f/* 6.0) (f/* t) (f/+ p)) + f2/3 (f// +3.0 +2.0)] + (cond (f/< (f// +6.0 +1.0) t) + (|> q (f/- p) (f/* +6.0) (f/* t) (f/+ p)) - (f/< (f// 2.0 1.0) t) + (f/< (f// +2.0 +1.0) t) q (f/< f2/3 t) - (|> q (f/- p) (f/* (|> f2/3 (f/- t))) (f/* 6.0) (f/+ p)) + (|> q (f/- p) (f/* (|> f2/3 (f/- t))) (f/* +6.0) (f/+ p)) ## else p))) (def: #export (from-hsl [hue saturation luminance]) (-> [Frac Frac Frac] Color) - (if (f/= 0.0 saturation) + (if (f/= +0.0 saturation) ## Achromatic (let [intensity (scale-up luminance)] (color [intensity intensity intensity])) ## Chromatic - (let [q (if (f/< 0.5 luminance) - (|> saturation (f/+ 1.0) (f/* luminance)) + (let [q (if (f/< +0.5 luminance) + (|> saturation (f/+ +1.0) (f/* luminance)) (|> luminance (f/+ saturation) (f/- (f/* saturation luminance)))) - p (|> luminance (f/* 2.0) (f/- q)) - third (|> 1.0 (f// 3.0))] + p (|> luminance (f/* +2.0) (f/- q)) + third (|> +1.0 (f// +3.0))] (color [(scale-up (|> hue (f/+ third) (hue-to-rgb p q))) (scale-up (|> hue (hue-to-rgb p q))) (scale-up (|> hue (f/- third) (hue-to-rgb p q)))])))) @@ -123,41 +123,41 @@ min ($_ f/min red green blue) brightness max diff (|> max (f/- min)) - saturation (if (f/= 0.0 max) - 0.0 + saturation (if (f/= +0.0 max) + +0.0 (|> diff (f// max)))] (if (f/= max min) ## Achromatic - [0.0 saturation brightness] + [+0.0 saturation brightness] ## Chromatic (let [hue (cond (f/= red max) (|> green (f/- blue) (f// diff) - (f/+ (if (f/< blue green) 6.0 0.0))) + (f/+ (if (f/< blue green) +6.0 +0.0))) (f/= green max) (|> blue (f/- red) (f// diff) - (f/+ 2.0)) + (f/+ +2.0)) ## (f/= blue max) (|> red (f/- green) (f// diff) - (f/+ 4.0)))] - [(|> hue (f// 6.0)) + (f/+ +4.0)))] + [(|> hue (f// +6.0)) saturation brightness])))) (def: #export (from-hsb [hue saturation brightness]) (-> [Frac Frac Frac] Color) - (let [hue (|> hue (f/* 6.0)) + (let [hue (|> hue (f/* +6.0)) i (math.floor hue) f (|> hue (f/- i)) - p (|> 1.0 (f/- saturation) (f/* brightness)) - q (|> 1.0 (f/- (f/* f saturation)) (f/* brightness)) - t (|> 1.0 (f/- (|> 1.0 (f/- f) (f/* saturation))) (f/* brightness)) + p (|> +1.0 (f/- saturation) (f/* brightness)) + q (|> +1.0 (f/- (f/* f saturation)) (f/* brightness)) + t (|> +1.0 (f/- (|> +1.0 (f/- f) (f/* saturation))) (f/* brightness)) v brightness - mod (|> i (f/% 6.0) frac-to-int .nat) - red (case mod +0 v +1 q +2 p +3 p +4 t +5 v _ (undefined)) - green (case mod +0 t +1 v +2 v +3 q +4 p +5 p _ (undefined)) - blue (case mod +0 p +1 p +2 t +3 v +4 v +5 q _ (undefined))] + mod (|> i (f/% +6.0) frac-to-int .nat) + red (case mod 0 v 1 q 2 p 3 p 4 t 5 v _ (undefined)) + green (case mod 0 t 1 v 2 v 3 q 4 p 5 p _ (undefined)) + blue (case mod 0 p 1 p 2 t 3 v 4 v 5 q _ (undefined))] (color [(scale-up red) (scale-up green) (scale-up blue)]))) @@ -168,34 +168,34 @@ red (scale-down red) green (scale-down green) blue (scale-down blue) - key (|> 1.0 (f/- ($_ f/max red green blue))) - f (if (f/< 1.0 key) - (|> 1.0 (f// (|> 1.0 (f/- key)))) - 0.0) - cyan (|> 1.0 (f/- red) (f/- key) (f/* f)) - magenta (|> 1.0 (f/- green) (f/- key) (f/* f)) - yellow (|> 1.0 (f/- blue) (f/- key) (f/* f))] + key (|> +1.0 (f/- ($_ f/max red green blue))) + f (if (f/< +1.0 key) + (|> +1.0 (f// (|> +1.0 (f/- key)))) + +0.0) + cyan (|> +1.0 (f/- red) (f/- key) (f/* f)) + magenta (|> +1.0 (f/- green) (f/- key) (f/* f)) + yellow (|> +1.0 (f/- blue) (f/- key) (f/* f))] [cyan magenta yellow key])) (def: #export (from-cmyk [cyan magenta yellow key]) (-> [Frac Frac Frac Frac] Color) - (if (f/= 1.0 key) - (color [+0 +0 +0]) - (let [red (|> (|> 1.0 (f/- cyan)) - (f/* (|> 1.0 (f/- key)))) - green (|> (|> 1.0 (f/- magenta)) - (f/* (|> 1.0 (f/- key)))) - blue (|> (|> 1.0 (f/- yellow)) - (f/* (|> 1.0 (f/- key))))] + (if (f/= +1.0 key) + (color [0 0 0]) + (let [red (|> (|> +1.0 (f/- cyan)) + (f/* (|> +1.0 (f/- key)))) + green (|> (|> +1.0 (f/- magenta)) + (f/* (|> +1.0 (f/- key)))) + blue (|> (|> +1.0 (f/- yellow)) + (f/* (|> +1.0 (f/- key))))] (color [(scale-up red) (scale-up green) (scale-up blue)])))) (def: (normalize ratio) (-> Frac Frac) - (cond (f/> 1.0 ratio) - (f/% 1.0 ratio) + (cond (f/> +1.0 ratio) + (f/% +1.0 ratio) - (f/< 0.0 ratio) - (|> 1.0 (f/+ (f/% 1.0 ratio))) + (f/< +0.0 ratio) + (|> +1.0 (f/+ (f/% +1.0 ratio))) ## else ratio)) @@ -203,7 +203,7 @@ (def: #export (interpolate ratio end start) (-> Frac Color Color Color) (let [dS (normalize ratio) - dE (|> 1.0 (f/- dS)) + dE (|> +1.0 (f/- dS)) interpolate' (: (-> Nat Nat Nat) (function (_ end start) (|> (|> start .int int-to-frac (f/* dS)) @@ -216,7 +216,7 @@ (interpolate' greenE greenS) (interpolate' blueE blueS)]))) -(def: black Color (color [+0 +0 +0])) +(def: black Color (color [0 0 0])) (def: white Color (color [top top top])) (do-template [<name> <target>] @@ -242,8 +242,8 @@ (let [[hue saturation luminance] (to-hsl color)] (from-hsl [hue (|> saturation - (f/* (|> 1.0 (<op> (normalize ratio)))) - (f/min 1.0)) + (f/* (|> +1.0 (<op> (normalize ratio)))) + (f/min +1.0)) luminance])))] [saturate f/+] @@ -253,7 +253,7 @@ (def: #export (gray-scale color) (-> Color Color) (let [[_ _ luminance] (to-hsl color)] - (from-hsl [0.0 0.0 luminance]))) + (from-hsl [+0.0 +0.0 luminance]))) (do-template [<name> <1> <2>] [(def: #export (<name> color) @@ -263,9 +263,9 @@ (from-hsl [(|> hue (f/+ <1>) normalize) saturation luminance]) (from-hsl [(|> hue (f/+ <2>) normalize) saturation luminance])]))] - [triad (|> 1.0 (f// 3.0)) (|> 2.0 (f// 3.0))] - [clash (|> 1.0 (f// 4.0)) (|> 3.0 (f// 4.0))] - [split-complement (|> 1.0 (f// 5.0)) (|> 3.0 (f// 5.0))] + [triad (|> +1.0 (f// +3.0)) (|> +2.0 (f// +3.0))] + [clash (|> +1.0 (f// +4.0)) (|> +3.0 (f// +4.0))] + [split-complement (|> +1.0 (f// +5.0)) (|> +3.0 (f// +5.0))] ) (do-template [<name> <1> <2> <3>] @@ -277,13 +277,13 @@ (from-hsl [(|> hue (f/+ <2>) normalize) saturation luminance]) (from-hsl [(|> hue (f/+ <3>) normalize) saturation luminance])]))] - [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))] + [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))] ) (def: #export (analogous results slice color) (-> Nat Frac Color (List Color)) - (if (n/= +0 results) + (if (n/= 0 results) (list) (let [[hue saturation luminance] (to-hsl color) slice (normalize slice)] @@ -291,15 +291,15 @@ (from-hsl [(|> idx .int int-to-frac (f/* slice) (f/+ hue) normalize) saturation luminance])) - (list.n/range +0 (dec results)))))) + (list.n/range 0 (dec results)))))) (def: #export (monochromatic results color) (-> Nat Color (List Color)) - (if (n/= +0 results) + (if (n/= 0 results) (list) (let [[hue saturation brightness] (to-hsb color) - slice (|> 1.0 (f// (|> results .int int-to-frac)))] - (|> (list.n/range +0 (dec results)) + slice (|> +1.0 (f// (|> results .int int-to-frac)))] + (|> (list.n/range 0 (dec results)) (list/map (|>> .int int-to-frac (f/* slice) (f/+ brightness) |