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

;; --------------------------------------------------------------------------

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

;; --------------------------------------------------------------------------

(-> 'cl-lib)
(-> 'facemenu)

;; --------------------------------------------------------------------------

(defun bad-random (lst)
  (when (lu lst)
    (seq-random-elt lst)))

(defun bad-bg-random ()
  (bad-random (bad-bg-colors)))

(defun bad-fg-random ()
  (bad-random (bad-fg-colors)))

;; --------------------------------------------------------------------------

(defun bad-color-sum (col)
  (pcase-let ((`(,r ,g ,b) (mapcar (L (e) (/ e (** 2 8))) (color-values col))))
    (/ (+ r g b) 3)))
;; (bad-color-sum "azure")
;; (bad-color-sum "gray33")

(let ((fg-cols)
      (too-dark 96)) ; (* 6 (// 1 16) (** 2 8))
  (defun bad-fg-colors ()
    (or fg-cols
        (setq fg-cols (cl-remove-if-not
                       (L (e) (< too-dark (bad-color-sum e)))
                       (defined-colors))))))
(let ((bg-cols)
      (too-dark    80)  ; (*  5 (// 1 16) (** 2 8))
      (too-bright 192)) ; (* 12 (// 1 16) (** 2 8))
  (defun bad-bg-colors ()
    (or bg-cols
        (setq bg-cols (cl-remove-if-not
                       (L (e) (< too-dark (bad-color-sum e) too-bright))
                       (defined-colors))))))

(declare-function bad-fg-colors nil)
(declare-function bad-bg-colors nil)

;; --------------------------------------------------------------------------

(defvar our-black)
(defvar our-red)
(defvar our-green)
(defvar our-yellow)
(defvar our-blue)
(defvar our-magenta)
(defvar our-cyan)
(defvar our-white)

(defvar our-black-b)
(defvar our-red-b)
(defvar our-green-b)
(defvar our-yellow-b)
(defvar our-blue-b)
(defvar our-magenta-b)
(defvar our-cyan-b)
(defvar our-white-b)

(setq our-black     "#000000")
(setq our-red       "#d75f00")
(setq our-green     "#00ff00")
(setq our-yellow    "#d7d700")
(setq our-blue      "#5f87ff")
(setq our-magenta   "#d75fd7")
(setq our-cyan      "#00d7d7")
(setq our-white     "#afafd7")

(setq our-black-b   "#878787")
(setq our-red-b     "#ff8700")
(setq our-green-b   "#5fff5f")
(setq our-yellow-b  "#ffff00")
(setq our-blue-b    "#8787ff")
(setq our-magenta-b "#ff5fff")
(setq our-cyan-b    "#00ffff")
(setq our-white-b   "#d7d7d7")

;; --------------------------------------------------------------------------

;; ANSI steps:
;;  0  1  2  3  4  5
;; 00 5f 87 af d7 ff

(defun bad-color-ansi (&optional str) (i)
  (when-let* ((buf (get-buffer-create "*ansi-cube*")))
    (with-current-buffer buf
      (erase-buffer)
      (cl-loop
       with str = (or str "  ")
       with pts = (number-sequence 0 1 (/ 1.0 5))
       for r in pts do
       (cl-loop
        for g in pts do
        (cl-loop
         for b in pts
         for ansi = (color-rgb-to-hex r g b) do
         (insert (propertize str 'face `(:background ,ansi))))
        (insert " ")
        finally do (delete-char -1) (insert "\n"))))
    (pop-to-buffer buf))) ; (bad-color-ansi)

;; --------------------------------------------------------------------------

(defun icac () (i)
  (when-let* ((buf (get-buffer-create "*ansi-buffer*")))
    (with-current-buffer buf
      (cl-loop
       initially do (erase-buffer)
       with cols   = '(our-black   our-red       our-green   our-yellow
                       our-blue    our-magenta   our-cyan    our-white
                       our-black-b our-red-b     our-green-b our-yellow-b
                       our-blue-b  our-magenta-b our-cyan-b  our-white-b)
       with pad = 13
       with spc = (make-string pad ?\s)
       for c in cols
       for nom = (symbol-name c)
       for col = (symbol-value c) do
       (insert (@f
         "    %s  %s  %s\n"
         (string-pad (propertize nom 'face `(:weight bold :foreground ,col)) pad)
         (propertize col 'face `(:foreground ,col))
         (propertize spc 'face `(:background ,col))))
       finally do (goto-beg))
    (pop-to-buffer buf)))) ; (icac)

;; --------------------------------------------------------------------------

(defun bad-use-x-resources-colors () (i)
  (when (gfx)
    (cl-loop
     with cols = 16
     for i from 0 to cols
     collect (x-get-resource (@f "color%d" i) "*") into x-cols
     finally do
     (when (= cols (--- x-cols))
       (setq our-black     (pop x-cols))
       (setq our-red       (pop x-cols))
       (setq our-green     (pop x-cols))
       (setq our-yellow    (pop x-cols))
       (setq our-blue      (pop x-cols))
       (setq our-magenta   (pop x-cols))
       (setq our-cyan      (pop x-cols))
       (setq our-white     (pop x-cols))
       (setq our-black-b   (pop x-cols))
       (setq our-red-b     (pop x-cols))
       (setq our-green-b   (pop x-cols))
       (setq our-yellow-b  (pop x-cols))
       (setq our-blue-b    (pop x-cols))
       (setq our-magenta-b (pop x-cols))
       (setq our-cyan-b    (pop x-cols))
       (setq our-white-b   (pop x-cols))))))

;; --------------------------------------------------------------------------

(defun bad-draw-fg-color (&optional fg beg stay end) (i)
  (or fg  (setq fg  our-green))
  (or beg (setq beg (point)))
  (or end (setq end (1+ beg)))
  (put-text-property beg end 'face
     (list :foreground fg :background (background-color-at-point)))
  (unless stay
    (forward-char)))

(defun bad-draw-bg-color (&optional bg beg stay end) (i)
  (or bg  (setq bg  our-magenta))
  (or beg (setq beg (point)))
  (or end (setq end (1+ beg)))
  (put-text-property beg end 'face
     (list :foreground (foreground-color-at-point) :background bg))
  (unless stay
    (forward-char)))

(defun bad-put-color-at-point (&optional colors) (i)
  (or colors (setq colors (defined-colors)))
  (let ((c (if (lu colors)
               (seq-random-elt colors)
             colors)))
    (bad-draw-bg-color c (point))))

(defun bad-cursor-pos (&optional w)
  (or w (setq w (1+ (frame-width))))
  (when-let* ((pos (mouse-position))
              (lin (2i pos))
              (col (1i pos)))
    (+ 1 col (* lin w))))

(defun bad-test-area () (i)
  (let ((len (- (frame-width) 4))
        (beg (point)))
    (insert ?\n (make-string len ?█) ?\n)
    (insert     (make-string len ?▓) ?\n)
    (insert     (make-string len ?▒) ?\n)
    (insert     (make-string len ?░) ?\n)
    (insert "(font-lock-mode -1)")
    (comment-region beg (point))))

;; (bad-test-area)
;; ████████████████████████████████████████████████████████████████████████████
;; ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
;; ▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒
;; ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░
;; (font-lock-mode -1)
;; (keymap-local-set "<mouse-1>" #'bad-put-color-at-point)

;; --------------------------------------------------------------------------

(defun get-colors (&optional n)
  "Cut version of facemenu.el code."
  (or n (setq n 16))
  (when (< 0 (display-color-cells))
    (let ((lst (list-colors-duplicates (defined-colors))))
      (when list-colors-sort
        (setq lst
              (mapcar
		         #'car ; NOTE: OK
		         (sort (delq nil (mapcar
                                (L (e)
				                       (when-let* ((key (list-colors-sort-key (1st e))))
					                      (cons e (if (consp key) key (list key)))))
                                lst))
			            (L (a b)
			               (let* ((a-keys (cdr a))
				                   (b-keys (cdr b))
				                   (a-key  (1st a-keys))
				                   (b-key  (1st b-keys)))
			                 (while (& a-key b-key (l= a-key b-key))
			                   (setq a-keys (cdr a-keys))
                            (setq a-key  (1st a-keys))
				                (setq b-keys (cdr b-keys))
                            (setq b-key  (1st b-keys)))
			                 (cond
			                  ((& (n a-key) (n b-key))       (< a-key b-key))
			                  ((& (s a-key) (s b-key)) (string< a-key b-key)))))))))
      (take n lst))))

;; (get-colors)
;; (length (get-colors 8))   ;   8
;; (length (get-colors))     ;  16
;; (length (get-colors 800)) ; 256 (here in -nw Emacs)

;; --------------------------------------------------------------------------

(defun pick-close-color (&optional col n ps)
  (or ps  (setq ps "color: "))
  (or col (setq col (read-color ps)))
  (or n   (setq n 8))
  (when (color-defined-p col)
    (pcase-let* ((list-colors-sort (cons 'rgb-dist col))
                 (`(,r ,g ,b) (color-name-to-rgb (1st (seq-random-elt (get-colors n))))))
      (color-rgb-to-hex r g b 2))))

;; (pick-close-color our-white)
;; (pick-close-color)

;; --------------------------------------------------------------------------

(defun bad-color-get ()
  (list
   (face-attribute 'default :foreground)
   (face-attribute 'default :background)))

(defun bad-color-echo ()
  (pcase-let* ((`(,fg ,bg) (bad-color-get))
               (`(,fg-r ,fg-g ,fg-b) (color-values fg))  ; TODO: trust `color-values'? [1]
               (`(,bg-r ,bg-g ,bg-b) (color-values bg)))
    ($ "%4s[fg %5d %5d %5d %s]%4s[bg %5d %5d %5d %s]"
       " " fg-r fg-g fg-b fg
       " " bg-r bg-g bg-b bg)))

(defun bad-color-cycle (&optional prev fg-mode)
  (pcase-let* ((cols (defined-colors-with-face-attributes))
               (len  (--- cols))
               (`(,fg  ,bg) (bad-color-get))
               (`(,col ,cfun) (if fg-mode
                                  (list fg #'set-foreground-color)
                                (list bg #'set-background-color)))
               (pos (cl-position col cols :test #'s=))
               (step 1)
               (incv (if prev (* -1 step) step)))
    (if pos
        (setq pos (m (++ pos incv) len))
      (setq pos 0))
    (let ((col-nxt (nth pos cols)))
      (funcall cfun col-nxt)))
  (bad-color-echo))

;; --------------------------------------------------------------------------
;;
;; [1] (color-defined-p "#ff02f0")   ; t, so expected (255 2 240) but:
;;     (color-name-to-rgb "#ff02f0") ; (1.0 0.0 1.0)
;;     (color-values      "#ff02f0") ; (65535 0 65535)
;;
;; --------------------------------------------------------------------------

(<- 'bad-color)