;;; 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=)
(cl-pushnew ".." load-path :test #'string=)
(require 'luki-lisp)

(-> 'bad-ascii)
(-> 'bad-color)
(-> 'bad)

(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-name = 13
   initially (@i 10)
   for f in faces
   for c in cols
   for i from 0
   for nms      = (string-pad (propertize (symbol-name f) 'face `(:weight bold :foreground ,c)) pad-name)
   for rgb      = (mapcar (L (e) (1- (// e 256))) (color-values c)) for (r   g   b)   = rgb
   for rgbs     = (mapcar (L (d) (@f "%\ 3.0f" d)) rgb)             for (rs  gs  bs)  = rgbs
   for rgbf     = (mapcar (L (e) (// (- e 1) 255)) rgb )            for (rf  gf  bf)  = rgbf
   for rgbfs    = (mapcar (L (d) (@f "%3.2f"   d)) rgbf)            for (rfs gfs bfs) = rgbfs
   for bad-sum  = (bad-color-sum c)
   for sum      = (@f " %3d%% " (r (* 100.0 bad-sum )))
   for red      = (@f " %3d%% " (r (* 100.0 rf      )))
   for grn      = (@f " %3d%% " (r (* 100.0 gf      )))
   for blu      = (@f " %3d%% " (r (* 100.0 bf      )))
   for fg       = (propertize (@f " %s " c  ) 'face `(:foreground ,c :box ,(if (evenp i) '(-8 -96) '(-96  -8))))
   for norm-red = (bad-color-norm `(     ,rf         ,(// gf 4.5) ,(// bf 2.5) ))
   for norm-grn = (bad-color-norm `( ,(// rf 5.5) ,(- 1.0 gf)     ,(// bf 6.5) ))
   for norm-blu = (bad-color-norm `( ,(// rf 3.5) ,(//    gf 4.5)     ,bf      ))
   for sum-clr  = (bad-color-norm (list bad-sum bad-sum bad-sum))
   for bar-sum  = (propertize sum 'face `(:foreground "grey24" :background ,c ))
   for bar-red  = (propertize red 'face `(:foreground ,sum-clr :background ,norm-red ))
   for bar-grn  = (propertize grn 'face `(:foreground ,sum-clr :background ,norm-grn ))
   for bar-blu  = (propertize blu 'face `(:foreground ,sum-clr :background ,norm-blu ))
   for str      = (@f "%s  %s  %s %s%s%s  %s %s \n" nms fg
                      bar-sum
                      bar-red bar-grn bar-blu
                      (propertize (@f " %s %s %s " rs  gs  bs  ) 'face '(:foreground "gray69" :background "gray35" ))
                      (propertize (@f " %s %s %s " rfs gfs bfs ) 'face '(:foreground "gray53" :background "gray27" )))
   do (@i str))) ; (progn (eval-buffer) (bad-demo-icac))

(defun bad-demo-uxu ()
  (new-buf "*bad-draw*")
  (let ((uxu (ascii)))
    (bad-read-file uxu (file-name-concat "data" "ascii" "uxu.txt"))
    (~ (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-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 ,(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