diff options
Diffstat (limited to 'color.lisp')
| -rw-r--r-- | color.lisp | 48 |
1 files changed, 23 insertions, 25 deletions
@@ -1,28 +1,26 @@ (in-package #:color) (defun hsl->rgb (h s l) - (let* ((c (* (- 1 (abs (- (* 2 l) 1))) s)) - (x (* c (- 1 (abs (- (mod (/ h 60) 2) 1))))) - (m (- l (/ c 2))) - (r m) - (g m) - (b m)) - (cond ((<= 0 h 59) - (incf r c) - (incf g x)) - ((<= 60 h 119) - (incf r x) - (incf g c)) - ((<= 120 h 179) - (incf g c) - (incf b x)) - ((<= 180 239) - (incf g x) - (incf b c)) - ((<= 240 299) - (incf r x) - (incf b c)) - ((<= 300 359) - (incf r c) - (incf b x))) - (values r g b))) + (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)))))))) |