diff options
Diffstat (limited to 'stdlib/source/lux/data/color.lux')
| -rw-r--r-- | stdlib/source/lux/data/color.lux | 220 |
1 files changed, 110 insertions, 110 deletions
diff --git a/stdlib/source/lux/data/color.lux b/stdlib/source/lux/data/color.lux index 61ee1249a..17546902a 100644 --- a/stdlib/source/lux/data/color.lux +++ b/stdlib/source/lux/data/color.lux @@ -6,7 +6,7 @@ (type opaque))) (def: rgb Nat +256) -(def: top Nat (n.dec rgb)) +(def: top Nat (n/dec rgb)) (def: nat-to-frac (-> Nat Frac) (|>. nat-to-int int-to-frac)) (def: frac-to-nat (-> Frac Nat) (|>. frac-to-int int-to-nat)) @@ -15,11 +15,11 @@ (def: scale-down (-> Nat Frac) - (|>. nat-to-frac (f./ rgb-factor))) + (|>. nat-to-frac (f// rgb-factor))) (def: scale-up (-> Frac Nat) - (|>. (f.* rgb-factor) frac-to-nat)) + (|>. (f/* rgb-factor) frac-to-nat)) (opaque: #export Color {} {#red Nat @@ -28,9 +28,9 @@ (def: #export (color [red green blue]) (-> [Nat Nat Nat] Color) - (@opaque [(n.% rgb red) - (n.% rgb green) - (n.% rgb blue)])) + (@opaque [(n/% rgb red) + (n/% rgb green) + (n/% rgb blue)])) (def: #export unpack (-> Color [Nat Nat Nat]) @@ -40,9 +40,9 @@ (def: (= reference sample) (let [[rr rg rb] (@repr reference) [sr sg sb] (@repr sample)] - (and (n.= rr sr) - (n.= rg sg) - (n.= rb sb))))) + (and (n/= rr sr) + (n/= rg sg) + (n/= rb sb))))) ) (def: #export (to-hsl color) @@ -51,67 +51,67 @@ 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]) (-> [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)) - (|> luminance (f.+ saturation) (f.- (f.* saturation luminance)))) - p (|> luminance (f.* 2.0) (f.- q)) - third (|> 1.0 (f./ 3.0))] - (color [(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))] + (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)))])))) + (scale-up (|> hue (f/- third) (hue-to-rgb p q)))])))) (def: #export (to-hsb color) (-> Color [Frac Frac Frac]) @@ -119,42 +119,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]) (-> [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)) + 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-nat) + mod (|> i (f/% 6.0) frac-to-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))] @@ -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)))) + 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 magenta yellow key])) (def: #export (from-cmyk [cyan magenta yellow key]) (-> [Frac Frac Frac Frac] Color) - (if (f.= 1.0 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))))] + (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,11 +203,11 @@ (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] - (frac-to-nat (f.+ (f.* dE (nat-to-frac end)) - (f.* dS (nat-to-frac start)))))) + (frac-to-nat (f/+ (f/* dE (nat-to-frac end)) + (f/* dS (nat-to-frac start)))))) [redS greenS blueS] (unpack start) [redE greenE blueE] (unpack end)] (color [(interpolate' redE redS) @@ -229,7 +229,7 @@ (def: #export (complement color) (-> Color Color) (let [[red green blue] (unpack color) - adjust (function [value] (|> top (n.- value)))] + adjust (function [value] (|> top (n/- value)))] (;;color [(adjust red) (adjust green) (adjust blue)]))) @@ -240,12 +240,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) @@ -258,12 +258,12 @@ (-> Color [Color Color Color]) (let [[hue saturation luminance] (to-hsl color)] [color - (from-hsl [(|> hue (f.+ <1>) normalize) saturation luminance]) - (from-hsl [(|> hue (f.+ <2>) normalize) saturation luminance])]))] + (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>] @@ -271,36 +271,36 @@ (-> Color [Color Color Color Color]) (let [[hue saturation luminance] (to-hsl color)] [color - (from-hsl [(|> hue (f.+ <1>) normalize) saturation luminance]) - (from-hsl [(|> hue (f.+ <2>) normalize) saturation luminance]) - (from-hsl [(|> hue (f.+ <3>) normalize) saturation luminance])]))] + (from-hsl [(|> hue (f/+ <1>) normalize) saturation luminance]) + (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)] (L/map (function [idx] - (from-hsl [(|> idx nat-to-frac (f.* slice) (f.+ hue) normalize) + (from-hsl [(|> idx nat-to-frac (f/* slice) (f/+ hue) normalize) saturation luminance])) - (list;n.range +0 (n.dec results)))))) + (list;n/range +0 (n/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./ (nat-to-frac results)))] - (|> (list;n.range +0 (n.dec results)) + slice (|> 1.0 (f// (nat-to-frac results)))] + (|> (list;n/range +0 (n/dec results)) (L/map (|>. nat-to-frac - (f.* slice) - (f.+ brightness) + (f/* slice) + (f/+ brightness) normalize [hue saturation] from-hsb)))))) |