Initial commit
[yotta-zoomer.git] / color-map.lisp
blob7a12be54e36fd5e28219561d737534ee3a0d6336
2 (defun get-red (color-list)
3 (cadr (assoc :red color-list)))
5 (defun get-green (color-list)
6 (cadr (assoc :green color-list)))
8 (defun get-blue (color-list)
9 (cadr (assoc :blue color-list)))
11 (defun get-point (color-list)
12 (cadr (assoc :point color-list)))
14 (defun calc-normal-alpha (start end alpha)
15 (* (- alpha start) (/ 1.0 (- end start))))
17 (defun add-point-to-color-list (color-list point &key red green blue)
18 (list
19 `((:red . ,red)
20 (:green . ,green)
21 (:blue . ,blue)
22 (:point . ,point))
23 color-list))
25 (defun add-points-to-color-list (color-list points)
26 (append
27 (loop
28 for point in points
29 collect
30 (destructuring-bind
31 (p &key red green blue)
32 point
33 `((:red ,red)
34 (:green ,green)
35 (:blue ,blue)
36 (:point ,p))))
37 color-list))
39 (defparameter *color-list*
40 (add-points-to-color-list
41 nil
42 '((0.0 :red 255 :green 255 :blue 255)
43 (0.1 :red 64 :green 0 :blue 64)
44 (0.5 :red 0 :green 64 :blue 64)
45 (1.0 :red 64 :green 63 :blue 0))))
47 (defun sort-color-list (color-list)
48 (sort color-list
49 #'(lambda (x y)
50 (< (cadr (assoc :point x))
51 (cadr (assoc :point y))))))
53 (defun make-color-list-interpolator (color-list)
54 (let
55 ((sorted-color-list (sort-color-list color-list)))
56 (lambda (alpha)
57 (destructuring-bind
58 (start end)
59 (loop
60 for next-color in sorted-color-list
61 and color = nil then next-color
62 when (<= alpha (cadr (assoc :point next-color)))
63 return
64 (list color next-color))
65 (list
66 (cons
67 :red
68 ((cadr (assoc :red start))
69 + (*
70 (- (cadr (assoc :red end))
71 (cadr (assoc :red end))
74 (format t "~A ~A~%~A~%" color next-color
75 (>= alpha (cadr (assoc :point next-color))))))))
78 return (cons color next-color)))))
80 ;; to do --
81 ;; sort-color-list
82 ;; make-color-list-interpolator