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

(require 'eieio)

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

(defclass box (borderless)
  ((name :initform (format "box-%d" (random 100)))
   (img :initarg :img :type (or null integer) :initform nil)
   (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-take-img ((_ box))
  (ignore))

(cl-defmethod bad-box-inverted-border ((b box))
  (with-slots (w-min h-min s1 s2 s3 s4 c1 c2 c3 c4) b
    (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))
      (?┏  (bad-border b #1=?\s))
      (?\s (bad-box-inverted-border 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)