;;; -*- lexical-binding: t -*-

(defun slab-to-rgb (l a b)
  (apply 'color-rgb-to-hex
         (mapcar 'color-clamp
                 (color-lab-to-srgb (* l 100)
                                    (- (* a 200) 100)
                                    (- (* b 200) 100)))))

(defun scale (min max n &optional back)
  (let ((scaled (* n (- max min))))
    (if back (- max scaled) (+ min scaled))))

(defun scale* (min max &optional back)
  (lambda (n)
    (list (scale (car min) (car max) (car n) back)
          (scale (cadr min) (cadr max) (cadr n))
          (scale (caddr min) (caddr max) (caddr n)))))

(defun light-on-dark-p ()
  (< (car l-bg-min) (car l-fg-min)))

(defun lab (l a b &optional inv)  
  (apply 'slab-to-rgb
         (funcall (if inv
                      (scale* l-bg-min l-bg-max (light-on-dark-p))
                    (scale* l-fg-min l-fg-max (not (light-on-dark-p))))
                  `(,l ,a ,b))))

(defun labc (x &optional y b &rest r)
  (defun labfg (x y z &optional b)
    `(:foreground ,(lab x y z b)))
  (defun labbg (x y z &optional b)
    `(:background ,(lab x y z (not b))))
  (list (list '((class color) (min-colors 89))
              (append 
               (if x (apply 'labfg (append x (list b))) nil)
               (if y (apply 'labbg (append y (list b))) nil)
               r))))

;; light-on-dark
(setq l-bg-min '(.05 .48 .48)
      l-bg-max '( .1 .52 .52)
      l-fg-min '(.65   0   0)
      l-fg-max '(.95   1   1))

;; dark-on-light
(setq l-bg-min '( .9 .48 .48)
      l-bg-max '(.95 .52 .52)
      l-fg-min '(.05   0   0)
      l-fg-max '(.35   1   1))


(deftheme test
  "test theme")

(let ((class '((class color) (min-colors 89))))
  (custom-theme-set-faces
   'test
   ;; text appearance
   `(default                      ,(labc '( .7  .5  .5) '( .5  .5  .5)))
   ;; text parts, temporary
   `(region                       ,(labc '(  1  .5  .5) '(  0  .5 .55) t))
   ;; parts of the Emacs frame
   `(isearch                      ,(labc '(  1  .5  .5) '(  1  .5   1) t))
   `(query-replace                ,(labc '(  1  .5  .5) '(  1  .6   1) t))
   `(lazy-highlight               ,(labc '(  1  .5  .5) '(  0  .5   1) t))
   `(mode-line                    ,(labc '( .5  .5 .55) '( .8  .5  .5)))
   `(mode-line-inactive           ,(labc '(  0  .5 .51) '(  0  .5  .5)))
   `(fringe                       ,(labc '( .2  .5 .55) '( .5  .5  .5)))
   `(vertical-border              ,(labc '(  0  .5  .5) nil            t))
   `(minibuffer-prompt            ,(labc '( .2  .5 .35)))
   `(cursor                       ,(labc nil            '(  0  .6  .6) t))
   ;; font lock faces
   `(font-lock-comment-face       ,(labc '(  0  .5  .4)))
   `(font-lock-string-face        ,(labc '( .3  .6  .6)))
   `(font-lock-doc-face           ,(labc '( .5  .4 .65)))
   `(font-lock-keyword-face       ,(labc '( .2  .5  .6)))
   `(font-lock-function-name-face ,(labc '( .6 .45 .65)))
   `(font-lock-constant-face      ,(labc '( .5  .4  .5)))
   `(font-lock-variable-name-face ,(labc '( .7  .4  .6)))
   `(font-lock-builtin-face       ,(labc '(  0  .5  .5)))
   ;; faces.el
   `(link                         ,(labc '(  1  .5  .1) nil            nil :underline t))
   `(link-visited                 ,(labc '(  1   1   0) nil            nil :underline t))
   `(highlight                    ,(labc '( .5  .5  .5) '( .5  .5  .3) t   :underline t))
   ))