diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/data/color.lux | 126 |
1 files changed, 63 insertions, 63 deletions
diff --git a/stdlib/source/lux/data/color.lux b/stdlib/source/lux/data/color.lux index 2ce752cfd..82d421715 100644 --- a/stdlib/source/lux/data/color.lux +++ b/stdlib/source/lux/data/color.lux @@ -20,15 +20,15 @@ (def: rgb 256) (def: top (dec rgb)) -(def: rgb-factor (|> top .int int.frac)) +(def: rgb_factor (|> top .int int.frac)) -(def: scale-down +(def: scale_down (-> Nat Frac) - (|>> .int int.frac (f./ rgb-factor))) + (|>> .int int.frac (f./ rgb_factor))) -(def: scale-up +(def: scale_up (-> Frac Nat) - (|>> (f.* rgb-factor) f.int .nat)) + (|>> (f.* rgb_factor) f.int .nat)) (type: #export RGB {#red Nat @@ -50,13 +50,13 @@ (abstract: #export Color RGB - (def: #export (from-rgb [red green blue]) + (def: #export (from_rgb [red green blue]) (-> RGB Color) (:abstraction {#red (n.% ..rgb red) #green (n.% ..rgb green) #blue (n.% ..rgb blue)})) - (def: #export to-rgb + (def: #export to_rgb (-> Color RGB) (|>> :representation)) @@ -78,17 +78,17 @@ (def: (hash value) (let [[r g b] (:representation value)] ($_ i64.or - (i64.left-shift 16 r) - (i64.left-shift 8 g) + (i64.left_shift 16 r) + (i64.left_shift 8 g) b)))) (def: #export black - (..from-rgb {#red 0 + (..from_rgb {#red 0 #green 0 #blue 0})) (def: #export white - (..from-rgb {#red ..top + (..from_rgb {#red ..top #green ..top #blue ..top})) @@ -128,12 +128,12 @@ #blue (n.min lB rB)})))) ) -(def: #export (to-hsl color) +(def: #export (to_hsl color) (-> Color HSL) - (let [[red green blue] (to-rgb color) - red (scale-down red) - green (scale-down green) - blue (scale-down blue) + (let [[red green blue] (to_rgb color) + 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))] @@ -163,7 +163,7 @@ saturation luminance])))) -(def: (hue-to-rgb p q t) +(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) @@ -182,12 +182,12 @@ ## else p))) -(def: #export (from-hsl [hue saturation luminance]) +(def: #export (from_hsl [hue saturation luminance]) (-> HSL Color) (if (f.= +0.0 saturation) ## Achromatic - (let [intensity (scale-up luminance)] - (from-rgb {#red intensity + (let [intensity (scale_up luminance)] + (from_rgb {#red intensity #green intensity #blue intensity})) ## Chromatic @@ -196,16 +196,16 @@ (|> 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)))})))) + (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)))})))) -(def: #export (to-hsb color) +(def: #export (to_hsb color) (-> Color HSB) - (let [[red green blue] (to-rgb color) - red (scale-down red) - green (scale-down green) - blue (scale-down blue) + (let [[red green blue] (to_rgb color) + red (scale_down red) + green (scale_down green) + blue (scale_down blue) max ($_ f.max red green blue) min ($_ f.min red green blue) brightness max @@ -232,7 +232,7 @@ saturation brightness])))) -(def: #export (from-hsb [hue saturation brightness]) +(def: #export (from_hsb [hue saturation brightness]) (-> HSB Color) (let [hue (|> hue (f.* +6.0)) i (math.floor hue) @@ -245,16 +245,16 @@ 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))] - (from-rgb {#red (scale-up red) - #green (scale-up green) - #blue (scale-up blue)}))) + (from_rgb {#red (scale_up red) + #green (scale_up green) + #blue (scale_up blue)}))) -(def: #export (to-cmyk color) +(def: #export (to_cmyk color) (-> Color CMYK) - (let [[red green blue] (to-rgb color) - red (scale-down red) - green (scale-down green) - blue (scale-down blue) + (let [[red green blue] (to_rgb color) + 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)))) @@ -267,10 +267,10 @@ #yellow yellow #key key})) -(def: #export (from-cmyk [cyan magenta yellow key]) +(def: #export (from_cmyk [cyan magenta yellow key]) (-> CMYK Color) (if (f.= +1.0 key) - (from-rgb {#red 0 + (from_rgb {#red 0 #green 0 #blue 0}) (let [red (|> (|> +1.0 (f.- cyan)) @@ -279,9 +279,9 @@ (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)})))) + (from_rgb {#red (scale_up red) + #green (scale_up green) + #blue (scale_up blue)})))) (def: (normalize ratio) (-> Frac Frac) @@ -304,9 +304,9 @@ (f.+ (|> end .int int.frac (f.* dE))) f.int .nat))) - [redS greenS blueS] (to-rgb start) - [redE greenE blueE] (to-rgb end)] - (from-rgb {#red (interpolate' redE redS) + [redS greenS blueS] (to_rgb start) + [redE greenE blueE] (to_rgb end)] + (from_rgb {#red (interpolate' redE redS) #green (interpolate' greenE greenS) #blue (interpolate' blueE blueS)}))) @@ -322,53 +322,53 @@ (template [<name> <op>] [(def: #export (<name> ratio color) (-> Frac Color Color) - (let [[hue saturation luminance] (to-hsl color)] - (from-hsl [hue + (let [[hue saturation luminance] (to_hsl color)] + (from_hsl [hue (|> saturation (f.* (|> +1.0 (<op> (..normalize ratio)))) (f.min +1.0)) luminance])))] [saturate f.+] - [de-saturate f.-] + [de_saturate f.-] ) -(def: #export (gray-scale color) +(def: #export (gray_scale color) (-> Color Color) - (let [[_ _ luminance] (to-hsl color)] - (from-hsl [+0.0 + (let [[_ _ luminance] (to_hsl color)] + (from_hsl [+0.0 +0.0 luminance]))) (template [<name> <1> <2>] [(def: #export (<name> color) (-> Color [Color Color Color]) - (let [[hue saturation luminance] (to-hsl 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))] + [split_complement (|> +1.0 (f./ +5.0)) (|> +3.0 (f./ +5.0))] ) (template [<name> <1> <2> <3>] [(def: #export (<name> color) (-> Color [Color Color Color Color]) - (let [[hue saturation luminance] (to-hsb color)] + (let [[hue saturation luminance] (to_hsb color)] [color - (from-hsb [(|> hue (f.+ <1>) ..normalize) + (from_hsb [(|> hue (f.+ <1>) ..normalize) saturation luminance]) - (from-hsb [(|> hue (f.+ <2>) ..normalize) + (from_hsb [(|> hue (f.+ <2>) ..normalize) saturation luminance]) - (from-hsb [(|> hue (f.+ <3>) ..normalize) + (from_hsb [(|> hue (f.+ <3>) ..normalize) saturation luminance])]))] @@ -384,17 +384,17 @@ (def: #export (analogous spread variations color) (-> Spread Nat Color (List Color)) - (let [[hue saturation brightness] (to-hsb color) + (let [[hue saturation brightness] (to_hsb color) spread (..normalize spread)] (list\map (function (_ idx) - (from-hsb [(|> idx inc .int int.frac (f.* spread) (f.+ hue) ..normalize) + (from_hsb [(|> idx inc .int int.frac (f.* spread) (f.+ hue) ..normalize) saturation brightness])) (list.indices variations)))) (def: #export (monochromatic spread variations color) (-> Spread Nat Color (List Color)) - (let [[hue saturation brightness] (to-hsb color) + (let [[hue saturation brightness] (to_hsb color) spread (..normalize spread)] (|> (list.indices variations) (list\map (|>> inc .int int.frac @@ -402,7 +402,7 @@ (f.+ brightness) ..normalize [hue saturation] - from-hsb))))) + from_hsb))))) (type: #export Alpha Rev) |