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

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

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

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

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

(cl-defmethod bad-resize-sub ((e elem))
  (~ (sub w h) e
     (dolist (sub-e sub)
       (~ (resize-wh (sub-w w) (sub-h h) w-max h-max) sub-e
          (setf w-max w)
          (setf h-max h)
          (when resize-wh
            (let ((rx (1i resize-wh))
                  (ry (2i resize-wh)))
              (bad-size sub-e (or (& rx (+ w rx)) sub-w)
                              (or (& ry (+ h ry)) sub-h))))))))

(cl-defmethod bad-size ((e elem) (new-w integer) &optional new-h verbose)
  (or new-h (setq new-h new-w))
  (~ (movable sub w-min w w-max h-min h h-max) e
     (when (& movable
              (or (! w-min) (<= 0 w-min new-w))
              (or (! h-min) (<= 0 h-min new-h)))
       (let ((r1 (bad-rect e))
              r2
             (dx (- new-w w))
             (dy (- new-h h)))
         (setf w new-w)
         (setf h new-h)
         (setq r2 (bad-rect e))
         (push (bad-rect-reduce r1 r2) bad-buddy-boxes)
         (when verbose
           (bad-size-report e))
         (bad-align-sub e dx dy)
         (bad-resize-sub e)))))

(defun bad-pixels-to-chars (pxls &optional h)
  (cl-assert (& (integerp pxls) (<= 0 pxls)))
  (+ 2 (/ pxls (if h (frame-char-height) (frame-char-width)))))

(cl-defmethod bad-size-from-pixels ((e elem) (pix-w integer) (pix-h integer))
  (bad-size e
   (bad-pixels-to-chars pix-w)
   (bad-pixels-to-chars pix-h t)))

(cl-defmethod bad-size-report ((e elem))
  (~ (w h) e
     (let* ((col (@f "%dx%d" w h))
            (pxl-w (* w (frame-char-width)))
            (pxl-h (* h (frame-char-height)))
            (pxl (@f "(%dx%d pxl)" pxl-w pxl-h))
            (msg (@f "%s %s"
                     (if (= w h)
                         (propertize col 'face
                                     `(:weight bold
                                               :foreground ,our-white
                                               :background ,our-blue-b))
                       col)
                     (if (= pxl-w pxl-h)
                         (propertize pxl 'face
                                     `(:weight bold
                                               :foreground ,our-black
                                               :background ,our-white))
                       pxl))))
       ($ msg))))

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

(cl-defmethod bad-size-min ((e elem))
  (~ (min-x min-y w-min h-min) e
     (bad-pos e min-x min-y)
     (bad-size e w-min h-min)))

(cl-defmethod bad-size-half ((e elem))
  (~ (min-x min-y w h w-max h-max) e
     (bad-pos e min-x min-y)
     (let ((new-w (/ (or w-max w) 2))
           (new-h (/ (or h-max h) 2)))
       (bad-size e new-w new-h))))

(cl-defmethod bad-size-max ((e elem))
  (~ (min-x min-y w h w-max h-max) e
     (bad-pos e min-x min-y)
     (let ((new-w (or w-max (* w 2)))
           (new-h (or h-max (* h 2))))
       (bad-size e new-w new-h))))

(cl-defmethod bad-size-square ((e elem) &optional style)
  (~ (w h) e
     (let ((side (cl-case style
                   ((w   quote) w)
                   ((h   quote) h)
                   ((max quote) (max w h))
                   (t           (min w h)))))
       (when side
         (bad-size e side side)))))

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

(cl-defmethod bad-size-add ((e elem) &optional x y)
  (or x (setq x 1))
  (or y (setq y x))
  (~ (w h) e
     (bad-size e (+ x w) (+ y h))))

(cl-defmethod bad-add-col ((e elem) &optional n)
  (or n (setq n 1))
  (bad-size-add e n 0))

(cl-defmethod bad-add-row ((e elem) &optional n)
  (or n (setq n 1))
  (bad-size-add e 0 n))

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

(<- 'bad-size)