;; color
  (keymap-set bad-demo-mode-map "5" (lambda () (interactive) (bad-color-more-approximate s 'red)))
  (keymap-set bad-demo-mode-map "%" (lambda () (interactive) (bad-color-more-approximate s 'red t)))
  (keymap-set bad-demo-mode-map "6" (lambda () (interactive) (bad-color-more-approximate s 'green)))
  (keymap-set bad-demo-mode-map "^" (lambda () (interactive) (bad-color-more-approximate s 'green t)))
  (keymap-set bad-demo-mode-map "7" (lambda () (interactive) (bad-color-more-approximate s 'blue)))
  (keymap-set bad-demo-mode-map "&" (lambda () (interactive) (bad-color-more-approximate s 'blue t)))

(defun bad-color-same-proportion-test ()
  (cl-loop repeat (expt 2 8)
   with max = (expt 2 16)
   with res
   with len
   with zeroes
   with ones
   with good
   for r = (random max)
   for g = (random max)
   for b = (random max) do
   (push (length (bad-color-same-proportion (list r g b))) res)
   finally return (progn
                    (setq len (length res))
                    (setq zeroes (cl-count 0 res))
                    (setq ones   (cl-count 1 res))
                    (setq good (- len zeroes ones))
                    (list len
                          zeroes
                          ones
                          (/ good (* 1.0 len))))))

;; (bad-color-same-proportion-test)

(defun bad-color-sum (col1 col2)
  (if (and col1 (not col2))
      col1
    (if (and col2 (not col1))
        col2
      (when (and col1 col2)
        (pcase-let ((`(,r1 ,g1 ,b1) (color-values col1))
                    (`(,r2 ,g2 ,b2) (color-values col2)))
          (bad-color-same-proportion (list (+ r1 r2)
                                           (+ g1 g2)
                                           (+ b1 b2))))))))

;; (bad-color-sum "blue" "red")

(defun bad-color-same-proportion (col)
  (let* ((vals   (if (stringp col) (color-values col) col))
         (simple (bad-color-simplify vals))
         (all    (bad-color-simplify-all))
         (same   (cl-remove-if-not (lambda (e) (equal (car e) simple)) all)))
    (mapcar #'cadr same)))

;; (bad-color-same-proportion '(10 10 10))
;; (member "white" (bad-color-same-proportion "white"))
;; (length (bad-color-same-proportion "coral1"))
;; (length (bad-color-same-proportion (seq-random-elt (defined-colors))))

(defun bad-color-simplify (col)
  (let ((vals (if (stringp col) (color-values col) col)))
    (mapcar
     (lambda (c) (ash c -14))
     vals)))

;; (bad-color-simplify "white")
;; (bad-color-simplify (seq-random-elt (defined-colors)))

(defun bad-color-simplify-all ()
  (let* ((cols (defined-colors))
         (simple-no-label (mapcar #'bad-color-simplify cols))
         (simple))
    (cl-loop
     for s in simple-no-label
     for c in cols do
     (push (list s c) simple)
     finally return (nreverse simple))))

;; (bad-color-simplify-all)

;; TODO: almost
(cl-defmethod bad-color-more-approximate ((s studio) col &optional less)
  (with-slots (fg-mode) s
    (pcase-let* ((`(,fg ,bg) (bad-color-get))
                 (`(,col-cur ,cfun) (if fg-mode
                                        (list fg #'set-foreground-color)
                                      (list bg #'set-background-color)))
                 (`(,r ,g ,b) (color-values col-cur))
                 (max-val (expt 2 16))
                 (inc-val (if less (- #1=(expt 2 10)) #1#)))
      (cl-case col
        ((red   quote) (cl-incf r inc-val))
        ((green quote) (cl-incf g inc-val))
        ((blue  quote) (cl-incf b inc-val)))
      (setq r (min max-val (max 0 r)))
      (setq g (min max-val (max 0 g)))
      (setq b (min max-val (max 0 b)))
      (let* ((new-cols (bad-color-same-proportion (list r g b)))
             (new-col (when new-cols (seq-random-elt new-cols))))
        (if new-col
            (progn
              (funcall cfun new-col)
              (bad-color-echo))
          (message "approximation failed"))))))

(cl-defmethod bad-color-toggle-fg-mode ((s studio))
  (with-slots (fg-mode) s
      (setf fg-mode (not fg-mode))
      (message (if fg-mode "fg" "bg"))))

(cl-defmethod bad-rgb-list ((s studio))
  (with-slots (col-r col-g col-b) s
    (cl-loop
     for c in (defined-colors-with-face-attributes)
     with rgb-list
     for rgb = (color-values c)
     for r   = (nth 0 rgb)
     for g   = (nth 1 rgb)
     for b   = (nth 2 rgb) do
     (cl-pushnew (list r g b c) rgb-list :test #'equal)
     finally do
       (setf col-r (sort rgb-list :key #'car))
       (setf col-g (sort rgb-list :key #'cadr))
       (setf col-b (sort rgb-list :key #'caddr)))))

(cl-defmethod bad-color-more ((s studio) col &optional less)
  (with-slots (col-r col-g col-b fg-mode) s
    (unless (and col-r col-g col-b)
      (bad-rgb-list s))
    (pcase-let* ((`(,fg ,bg) (bad-color-get))
                 (`(,col-cur ,cfun) (if fg-mode
                                        (list fg #'set-foreground-color)
                                      (list bg #'set-background-color)))
                 (`(,lst ,extr) (cl-case col
                                  ((red   quote) (list col-r #'car))
                                  ((green quote) (list col-g #'cadr))
                                  ((blue  quote) (list col-b #'caddr))))
                 (cmp (if less #'< #'>))
                 (cmp-col (funcall extr (color-values col-cur)))
                 (col-new (cl-find-if (lambda (c)
                                        (funcall
                                         cmp
                                         (funcall extr c)
                                         cmp-col))
                                      (if less (reverse lst) lst))))
      (when col-new
        (funcall cfun (nth 3 col-new)))
      (bad-color-echo))))