blob: 623007ca0afff49bd3bff65dd38b48316430a3ed (
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
|
(in-package #:color)
(defun hsl->rgb (h s l)
(declare (optimize (speed 3) (safety 0))
((single-float 0.0 1.0) h s l))
(labels ((hue-to-rgb
(p q tt)
(declare (single-float p q tt))
(setf tt (mod tt 1))
(cond ((< tt (float (/ 1 6)))
(+ p (* (- q p) 6 tt)))
((< tt (/ 1 2))
q)
((< tt (float (/ 2 3)))
(+ p (* (- q p) 6 (- (/ 2 3) tt))))
(t p))))
(if (= s 0)
(values l l l)
(let* ((q (if (< l 0.5)
(* l (1+ s))
(+ l s (- (* l s)))))
(p (- (* 2 l) q)))
(values
(hue-to-rgb p q (+ h (/ 1 3)))
(hue-to-rgb p q h)
(hue-to-rgb p q (- h (/ 1 3))))))))
|
