;;; nf-color.el --- additional color-manipulation functions

;; Author: Noah Friedman <friedman@splode.com>
;; Created: 2022-03-21
;; Public domain.

;; $Id: nf-color.el,v 1.2 2022/03/22 02:39:50 friedman Exp $

;;; Commentary:
;;; Code:

(require 'color)

(defun nf-color-rgb-normalize (rgb &optional bits frame)
  "Convert string or integer list \(R G B\) to floating values between 0.0 and 1.0.
If RGB is a string, it may be a color name or an rgb triplet string
\(e.g. \"#ffff1122eecc\"\).

If RGB is an integer list, BITS should be 8 or 16, indicating whether
provided values are in the range 0..255 or 0..65535, respectively."
  (cond ((stringp rgb)
         (color-name-to-rgb rgb frame))

        ((cl-every 'floatp rgb)
         ;; n.b. no range checking; values ought to be in [0.0, 1.0]
         rgb)

        ((null bits)
         (signal 'wrong-number-of-arguments
                 (list "BITS must be provided for integer list" rgb bits)))

        ((not (memq bits '(8 16)))
         (signal 'domain-error (list "BITS should be 8 or 16" bits)))

        ((= bits 8)
         (color-name-to-rgb (apply 'format "#%02x%02x%02x" rgb) frame))

        ((= bits 16)
         (color-name-to-rgb (apply 'format "#%04x%04x%04x" rgb) frame))))


(defun nf-color-rgb-nearest-name (color &optional color-name-alist)
  "Return the color name most closely approximating COLOR.
If COLOR is a known name already, the result should just be that name.
If COLOR is an rgb hex string, the color name with rgb value most closely
approximating that value is returned.

	\(nf-color-rgb-nearest-name \"red\"\)
	=> \"red\"

	;; find color name approx 20% lighter than red
        \(nf-color-rgb-nearest-name \(color-lighten-name \"red\" 20\)\)
	=> \"firebrick1\"

The optional arg COLOR-NAME-ALIST is an alist of color names to RGB values
in the same format as `color-name-rgb-alist', which is the default."
  (let ((color-lab (apply 'color-srgb-to-lab (nf-color-rgb-normalize color)))
        (name nil)
        (min most-positive-fixnum))

    (mapc (lambda (elt)
            (let* ((elt-lab (apply 'color-srgb-to-lab
                                   (nf-color-rgb-normalize (car elt))))
                   (de2k (color-cie-de2000 color-lab elt-lab)))
              (if (< de2k min)
                  (setq min de2k
                        name (car elt)))))
      (or color-name-alist color-name-rgb-alist))
    name))


;; Should this be here?  It's a longstanding bug.
(defadvice color-lighten-hsl (around nf-color:bug-54514:luminance activate)
  "https://debbugs.gnu.org/cgi/bugreport.cgi?bug=54514"
  (setq ad-return-value
        (let ((H (ad-get-arg 0))
              (S (ad-get-arg 1))
              (L (ad-get-arg 2))
              (percent (ad-get-arg 3)))
          (list H S (color-clamp (+ L (* L (/ percent 100.0))))))))


(provide 'nf-color)

;; nf-color.el ends here