;;; bad-demo.el --- bad demos -*- lexical-binding: t -*-
;;
;;; Commentary:
;;
;; +------------------------------------+
;; | the ANSI 6x6x6 color cubes:        |
;; | 0   1   2   3   4   5    (step)    |
;; | x00 x5f x87 xaf xd7 xff  (hex)     |
;; | 0   95  135 175 215 255  (decimal) |
;; +------------------------------------+
;;
;; 01. (progn (eval-buffer) (bad-demo-ansi-cubes))
;; 02. (progn (eval-buffer) (bad-demo-icac))
;; 03. (progn (eval-buffer) (bad-demo-uxu))
;; 04. (progn (eval-buffer) (bad-demo-fonts t))
;;
;;; Code:

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

(-> 'bad-ascii)
(-> 'bad-elem)

(defun bad-demo-ansi-cube (&optional kr kg kb keep)
  (or (floatp kr) (setf kr 1.0))
  (or (floatp kg) (setf kg 1.0))
  (or (floatp kb) (setf kb 1.0))
  (cl-loop
   initially (unless keep (new-buf "*bad-draw*"))
   with beg  = 0
   with end  = 5
   with stps = (- end beg)
   with pntw = (round (// (bad-frame-char-height) (bad-frame-char-width)))
   with str  = (make-string pntw 32)
   with nbeg = 0.0
   with nend = 1.0
   with nlen = (- nend nbeg)
   with pts  = (number-sequence beg end (// nlen stps))
   with (pnt side square cube) = (mapcar (L (e) (** stps e)) '(0 1 2 3))
   for i from (1- pnt) below cube
   for (rr gg bb) = (mapcar (L (e) (nth (m (/ i e) side) pts)) `(,square ,side ,pnt))
   for (ra ga ba) = (mapcar (L (e) (max nbeg (min nend e))) `(,(* kr rr) ,(* kg gg) ,(* kb bb)))
   for pcol = `(:background ,(color-rgb-to-hex ra ga ba))
   for ccol = (or (propertize str 'face pcol) str)
   for spc  = (& (z (m i side   )) (char-to-string 32))
   for new  = (& (z (m i square )) (char-to-string 10))
   for fstr = (concat spc new ccol)
   do (@i fstr)
   finally (@i 10)))

(defun bad-demo-ansi-cubes (&optional num rse)
  (or (n num) (setf num 16))
  (or (n rse) (setf rse  4))
  (cl-loop
   initially (new-buf "*bad-draw*")
   with inc  = (+ 1 (* 0.01 (** 2 rse)))
   for i from 0.0 below 1.0 by (/ 1.0 num)
   for red   = (* i (** inc 1.2))
   for green = (* i (** inc 1.0))
   for blue  = (* i (** inc 1.4))
   do (bad-demo-ansi-cube red green blue t)))

(defun bad-demo-icac ()
  (cl-loop
   initially (new-buf "*bad-draw*")
	with faces = '( bad-black   bad-red   bad-green   bad-yellow   bad-blue   bad-magenta   bad-cyan   bad-white
		             bad-black-b bad-red-b bad-green-b bad-yellow-b bad-blue-b bad-magenta-b bad-cyan-b bad-white-b)
   with cols  = (mapcar (L (c) (symbol-value c)) faces)
   with pad = 16
	with spc = (make-string (/ 16 2) 32)
   for f in faces
   for c in cols
   for nms = (string-pad (propertize (symbol-name f) 'face (list :weight 'bold :foreground c)) pad)
   for fg  = (propertize c   'face (list :weight 'bold :foreground c))
   for bg  = (propertize spc 'face (list :weight 'bold :background c))
   for str = (concat nms fg " " bg "\n")
	do (@i str)))

(defun bad-demo-uxu ()
  (new-buf "*bad-draw*")
  (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))))

(defun bad-demo-fonts (&optional monospace)
  (cl-loop
   initially (new-buf "*bad-draw*")
   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 = (list bad-red bad-green bad-yellow bad-blue bad-magenta bad-cyan bad-white bad-black-b bad-red-b bad-green-b bad-yellow-b bad-blue-b bad-magenta-b bad-cyan-b bad-white-b)
   for f in fnts
   for i    = (or (& (ni i) (m (++ i) (--- colrs))) 0)
   for str  = (propertize f 'face `(: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)
    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 10))))

(<- 'bad-demo)
;;; bad-demo.el ends here