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

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

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

(-> 'bad-color)
(-> 'bad-elem)
(-> 'bad-size)

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

(defclass ascii (elem)
  ((name :initform "ascii")
   (char-col :initarg :char-col :type list :initform nil)
   (str-data :initarg :str-data :type list :initform nil)))

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

(cl-defmethod bad-update     ((_ ascii) &rest _) (ignore))
(cl-defmethod bad-write-subs ((_ ascii))         (ignore))

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

(cl-defmethod bad-ascii-to-drawable ((a ascii))
  (~ (data char-col str-data w) a
    (when (& data char-col)
      (cl-loop
       with str-lst = (seq--into-string data)
       with res-str = str-lst
       for (cr cl) in char-col do
       (cl-loop
        with len = (--- cr)
        with pos = 0
        with on  = t
        while on do
        (let* ((res (string-search cr str-lst pos)))
          (if (! res)
              (setq on nil)
            (set-text-properties res (+ res len) `(face (:foreground ,cl)) res-str)
            (setq pos (1+ res)))))
       finally do (setq str-data (seq-split res-str w))))))

(cl-defmethod bad-draw-ascii ((a ascii))
  (~ (str-data) a
    (unless str-data
      (bad-ascii-to-drawable a))
    (cl-loop
     initially do (erase-buffer)
     for l in str-data do
     (insert l "\n")
     finally do (goto-beg))))

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

(cl-defmethod bad-read-data ((a ascii) (strs list))
  (~ (w-max h-max w h data len) a
    (setf data (string-to-list (string-join strs)))
    (setf len  (--- data))
    (let* ((fst (--- (1st strs)))
           (all (--- strs)))
      (setf w (if w-max (min w-max fst) fst))
      (setf h (if h-max (min h-max all) all)))))

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

(cl-defmethod bad-read-file ((a ascii) &optional f dir)
  (~ (name) a
     (or dir (setq dir "data"))
     (setf f (file-name-concat dir (or f (concat name ".txt")))))
  (with-temp-buffer
    (insert-file-contents f)
    (let* ((lines (split-string
                   (buffer-substring-no-properties (point-min) (point-max))
                   "\n"))
           (len (apply #'max (mapcar #'length lines))))
      (bad-read-data a (mapcar (L (e) (string-pad e len)) lines)))))

(cl-defmethod bad-read-string ((a ascii) (str string))
  (let* ((lines  (split-string str "}\\|\n"))
         (chrs   (apply #'max (mapcar #'length lines)))
         (padded (mapcar (L (e) (string-pad e chrs)) lines)))
    (bad-read-data a padded)))

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

(defun bad-draw-uxu ()
  (i)
  (with-current-buffer (get-buffer-create "*bad-ascii*")
    (let* ((uxu (ascii)))
      (bad-read-file uxu "ascii/uxu")
      (~ (char-col) uxu
        (setf char-col (list `("#" ,our-black-b)
                             `("underground experts united" ,our-cyan)
                             )))
      (bad-draw-ascii uxu)
      (pop-to-buffer (current-buffer))))) ; (bad-draw-uxu)

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

(<- 'bad-ascii)