;; This file:
;;   http://anggtwu.net/MAXIMA/mycolorlerp1.lisp.html
;;   http://anggtwu.net/MAXIMA/mycolorlerp1.lisp.pyg.html
;;   http://anggtwu.net/MAXIMA/mycolorlerp1.lisp
;;          (find-angg "MAXIMA/mycolorlerp1.lisp")
;; Author: Eduardo Ochs <eduardoochs@gmail.com>
;; Thanks: to mrcom from #clschool =)
;;
;; This file implements a function my-color-lerp, that does this,
;;
;;   https://en.wikipedia.org/wiki/Linear_interpolation
;;
;; for colors. For example,
;;
;;   (my-color-lerp "#EEEEFF" "#0000FF" 0.5)
;;
;; returns a color midway from a very light blue to pure blue.
;;
;; See: (find-es "maxima" "foo-and-foo")
;;      (find-es "lisp" "color-values")

(defmacro from-colorspec (colorspec &rest body)
  `(flet ((tofloat (n) (/ n 255.0)))
     (let* ((colorspec ,colorspec)
	    (int    (parse-integer colorspec :start 1 :radix 16))
	    (rr     (ldb (byte 8 16) int))
	    (gg     (ldb (byte 8  8) int))
	    (bb     (ldb (byte 8  0) int))
	    (rx     (tofloat rr))
	    (gx     (tofloat gg))
	    (bx     (tofloat bb))
	    (floats (list rx gx bx)))
       (declare (ignorable floats))
       ,@body)))

#|
* (eepitch-sly)
* (eepitch-kill)
* (eepitch-sly)
(load "mycolorlerp1.lisp")
(from-colorspec "#2046F0" bb)
(from-colorspec "#2046F0" (list colorspec floats))
(from-colorspec "#2046F0" floats)

|#


(defmacro from-floats (floats &rest body)
  `(flet   ((toh    (n)     (format nil "~2,'0x" n))
	    (tohhh  (a b c) (format nil "#~a~a~a" a b c))
	    (trunc  (x y z) (max x (min y z)))
	    (toint  (x)     (round (* 255 x))))
     (flet ((to0255 (x)     (trunc 0 (toint x) 255)))
       (let* ((floats ,floats)
	      (rx (first  floats))
	      (gx (second floats))
	      (bx (third  floats))
	      (rr (to0255 rx))
	      (gg (to0255 gx))
	      (bb (to0255 bx))
	      (colorspec (tohhh (toh rr) (toh gg) (toh bb))))
	 (declare (ignorable colorspec))
	 ,@body))))

#|
* (eepitch-sly)
* (eepitch-kill)
* (eepitch-sly)
(load "mycolorlerp1.lisp")
(from-floats '(0.1 0.5 0.9) rx)
(from-floats '(0.1 0.5 0.9) (toh 10))
(from-floats '(0.1 0.5 0.9) (toint rx))
(from-floats '(0.1 0.5 0.9) (list rr gg bb colorspec))

|#


(defun my-k*v (k v)
  (map 'list (lambda (x) (* k x)) v))

(defun my-u+v (u v)
  (loop for i from 0 to 2
	collect (+ (nth i u) (nth i v))))

(defun my-u-v (u v) (my-u+v u (my-k*v -1 v)))

(defun my-lerp (v0 v1 tt) (my-u+v v0 (my-k*v tt (my-u-v v1 v0))))

(defun my-color-lerp (colorspec0 colorspec1 tt)
  (let* ((v0 (from-colorspec colorspec0 floats))
         (v1 (from-colorspec colorspec1 floats))
         (vt (my-lerp v0 v1 tt)))
    (from-floats vt colorspec)))

(defun $my_color_lerp (colorspec0 colorspec1 tt)
  (my-color-lerp colorspec0 colorspec1 tt))

#|
* (eepitch-sly)
* (eepitch-kill)
* (eepitch-sly)
(load "mycolorlerp1.lisp")
(my-k*v 10 '(1 2 3))
(my-u+v '(10 20 30) '(4 5 6))
(my-u-v '(10 20 30) '(4 5 6))
(my-lerp '(1 2 3) '(101 202 303) 0)
(my-lerp '(1 2 3) '(101 202 303) 1)
(my-lerp '(1 2 3) '(101 202 303) 0.1)
(my-color-lerp "#010203" "#112233" 0)
(my-color-lerp "#010203" "#112233" 1)
(my-color-lerp "#010203" "#112233" 0.93)

|#


#|
* (eepitch-maxima)
* (eepitch-kill)
* (eepitch-maxima)
load("~/MAXIMA/mycolorlerp1.lisp");
my_color_lerp("#010203", "#112233", 0.93);

fromwhite1(color1, t)  := my_color_lerp("#ffffff", color1, t);
fromwhite (color1, ts) := makelist(fromwhite1(color1, t), t, ts);

fromwhite ("#ff0000", [0.1, 0.5, 1]);  /* light pink, pink, red */

|#




;; Local Variables:
;; coding:  utf-8-unix
;; End: