diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/data/color.lux | 206 |
1 files changed, 104 insertions, 102 deletions
diff --git a/stdlib/source/lux/data/color.lux b/stdlib/source/lux/data/color.lux index 60b87ab61..3a094b01c 100644 --- a/stdlib/source/lux/data/color.lux +++ b/stdlib/source/lux/data/color.lux @@ -4,7 +4,9 @@ [equivalence (#+ Equivalence)]] [data [number - ["." rev ("#;." interval)]] + ["." int] + ["." rev ("#;." interval)] + ["f" frac]] [collection ["." list ("#;." functor)]]] ["." math] @@ -14,15 +16,15 @@ (def: rgb Nat 256) (def: top Nat (dec rgb)) -(def: rgb-factor Frac (|> top .int int-to-frac)) +(def: rgb-factor Frac (|> top .int int.frac)) (def: scale-down (-> Nat Frac) - (|>> .int int-to-frac (f// rgb-factor))) + (|>> .int int.frac (f./ rgb-factor))) (def: scale-up (-> Frac Nat) - (|>> (f/* rgb-factor) frac-to-int .nat)) + (|>> (f.* rgb-factor) f.int .nat)) (type: #export RGB {#red Nat @@ -71,71 +73,71 @@ red (scale-down red) green (scale-down green) blue (scale-down blue) - max ($_ f/max red green blue) - min ($_ f/min red green blue) - luminance (|> (f/+ max min) (f// +2.0))] - (if (f/= max min) + max ($_ f.max red green blue) + min ($_ f.min red green blue) + luminance (|> (f.+ max min) (f./ +2.0))] + (if (f.= max min) ## Achromatic [+0.0 +0.0 luminance] ## Chromatic - (let [diff (|> max (f/- min)) + (let [diff (|> max (f.- min)) saturation (|> diff - (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.> +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/= green max) - (|> blue (f/- red) (f// diff) - (f/+ +2.0)) + (f.= green max) + (|> blue (f.- red) (f./ diff) + (f.+ +2.0)) - ## (f/= blue max) - (|> red (f/- green) (f// diff) - (f/+ +4.0)))] - [(|> hue' (f// +6.0)) + ## (f.= blue max) + (|> red (f.- green) (f./ diff) + (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)) + (f.< f2/3 t) + (|> q (f.- p) (f.* (|> f2/3 (f.- t))) (f.* +6.0) (f.+ p)) ## else p))) (def: #export (from-hsl [hue saturation luminance]) (-> HSL Color) - (if (f/= +0.0 saturation) + (if (f.= +0.0 saturation) ## Achromatic (let [intensity (scale-up luminance)] (from-rgb {#red intensity #green intensity #blue intensity})) ## Chromatic - (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))] - (from-rgb {#red (scale-up (|> hue (f/+ third) (hue-to-rgb p q))) + (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))] + (from-rgb {#red (scale-up (|> hue (f.+ third) (hue-to-rgb p q))) #green (scale-up (|> hue (hue-to-rgb p q))) - #blue (scale-up (|> hue (f/- third) (hue-to-rgb p q)))})))) + #blue (scale-up (|> hue (f.- third) (hue-to-rgb p q)))})))) (def: #export (to-hsb color) (-> Color HSB) @@ -143,42 +145,42 @@ red (scale-down red) green (scale-down green) blue (scale-down blue) - max ($_ f/max red green blue) - min ($_ f/min red green blue) + max ($_ f.max red green blue) + min ($_ f.min red green blue) brightness max - diff (|> max (f/- min)) - saturation (if (f/= +0.0 max) + diff (|> max (f.- min)) + saturation (if (f.= +0.0 max) +0.0 - (|> diff (f// max)))] - (if (f/= max min) + (|> diff (f./ max)))] + (if (f.= max min) ## Achromatic [+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/= green max) - (|> blue (f/- red) (f// diff) - (f/+ +2.0)) - - ## (f/= blue max) - (|> red (f/- green) (f// diff) - (f/+ +4.0)))] - [(|> hue (f// +6.0)) + (let [hue (cond (f.= red max) + (|> green (f.- blue) (f./ diff) + (f.+ (if (f.< blue green) +6.0 +0.0))) + + (f.= green max) + (|> blue (f.- red) (f./ diff) + (f.+ +2.0)) + + ## (f.= blue max) + (|> red (f.- green) (f./ diff) + (f.+ +4.0)))] + [(|> hue (f./ +6.0)) saturation brightness])))) (def: #export (from-hsb [hue saturation brightness]) (-> HSB 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)) + 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)) v brightness - mod (|> i (f/% +6.0) frac-to-int .nat) + mod (|> i (f.% +6.0) f.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))] @@ -192,13 +194,13 @@ 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)))) + 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 (|> +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 cyan #magenta magenta #yellow yellow @@ -206,27 +208,27 @@ (def: #export (from-cmyk [cyan magenta yellow key]) (-> CMYK Color) - (if (f/= +1.0 key) + (if (f.= +1.0 key) (from-rgb {#red 0 #green 0 #blue 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))))] + (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))))] (from-rgb {#red (scale-up red) #green (scale-up green) #blue (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)) @@ -234,12 +236,12 @@ (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)) - (f/+ (|> end .int int-to-frac (f/* dE))) - frac-to-int + (|> (|> start .int int.frac (f.* dS)) + (f.+ (|> end .int int.frac (f.* dE))) + f.int .nat))) [redS greenS blueS] (to-rgb start) [redE greenE blueE] (to-rgb end)] @@ -277,12 +279,12 @@ (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/+] - [de-saturate f/-] + [saturate f.+] + [de-saturate f.-] ) (def: #export (gray-scale color) @@ -297,16 +299,16 @@ (-> Color [Color Color Color]) (let [[hue saturation luminance] (to-hsl color)] [color - (from-hsl [(|> hue (f/+ <1>) normalize) + (from-hsl [(|> hue (f.+ <1>) normalize) saturation luminance]) - (from-hsl [(|> hue (f/+ <2>) normalize) + (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))] ) (template [<name> <1> <2> <3>] @@ -314,18 +316,18 @@ (-> Color [Color Color Color Color]) (let [[hue saturation luminance] (to-hsl color)] [color - (from-hsl [(|> hue (f/+ <1>) normalize) + (from-hsl [(|> hue (f.+ <1>) normalize) saturation luminance]) - (from-hsl [(|> hue (f/+ <2>) normalize) + (from-hsl [(|> hue (f.+ <2>) normalize) saturation luminance]) - (from-hsl [(|> hue (f/+ <3>) normalize) + (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) @@ -335,7 +337,7 @@ (let [[hue saturation luminance] (to-hsl color) slice (normalize slice)] (list;map (function (_ idx) - (from-hsl [(|> idx .int int-to-frac (f/* slice) (f/+ hue) normalize) + (from-hsl [(|> idx .int int.frac (f.* slice) (f.+ hue) normalize) saturation luminance])) (list.indices results))))) @@ -345,11 +347,11 @@ (if (n/= 0 results) (list) (let [[hue saturation brightness] (to-hsb color) - slice (|> +1.0 (f// (|> results .int int-to-frac)))] + slice (|> +1.0 (f./ (|> results .int int.frac)))] (|> (list.indices results) - (list;map (|>> .int int-to-frac - (f/* slice) - (f/+ brightness) + (list;map (|>> .int int.frac + (f.* slice) + (f.+ brightness) normalize [hue saturation] from-hsb)))))) |