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

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

;; Here are a bunch of standalone demos.
;;
;; 0.  (eval-buffer)
;; 1.  (bad-color-ansi)
;; 2.1 (bad-icac)
;; 2.2 (progn (bad-icac) (bad-import-x-colors) (bad-icac)) <-- boring
;; 3.  (bad-draw-uxu)
;; 4.1 (bad-fonts)
;; 4.2 (bad-fonts 'monospace)

(-> 'bad-ascii)

;; +-----------------------------------------+
;; | the ANSI 6x6x6 color cubes              |
;; |                                         |
;; | ANSI steps:    0   1   2   3   4   5    |
;; | ----------   x00 x5f x87 xaf xd7 xff    |
;; |              (0  95 135 175 215 255)_10 |
;; +-----------------------------------------+

(cl-defmethod bad-color-ansi ()
  (with-current-buffer (get-buffer-create "*bad-draw*")
    (cl-loop
     initially (erase-buffer)
     with str = "  "
     with pts = (number-sequence 0 1 (/ 1.0 5))
     with len = (--- pts)
     with (cbe sqr lne pnt) = (list (** len 3) (** len 2) (** len 1) (** len 0))
     for i from 0 to (1- cbe)
     for (ri gi bi) = `(,(m (/ i sqr) len) ,(m (/ i lne) len) ,(m (/ i pnt) len))
     for (r g b) = `(,(nth ri pts) ,(nth gi pts) ,(nth bi pts))
     for pcol = `(:background ,(color-rgb-to-hex r g b))
     for ccol = (propertize str 'face pcol) do
     (cond ((z (m i cbe)) (ignore))
           ((z (m i sqr)) (@i ?\n))
           ((z (m i lne)) (@i ?\s)))
     (@i ccol)
     finally (@i ?\n)
     (pop-to-buffer (current-buffer)))))

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

(cl-defmethod bad-icac ()
  (with-current-buffer (get-buffer-create "*bad-draw*")
    (cl-loop
     initially (goto-end)
	  with faces = (list
	                '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 8 ?\s)
     for c in faces
	  for nom   = (symbol-name c)
	  for col   = (face-fg c)
     for nomp  = (propertize nom 'face `(:weight bold :foreground ,col))
     for nompp = (string-pad nomp pad)
     for fgp   = (propertize col 'face `(:foreground ,col))
     for bgp   = (propertize spc 'face `(:background ,col))
     for str   = (@f "%s %s %s\n" nompp fgp bgp)
	  do (@i str)
     finally (pop-to-buffer (current-buffer)))))

(cl-defmethod bad-import-x-colors ()
  (cl-loop
   with faces = (list
	              '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)
   for f in faces
   for i from 0 to (length faces)
   for res = (x-get-resource (@f "color%d" i) "*")
   do (set-face-attribute f nil :foreground res)))

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

(defun bad-draw-uxu ()
  (with-current-buffer (get-buffer-create "*bad-draw*")
    (@i ?\n)
    (let ((uxu (ascii)))
      (bad-read-file uxu (file-name-concat "data" "ascii" "uxu"))
      (~ (char-col) uxu
         (setf char-col '(("#"                          "#8787af")
                          ("underground experts united" "#00d7d7")
                          ("x"                          "#af000")))
         (bad-draw uxu)))
    (@i ?\n)
    (pop-to-buffer (current-buffer))))

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

(cl-defmethod bad-fonts (&optional monospace)
  (with-current-buffer (get-buffer-create "*bad-draw*")
    (cl-loop
     initially (goto-end)
     with fnts  =  (if monospace (seq-filter
                                  (L (f) (when-let* ((info (font-info f))) (string-match-p "spacing=100" (aref info 1))))
                                  (font-family-list))
                     (font-family-list))
     with colrs = '(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 clen  =  (--- colrs)
     with beg   = (point)
     for f in fnts
     for i    = (or (& (ni i) (m (++ i) clen)) 0)
     for str  = (propertize f 'face (list :family f :foreground (face-foreground (nth i colrs))))
     for info = (font-info f)
     for fe   = (& info (open-font (find-font (font-spec :name (aref info 0)))))
     when (& fe (font-has-char-p fe ?a)) collect str into fs
     finally (cl-loop
              with uni = (cl-remove-duplicates fs :test #'string-equal) ; NOTE: OK
              with srt = (cl-sort uni (L (a b) (s< a b)))
              for f in srt do
                (@i f)
                (goto-char (pos-bol))
                (@i (@f "%s " (window-text-pixel-size nil (point) (1+ (point)))))
                (goto-char (pos-eol))
                (@i ?\n))
     finally (goto-char beg) (pop-to-buffer (current-buffer)))))

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

(<- 'bad-demos)