aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/data/color/scheme.lux
blob: 380502eb3bcb13899e7217e730d43dbf8f9ac658 (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
(.require
 [library
  [lux (.except)
   [data
    [collection
     ["[0]" list (.use "[1]#[0]" functor)]]]
   [math
    [number
     ["i" int]
     ["f" frac]]]]]
 [//
  [rgb (.only RGB)]
  ["[0]" hsl]
  ["[0]" hsb]])

(def (ratio it)
  (-> Frac
      Frac)
  (cond (f.> +1.0 it)
        (f.% +1.0 it)

        (f.< +0.0 it)
        (|> it (f.% +1.0) (f.+ +1.0))

        ... else
        it))

(with_template [<name> <1> <2>]
  [(`` (def .public (<name> it)
         (-> RGB
             [RGB RGB RGB])
         (let [(open "/[0]") (hsl.of_rgb it)]
           [it
            (hsl.rgb (hsl.hsl (|> /#hue (f.+ <1>) ..ratio)
                              /#saturation
                              /#luminance))
            (hsl.rgb (hsl.hsl (|> /#hue (f.+ <2>) ..ratio)
                              /#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))]
  )

(with_template [<name> <1> <2> <3>]
  [(`` (def .public (<name> it)
         (-> RGB
             [RGB RGB RGB RGB])
         (let [(open "/[0]") (hsl.of_rgb it)
               of_hue (is (-> hsl.Value
                              RGB)
                          (function (_ hue)
                            (hsl.rgb (hsl.hsl hue /#saturation /#luminance))))]
           [it
            (|> /#hue (f.+ <1>) ..ratio of_hue)
            (|> /#hue (f.+ <2>) ..ratio of_hue)
            (|> /#hue (f.+ <3>) ..ratio of_hue)])))]

  [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))]
  )

(type .public Spread
  Frac)

... https://en.wikipedia.org/wiki/Color_scheme
(type .public Scheme
  (-> Spread Nat RGB
      (List RGB)))

(def .public (analogous spread variations it)
  Scheme
  (let [it (hsl.of_rgb it)
        hue (the hsl.#hue it)
        saturation (the hsl.#saturation it)
        luminance (the hsl.#luminance it)
        spread (..ratio spread)]
    (list#each (function (_ idx)
                 (hsl.rgb (hsl.hsl (|> idx ++ .int i.frac (f.* spread) (f.+ hue) ..ratio)
                                   saturation
                                   luminance)))
               (list.indices variations))))

(def .public (monochromatic spread variations it)
  Scheme
  (let [it (hsb.of_rgb it)
        hue (hsb.hue it)
        saturation (hsb.saturation it)
        brightness (hsb.brightness it)
        spread (..ratio spread)]
    (|> (list.indices variations)
        (list#each (|>> ++ .int i.frac
                        (f.* spread)
                        (f.+ brightness)
                        ..ratio
                        (hsb.hsb hue saturation)
                        hsb.rgb)))))