blob: 24ed8f61566e190a9a0b1b3a4143d8962e18e9e4 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
(.module:
[lux #*
[control
[monad (#+ do)]]
[data
["@" color]
[number
["." frac ("#/." number)]]]
["." math
["r" random]]]
lux/test)
(def: color
(r.Random @.Color)
(|> ($_ r.and r.nat r.nat r.nat)
(:: r.monad map @.from-rgb)))
(def: scale
(-> Nat Frac)
(|>> .int int-to-frac))
(def: square (-> Frac Frac) (math.pow +2.0))
(def: (distance from to)
(-> @.Color @.Color Frac)
(let [[fr fg fb] (@.to-rgb from)
[tr tg tb] (@.to-rgb to)]
(math.pow +0.5 ($_ f/+
(|> (scale tr) (f/- (scale fr)) square)
(|> (scale tg) (f/- (scale fg)) square)
(|> (scale tb) (f/- (scale fb)) square)))))
(def: error-margin Frac +1.8)
(def: black (@.from-rgb [0 0 0]))
(def: white (@.from-rgb [255 255 255]))
(do-template [<field>]
[(def: (<field> color)
(-> @.Color Frac)
(let [[hue saturation luminance] (@.to-hsl color)]
<field>))]
[saturation]
[luminance]
)
(context: "Color."
(<| (times 100)
(do @
[any color
colorful (|> color
(r.filter (function (_ color) (|> (distance color black) (f/>= +100.0))))
(r.filter (function (_ color) (|> (distance color white) (f/>= +100.0)))))
mediocre (|> color
(r.filter (|>> saturation
((function (_ saturation)
(and (f/>= +0.25 saturation)
(f/<= +0.75 saturation)))))))
ratio (|> r.frac (r.filter (f/>= +0.5)))]
($_ seq
(test "Has equivalence."
(:: @.equivalence = any any))
(test "Can convert to/from HSL."
(|> any @.to-hsl @.from-hsl
(distance any)
(f/<= error-margin)))
(test "Can convert to/from HSB."
(|> any @.to-hsb @.from-hsb
(distance any)
(f/<= error-margin)))
(test "Can convert to/from CMYK."
(|> any @.to-cmyk @.from-cmyk
(distance any)
(f/<= error-margin)))
(test "Can interpolate between 2 colors."
(and (f/<= (distance colorful black)
(distance (@.darker ratio colorful) black))
(f/<= (distance colorful white)
(distance (@.brighter ratio colorful) white))))
(test "Can calculate complement."
(let [~any (@.complement any)
(^open "@/.") @.equivalence]
(and (not (@/= any ~any))
(@/= any (@.complement ~any)))))
(test "Can saturate color."
(f/> (saturation mediocre)
(saturation (@.saturate ratio mediocre))))
(test "Can de-saturate color."
(f/< (saturation mediocre)
(saturation (@.de-saturate ratio mediocre))))
(test "Can gray-scale color."
(let [gray'ed (@.gray-scale mediocre)]
(and (f/= +0.0
(saturation gray'ed))
(|> (luminance gray'ed)
(f/- (luminance mediocre))
frac/abs
(f/<= error-margin)))))
))))
|
