3 files changed, 37 insertions(+), 4 deletions(-)

M hue-to-rgb.lisp
M make-plot.lisp
M packages.lisp

@@ 26,6 26,39 @@
   (mapcar (lambda (offset) (floor (* (hue-curve x :offset offset) 255))) 
           '(0 1/3 2/3)))
 
+;;; Color temp: Gonna define each channel separately.
+;;; Guesstimating linear movements from http://www.vendian.org/mncharity/dir3/blackbody/UnstableURLs/bbr_color.html
+;;; Gonna use temps in, then transform to 0 to 1 in the final combination
+
+(defun color-temp-red (k) ; k for kelvin
+  (cond
+    ((< k 6600)  255)
+    ((< k 9400)  (funcall (two-points 6600  255  9400 209) k))
+    ((< k 16000) (funcall (two-points 9400  209 16000 176) k))
+    ((< k 29800) (funcall (two-points 16000 176 29800 159) k))
+    (t 159)))
+
+(defun color-temp-green (k)
+  (cond
+    ((< k 6600)  (funcall (two-points 1000  #x38 6600  #xf9) k))
+    ((< k 13200) (funcall (two-points 6600  #xf9 13200 #xd0) k))
+    ((< k 19200) (funcall (two-points 13200 #xd0 19200 #xc6) k))
+    ((< k 29800) (funcall (two-points 19200 #xc6 29800 #xbf) k))
+    (t #xbf)))
+
+(defun color-temp-blue (k)
+  (cond
+    ((< k 6600)  (funcall (two-points 1000  #x00 6600  #xff) k))
+    (t #xff)))
+
+;;; input normalized 0 to 1
+(defun temp-to-rgb (x)
+  (if (= x 0) (return-from temp-to-rgb '(0 0 0)))
+  (let ((k (funcall (two-points 0 1000 1 29800) (sqrt x))))
+    (mapcar #'floor (list (color-temp-red   k) 
+                          (color-temp-green k)
+                          (color-temp-blue  k))))) 
+
 ;; (defun hue-plot () 
 ;;   (ppm-plot (lambda (x y) (hue-to-rgb x))
 ;;             (lambda (x) (apply #'format nil "~d ~d ~d " x))

@@ 16,9 16,9 @@
                       :if-does-not-exist :create)
                       
   (ppm-plot (lambda (x y) (mandelbrot (complex x y)))
-            (lambda (x) (apply #'format nil "~d ~d ~d " (hue-to-rgb (/ x 255))))
-            (range 0.50 :start -2.00 :steps 5000)
-            (range 1.25 :start -1.25 :steps 5000)
+            (lambda (x) (apply #'format nil "~d ~d ~d " (temp-to-rgb (/ x 255))))
+            (range 0.50 :start -2.00 :steps 3000)
+            (range 1.25 :start -1.25 :steps 3000)
             :file file))
 
 ;; Should look something like this:

@@ 10,4 10,4 @@
 
 (defpackage :dev.aarontag.hue-to-rgb
   (:use :common-lisp)
-  (:export :hue-to-rgb)) >
\ No newline at end of file
+  (:export :hue-to-rgb :temp-to-rgb)) <
\ No newline at end of file