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

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

(-> 'll-frame)

(defgroup our-faces nil
  "The `bad' faces."
  :group 'bad
  :group 'faces)

(defface our-black     '((((class color)))) "Our black face."  )
(defface our-red       '((((class color)))) "Our red face."    )
(defface our-green     '((((class color)))) "Our green face."  )
(defface our-yellow    '((((class color)))) "Our yellow face." )
(defface our-blue      '((((class color)))) "Our blue face."   )
(defface our-magenta   '((((class color)))) "Our magenta face.")
(defface our-cyan      '((((class color)))) "Our cyan face."   )
(defface our-white     '((((class color)))) "Our white face."  )

(defface our-black-b   '((((class color)))) "Our black bright face."  )
(defface our-red-b     '((((class color)))) "Our red bright face."    )
(defface our-green-b   '((((class color)))) "Our green bright face."  )
(defface our-yellow-b  '((((class color)))) "Our yellow bright face." )
(defface our-blue-b    '((((class color)))) "Our blue bright face."   )
(defface our-magenta-b '((((class color)))) "Our magenta bright face.")
(defface our-cyan-b    '((((class color)))) "Our cyan bright face."   )
(defface our-white-b   '((((class color)))) "Our white brightf ace."  )

;; _________________
;;  0  1  2  3  4  5
;; 00 5f 87 af d7 ff
;; -----------------

(set-face-foreground 'our-black     "#000000")
(set-face-foreground 'our-red       "#ff5f00")
(set-face-foreground 'our-green     "#008700")
(set-face-foreground 'our-yellow    "#afaf00")
(set-face-foreground 'our-blue      "#005fff")
(set-face-foreground 'our-magenta   "#d75fd7")
(set-face-foreground 'our-cyan      "#00d7d7")
(set-face-foreground 'our-white     "#afafaf")

(set-face-foreground 'our-black-b   "#8787d7")
(set-face-foreground 'our-red-b     "#ff5f5f")
(set-face-foreground 'our-green-b   "#00af00")
(set-face-foreground 'our-yellow-b  "#d7d700")
(set-face-foreground 'our-blue-b    "#87d7ff")
(set-face-foreground 'our-magenta-b "#ff5fff")
(set-face-foreground 'our-cyan-b    "#00ffff")
(set-face-foreground 'our-white-b   "#d7d7d7")

(defun unifont () (i)
  (set-frame-font "-GNU -Unifont-regular-normal-normal-*-*-*-*-*-d-0-iso10646-1"))

;; (unifont)

(defun monospace-fonts ()
  (seq-filter (L (f)
                 (when-let* ((info (font-info f)))
                   (string-match-p "spacing=100" (aref info 1))))
              (font-family-list)))

(let ((fonts (cl-delete-duplicates (monospace-fonts)))
      (i 0))

  (defun next-monospace (&optional n) (i)
    (or n (setf n 1))
    (when-let* ((font (nth (m (++ i n) (--- fonts)) fonts)))
      (set-frame-font font t)
      (fullscreen)
      ($ "font: %s" font)))

  (defun prev-monospace (&optional n) (i)
    (next-monospace (if n (- n) -1)))

  (declare-function next-monospace nil)
  (declare-function prev-monospace nil))

(keymap-global-set "M--" #'prev-monospace)
(keymap-global-set "M-=" #'next-monospace)

;; ---------------------------------------------------------------------------yx
;; the ys are at col 79
;; ---------------------------------------------------------------------------yx

(defun set-all-faces (&optional a) (i)
 (cl-loop
  with old   = (face-attribute 'default :height)
  with font  = (or (face-attribute 'default :family) "OCRABold")
  with w     = 'wide
  with stp   = 4 ; note: smaller DNC
  with h-def = 100
  with hf    = (cond
                ((ni a) (cond                               ; INTEGER:
                         ((< a (- stp))    (- old (abs a))) ; reduce x on -x
                         ((< a 0)          (- old stp))     ; reduce stp
                         ((= a 0)             old)          ; (see below)
                         ((< 0 a (1+ stp)) (+ stp old))     ; increase stp
                         (a)))                              ; set to a
                ((floatp a) (floor a)) ; FLOAT: crashes on e.g. 107.5
                ((functionp a) (funcall a old))) ; FUNCTION: set to a(old)
  ;; SAFE: try to just hold down the key to reduce
  ;; it will start over at the default when below 3
  ;; "if anything can start anew, then everything must continue"
  with h  = (or (& (ni hf) (< stp hf) hf) h-def)
  with fs = (face-list)
  initially (goto-char (pos-bol))
            (setf a (& (lu current-prefix-arg) (1st current-prefix-arg)))
  for f in fs do
  ;; ZERO: set all faces foreground to unspecified
  (when (z a)
    (set-face-attribute f nil :foreground 'unspecified))
  ;; ALWAYS: do this
  (set-face-attribute f nil :font font :height h :width w :underline nil)
  finally (prog1 h (when (functionp 'window-char-resolution)
                     ($ " %s (%d%%)" (window-char-resolution nil t t) h)))))

(keymap-global-set "C-0" #'set-all-faces)
(keymap-global-set "C-)" (L () (set-all-faces  0)))
(keymap-global-set "C--" (L () (set-all-faces -1)))
(keymap-global-set "C-=" (L () (set-all-faces  1)))

;; ----------------------------------------------------------------------------x
;; test area 51                                                       col 80 ->x
;; ----------------------------------------------------------------------------x
;; (set-all-faces)     ; set to the default value, 100
;; (set-all-faces nil) ; ..
;; (set-all-faces t)   ; ..
;; (let ((current-prefix-arg '(120))) (call-interactively #'set-all-faces)) ; set to 120
;; (let ((current-prefix-arg '(110))) (call-interactively #'set-all-faces)) ; ..  .. 110
;; (let ((current-prefix-arg '(-10))) (call-interactively #'set-all-faces)) ; reduce  10
;; (set-all-faces -50)  ; reduce 50
;; (set-all-faces  -5)  ; ..      5
;; (set-all-faces  -3)  ; ..      3
;; (set-all-faces  -2)  ; as -2 is too small, treat it as -3
;; (set-all-faces  -1)  ; ..
;; (set-all-faces   0)  ; still set it to the old value
;; (set-all-faces   1)  ; as +1 is too small, treat it as 3
;; (set-all-faces   2)  ; ..
;; (set-all-faces   3)  ; increase 3
;; (set-all-faces 105)  ; set to 105
;; (set-all-faces 107)  ; ..  .. 107, noticable from 108 to 107, but not from 105
;; (set-all-faces 108)  ; ..  .. 108
;; (set-all-faces #'1-) ; nothing happens as +/- 1 is too small
;; (set-all-faces #'1+) ; ..
;; (set-all-faces (L (e) (cl-incf e  8))) ; increase  8
;; (set-all-faces (L (e) (cl-decf e 16))) ; reduce   16
;; -----------------------------------------------------------------------------

(defun what-face (pos)
 (interactive "d")
 (let ((face (or (get-char-property pos 'face)
                 (get-char-property pos 'read-cf-name))))
  (if face
    (when-let* ((face-str (@f "%s" face)))
      (kill-new face-str)
      ($ face-str))
   ($ "No face!"))))

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

(defun set-face (face fg &optional bold bg)
 (setf bold (if bold 'bold 'normal))
 (setf bg   (if bg    bg   (face-bg 'our-black)))
 (set-face-attribute face nil :foreground fg :background bg :weight bold))

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

(font-lock-add-keywords 'emacs-lisp-mode
 '(
   ("our-black-b"                         . 'font-lock-doc-face)
   ("our-red-b"                           . 'font-lock-type-face)
   ("our-green-b"                         . 'font-lock-keyword-face)
   ("our-yellow-b"                        . 'font-lock-preprocessor-face)
   ("our-blue-b"                          . 'font-lock-comment-face)
   ("our-magenta-b"                       . 'font-lock-constant-face)
   ("our-cyan-b"                          . 'font-lock-function-name-face)
   ("our-white-b"                         . 'font-lock-operator-face)
   ("\\#'[-[:alnum:]]+"                   . 'font-lock-function-name-face)
   ("1-"                                  . 'font-lock-preprocessor-face)
   ("1\\+"                                . 'font-lock-keyword-face)
   ("?[\\]\\{,1\\}."                      . 'font-lock-constant-face)
   ("\\#[[:digit:]]="                     . 'font-lock-preprocessor-face)
   ("\\#[[:digit:]]\\#"                   . 'font-lock-doc-face)
   ("font-lock-builtin-face"              . 'font-lock-builtin-face)
   ("font-lock-comment-delimiter-face"    . 'font-lock-comment-delimiter-face)
   ("font-lock-comment-face"              . 'font-lock-comment-face)
   ("font-lock-constant-face"             . 'font-lock-constant-face)
   ("font-lock-doc-face"                  . 'font-lock-doc-face)
   ("font-lock-function-name-face"        . 'font-lock-function-name-face)
   ("font-lock-keyword-face"              . 'font-lock-keyword-face)
   ("font-lock-negation-char-face"        . 'font-lock-negation-char-face)
   ("font-lcok-operator-face"             . 'font-lock-operator-face)
   ("font-lock-preprocessor-face"         . 'font-lock-preprocessor-face)
   ("font-lock-regexp-grouping-backslash" . 'font-lock-regexp-grouping-backslash)
   ("font-lock-regexp-grouping-construct" . 'font-lock-regexp-grouping-construct)
   ("font-lock-string-face"               . 'font-lock-string-face)
   ("font-lock-type-face"                 . 'font-lock-type-face)
   ("font-lock-variable-name-face"        . 'font-lock-variable-name-face)
   ("font-lock-warning-face"              . 'font-lock-warning-face))
 t)

(set-face 'font-lock-builtin-face              (face-fg 'our-cyan-b)    t)
(set-face 'font-lock-comment-delimiter-face    (face-fg 'our-blue-b)    t)
(set-face 'font-lock-comment-face              (face-fg 'our-blue-b)    t)
(set-face 'font-lock-constant-face             (face-fg 'our-magenta-b) t)
(set-face 'font-lock-doc-face                  (face-fg 'our-black-b)   t)
(set-face 'font-lock-function-name-face        (face-fg 'our-blue-b)    t)
(set-face 'font-lock-keyword-face              (face-fg 'our-cyan)      t)
(set-face 'font-lock-negation-char-face        (face-fg 'our-black-b)   t)
(set-face 'font-lock-operator-face             (face-fg 'our-white-b)   t)
(set-face 'font-lock-preprocessor-face         (face-fg 'our-yellow-b)  t)
(set-face 'font-lock-regexp-grouping-backslash (face-fg 'our-blue-b)    t)
(set-face 'font-lock-regexp-grouping-construct (face-fg 'our-yellow-b)  t)
(set-face 'font-lock-string-face               (face-fg 'our-magenta-b) t)
(set-face 'font-lock-type-face                 (face-fg 'our-red-b)     t)
(set-face 'font-lock-variable-name-face        (face-fg 'our-white-b)   t)

;; -----------------------------------------------------------------------------
;; mode line
;; -----------------------------------------------------------------------------

(set-face-attribute 'mode-line-inactive nil
                    :foreground (face-fg 'our-white-b)
                    :background (face-fg 'our-blue))
(set-face-attribute 'mode-line-active nil
                    :foreground (face-fg 'our-white-b)
                    :background "#5f5f5f")
(setq-default mode-line-format "%8 %l %16 %*%*%* %b %*%*%* %16 %C")

;; -----------------------------------------------------------------------------
;; faces
;; -----------------------------------------------------------------------------

(set-face 'default (face-fg 'our-white-b) t (face-fg 'our-black))
(set-face-attribute 'region nil :background "#875fd7")

(<- 'll-face)