;;; ll-vector-color --- luki icac -*- lexical-binding: t -*-
;;
;;; Commentary:
;;    This file will be deleted, use juv-el instead.
;;
;;; Code:

(require 'cl-lib)
(cl-pushnew "." load-path :test #'string=)

(require 'color)
(require 'll)
(require 'll-type)

(defun ll-color* (col &optional i)
  (&  (n  i) (! (ni i)) (setf i (floor i)))
  (or (ni i) (setf i 100))
  (ll-vector-color-hex* col (* i 0.01)))

(defun decimal-color-values (col)
  (mapcar (L (c) (* 1.0 (// c (1- (** 2 16))))) (color-values col)))

(cl-defstruct ll-vector-color
  (red   0.0 :type float)
  (green 0.0 :type float)
  (blue  0.0 :type float))

(cl-defmethod ll-vector-color-vector ((c ll-vector-color))
  (vector
   (ll-vector-color-red   c)
   (ll-vector-color-green c)
   (ll-vector-color-blue  c)))

(cl-defmethod ll-vector-color-normalize ((c ll-vector-color))
  (setf (ll-vector-color-red   c) (color-clamp (ll-vector-color-red   c)))
  (setf (ll-vector-color-green c) (color-clamp (ll-vector-color-green c)))
  (setf (ll-vector-color-blue  c) (color-clamp (ll-vector-color-blue  c))))

(cl-defmethod ll-vector-color* ((c ll-vector-color) (k number) &optional as-hex no-set)
  (or (floatp k) (setf k (* 1.0 k)))
  (when-let* ((red   (ll-vector-color-red   c))
              (grn   (ll-vector-color-green c))
              (blu   (ll-vector-color-blue  c))
              (red-k (* k red))
              (grn-k (* k grn))
              (blu-k (* k blu)))
    (unless no-set
      (setf (ll-vector-color-red   c) red-k)
      (setf (ll-vector-color-green c) grn-k)
      (setf (ll-vector-color-blue  c) blu-k)
      (ll-vector-color-normalize c))
    (if as-hex
        (let* ((delta 0.04)
               (MIN   (+ 0.0 (* 2 delta)))
               (MAX   (- 1.0 (* 3 delta))))
          (color-rgb-to-hex
           (max MIN (min MAX red-k))
           (max MIN (min MAX grn-k))
           (max MIN (min MAX blu-k))
           2))
      c)))

(defun ll-vector-color-hex* (&optional h k)
  (or (su h) (setf h "black"))
  (if (& (n k) (!nf k)) (setf k (* 1.0 k)))
  (or (nf k) (setf k 1.0))
  (pcase-let* ((`(,red ,grn ,blu) (decimal-color-values h))
               (col (make-ll-vector-color :red red :green grn :blue blu)))
    (ll-vector-color* col k t t)))

(cl-defmethod ll-vector-color-light ((c ll-vector-color) as-string)
  (when-let* ((red (ll-vector-color-red   c))
              (grn (ll-vector-color-green c))
              (blu (ll-vector-color-blue  c))
              (avg (// (+ red grn blu) 3)))
    (if as-string (@f "%d" (* 1e2 avg))
      avg)))

(cl-defmethod ll-vector-color-power ((c ll-vector-color))
  (when-let* ((red (ll-vector-color-red   c))
              (grn (ll-vector-color-green c))
              (blu (ll-vector-color-blue  c))
              (no3 (min red grn blu)))
    (@f "%3d %3d %3d"
        (if (z no3) red (min 999 (* 1e2 (// red no3))))
        (if (z no3) grn (min 999 (* 1e2 (// grn no3))))
        (if (z no3) blu (min 999 (* 1e2 (// blu no3)))))))

(cl-defmethod ll-vector-color-red-perc ((c ll-vector-color))
  (when-let* ((red (ll-vector-color-red c)))
    (@f "%s" (r (* 1e2 red)))))

(cl-defmethod ll-vector-color-green-perc ((c ll-vector-color))
  (when-let* ((grn (ll-vector-color-green c)))
    (@f "%s" (r (* 1e2 grn)))))

(cl-defmethod ll-vector-color-blue-perc ((c ll-vector-color))
  (when-let* ((blu (ll-vector-color-blue c)))
    (@f "%s" (r (* 1e2 blu)))))

(cl-defmethod ll-vector-color-name ((c ll-vector-color))
  (when-let* ((hex (ll-vector-color-hex c)))
    (@f "lvc-%s" (substring hex 1))))

(cl-defmethod ll-vector-color-hex ((c ll-vector-color))
  (when-let* ((red (ll-vector-color-red   c))
              (grn (ll-vector-color-green c))
              (blu (ll-vector-color-red   c)))
    (color-rgb-to-hex red grn blu 2)))

(cl-defmethod ll-vector-color-hex-red ((c ll-vector-color))
  (when-let* ((red (ll-vector-color-red c)))
    (color-rgb-to-hex red 0 0 2)))

(cl-defmethod ll-vector-color-hex-green ((c ll-vector-color))
  (when-let* ((grn (ll-vector-color-green c)))
    (color-rgb-to-hex 0 grn 0 2)))

(cl-defmethod ll-vector-color-hex-blue ((c ll-vector-color))
  (when-let* ((blu (ll-vector-color-blue c)))
    (color-rgb-to-hex 0 0 blu 2)))

(cl-defmethod ll-vector-color-part ((c ll-vector-color))
  (cl-loop
   with vec = (ll-vector-color-vector c)
   for a across-ref vec
   concat (@f "%s " (cond ((z a) "0.00") ((< (- 1.0 a) 0.01) "1.00") ((@f "%.2f" a)))) into res
   finally return (substring res 0 -1)))

(defun ll-colors-from-faces ()
  (cl-loop
   with faces      = (face-list)
   with faces-fg   = (cl-remove-if-not #'face-foreground faces)
   with faces-bg   = (cl-remove-if-not #'face-background faces)
   with colors-fg  = (mapcar #'face-foreground faces-fg)
   with colors-bg  = (mapcar #'face-background faces-bg)
   with colors     = (seq-union colors-fg colors-bg)
   with colors-str = (cl-remove-if-not #'stringp colors)
   for c-str in colors-str
   for (red grn blu) = (decimal-color-values c-str)
   for col           = (make-ll-vector-color :red red :green grn :blue blu)
   collect (ll-vector-color-normalize col)))

;; (setq llvctc (make-ll-vector-color :red 0.1 :green 0.5 :blue 1.0))

;; (ll-vector-color-vector    llvctc     )
;; (ll-vector-color-normalize llvctc     )
;; (ll-vector-color*          llvctc 0.2 )
;; (ll-vector-color*          llvctc 2   )
;; (ll-vector-color*          llvctc 1.8 )
;; (ll-vector-color-light     llvctc     )
;; (ll-vector-color-light-str llvctc     )
;; (ll-vector-color-name      llvctc     )
;; (ll-vector-color-part      llvctc     )
;; (ll-vector-color-hex       llvctc     )
;; (ll-colors-from-faces                 )

(provide 'll-vector-color)
;;; ll-vector-color.el ends here