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

(require 'eieio)

(require 'bad-borderless)
(require 'bad-move)
(require 'bad-write)

(defclass box (borderless)
  ((name :initform (format "box-%d" (random 100)))
   (img :initarg :img               :initform nil)
   (iix :initarg :iix :type integer :initform 0)
   (iiy :initarg :iiy :type integer :initform 0)
   (c1  :initarg :c1  :type integer :initform ?┏)
   (c2  :initarg :c2  :type integer :initform ?┓)
   (c3  :initarg :c3  :type integer :initform ?┛)
   (c4  :initarg :c4  :type integer :initform ?┗)
   (s1  :initarg :s1  :type list    :initform #2='(?━))
   (s2  :initarg :s2  :type list    :initform #3='(?┃))
   (s3  :initarg :s3  :type list    :initform #2#)
   (s4  :initarg :s4  :type list    :initform #3#)))

(cl-defmethod bad-load-img ((b box) &optional div)
  (or div (setq div 2))
  (unless (oref b img)
    (let* ((img-path (seq-random-elt (directory-files "~/test/imgs/" t ".png")))
           (img-l (create-image img-path nil nil :ascent 'center)))
      (with-slots (img) b
        (let ((img-w (car #1=(image-size img-l t)))
              (img-h (cdr #1#)))
          (setf img (create-image img-path nil nil
                                  :width  (/ img-w div)
                                  :height (/ img-h div)
                                  :ascent 'center)))))))

(cl-defmethod bad-draw-img ((b box) &optional boost-x boost-y)
  (or boost-x (setq boost-x 0))
  (or boost-y (setq boost-y 0))
  (with-slots (img w h iix iiy x y) b
    (when img
      (let* ((cw (frame-char-width))
             (ch (frame-char-height))
             (rx (+ 1 boost-x x))
             (ry (+ 1 boost-y y))
             (img-w (car #1=(image-size img t)))
             (img-h (cdr #1#))
             (img-cols     (/ img-w cw))
             (img-rows (1- (/ img-h ch)))
             (reduce 3)
             (box-cols (- w reduce))
             (box-rows (- h reduce))
             (cols (min img-cols (+ iix box-cols)))
             (rows (min img-rows (+ iiy box-rows))))
        (when (< #1=box-cols iix)
          (setf iix #1#))
        (when (< #1=(- img-rows box-rows) iiy)
          (setf iiy #1#))
        ;; (message "%s %s" iix iiy)
        (goto-char (point-min))
        (goto-char (pos-bol ry))
        (cl-loop
         for r from iiy upto rows do
         (goto-char (+ rx (pos-bol 2)))
         (cl-loop
          for c from iix upto cols do
          (delete-char 1)
          (insert
                 (propertize " " 'display
                             (list (list 'slice (* c cw) (* r ch) cw ch) img))))))
      (goto-char (point-min)))))

(cl-defmethod bad-box-inverted-border ((b box) &optional just-border)
  (with-slots (w-min h-min s1 s2 s3 s4 c1 c2 c3 c4) b
    (unless just-border
      (setf w-min #1=1)
      (setf h-min #1#))
    (setf s1 '(?▁))
    (setf s2 '(?▏))
    (setf s3 '(?▔))
    (setf s4 '(?▕))
    (setf c1 #2=bad-nonsolid)
    (setf c2 #2#)
    (setf c3 #2#)
    (setf c4 #2#)))

(cl-defmethod bad-cycle-border ((b box))
  (with-slots (c1 s1) b
    (cl-case c1
      (?\+ (bad-make-light b))
      (?\┌ (bad-make-heavy b))
      (?\┏ (progn
             (bad-border b #1=?\s)
             (message "opaque"))) ; TODO: these are overwritten instantly
      (#1# (progn
             (bad-border b bad-nonsolid)
             (message "(bad's) transparent")))
      (?\{ (if (equal s1 (list bad-nonsolid))
               (bad-box-inverted-border b)
             (bad-make-ascii b)))
      (t   (bad-make-ascii b)))))

(cl-defmethod bad-make-ascii ((b box))
  (with-slots (c1 c2 c3 c4 s1 s2 s3 s4) b
    (setf c1    #0=?+) (setf s1 #1='(?-)) (setf c2 #0#)
    (setf s4 #2='(?|))                    (setf s2 #2#)
    (setf c4      #0#) (setf s3 #1#)      (setf c3 #0#))
  (bad-update b))

(cl-defmethod bad-make-heavy-ascii ((b box))
  (bad-make-heavy b)
  (with-slots (s1 s3) b
    (setf s1 #1='(?-)))
  (bad-update b))

(cl-defmethod bad-make-light ((b box))
  (with-slots (c1 c2 c3 c4 s1 s2 s3 s4) b
    (setf c1      ?┌)  (setf s1 #1='(?─)) (setf c2 ?┐)
    (setf s4 #2='(?│))                    (setf s2 #2#)
    (setf c4      ?└)  (setf s3 #1#)      (setf c3 ?┘))
  (bad-update b))

(cl-defmethod bad-make-heavy ((b box))
  (with-slots (c1 c2 c3 c4 s1 s2 s3 s4) b
         (setf c1 ?┏)  (setf s1 #1='(?━)) (setf c2 ?┓)
    (setf s4 #2='(?┃))                    (setf s2 #2#)
         (setf c4 ?┗)  (setf s3 #1#)      (setf c3 ?┛))
  (bad-update b))

(cl-defmethod bad-make-bra ((b box) &optional new)
  (with-slots (c1 c2 c3 c4 s1 s2 s3 s4 spc) b
    (setf c1   ?⡏)  (setf s1  '(?⠉))  (setf c2   ?⢹)
    (setf s4 '(?⡇))                   (setf s2 '(?⢸))
    (setf c4   ?⣇)  (setf s3  '(?⣀))  (setf c3   ?⣸)
    (when new
      (setf spc '(?⠁ ?⠂ ?⠄ ?⠈ ?⠐ ?⠠))))
  (bad-update b))

(defun scramble (seq)
  (seq-sort (lambda (_ __) (zerop (random 2))) seq))

(cl-defmethod bad-make-bra-full ((b box) &optional new)
  (with-slots (c1 c2 c3 c4 s1 s2 s3 s4 spc) b
    (setf c1 ?⡿)             (setf s1 #1=(scramble '(?⡿ ?⣟ ?⣯ ?⣾))) (setf c2 ?⣟)
    (setf s4 (scramble #1#))                                        (setf s2 (scramble #1#))
    (setf c4 ?⣾)             (setf s3 (scramble #1#))               (setf c3 ?⣯)
    (when new
      (setf spc (scramble #1#))))
  (bad-update b))

(cl-defmethod bad-clear ((b box) &optional fill)
  (or fill (setq fill '(?\s)))
  (with-slots (spc) b
    (setf spc fill))
  (bad-update b)
  (message "cleared to: %s" fill))

(cl-defmethod bad-resize-sub :after ((b box))
  (with-slots (sub w h pushy) b
    (dolist (s sub)
      (with-slots (w-min h-min (sw w) (sh h) w-max h-max
                   min-x min-y x y           max-x max-y)
          s
        (setf w-max (max w-min #1=(- w 2)))
        (setf h-max (max h-min #2=(- h 2)))
        (setf max-x (max min-x #1#))
        (setf max-y (max min-y #2#))
        (when pushy
          (when (< w-max sw)
            (setf sw (max w-min w-max)))
          (when (< h-max sh)
            (setf sh (max h-min h-max)))
          (when (< w-max (- (+ x sw) min-x))
            (bad-mov-x s -1))
          (when (< h-max (- (+ y sh) min-y))
            (bad-mov-y s -1)))))))

(cl-defmethod bad-border ((b box) c)
  (with-slots (c1 c2 c3 c4 s1 s2 s3 s4) b
    (setf c1 c)
    (setf c2 c)
    (setf c3 c)
    (setf c4 c)
    (setf s1 `(,c))
    (setf s2 `(,c))
    (setf s3 `(,c))
    (setf s4 `(,c))))

(cl-defmethod bad-side ((b box) n s)
  (when (and (stringp s)
             (not (zerop (length s))))
    (with-slots (s1 s2 s3 s4) b
      (let ((lst (string-to-list s)))
        (cl-case n
          (1 (setf s1 lst))
          (2 (setf s2 lst))
          (3 (setf s3 lst))
          (4 (setf s4 lst))
          (_ (message "DNC")))))))

(cl-defmethod bad-corner ((b box) n c)
  (with-slots (c1 c2 c3 c4) b
    (cl-case n
      (1 (setf c1 c))
      (2 (setf c2 c))
      (3 (setf c3 c))
      (4 (setf c4 c))
      (_ (message "DNC")))))

(cl-defmethod bad-add ((b box) (e elem))
  (with-slots (color w h sub pushy) b
    (setf pushy t)
    (with-slots (fg color (iw w) (ih h) w-max h-max x y min-x min-y) e
      (setf fg    (seq-random-elt #1=(defined-colors)))
      (setf color (seq-random-elt #1#))
      (setf iw #1=(- h 2))
      (setf ih #1#)
      (setf w-max (- w 2))
      (setf h-max #1#)
      (setf x #3=1)
      (setf y #4=1)
      (setf min-x #3#)
      (setf min-y #4#))
    (bad-update e)
    (push e sub)
    e))

(provide 'bad-box)