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

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

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

(-> 'bad-elem)
(-> 'bad-pos)

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

(cl-defmethod bad-mov ((e elem) (dx integer) (dy integer))
  (~ (x y) e
     (bad-pos e (+ dx x) (+ dy y))))

(cl-defmethod bad-mov-x ((e elem) &optional d)
  (or d (setq d 1))
  (bad-mov e d 0))

(cl-defmethod bad-mov-y ((e elem) &optional d)
  (or d (setq d 1))
  (bad-mov e 0 d))

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

(cl-defmethod bad-left ((e elem) &optional d)
  (or d (setq d 1))
  (bad-mov-x e (- d)))

(cl-defmethod bad-right ((e elem) &optional d)
  (or d (setq d 1))
  (bad-mov-x e d))

(cl-defmethod bad-up ((e elem) &optional d)
  (or d (setq d 1))
  (bad-mov-y e (- d)))

(cl-defmethod bad-down ((e elem) &optional d)
  (or d (setq d 1))
  (bad-mov-y e d))

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

(cl-defmethod bad-origo ((e elem))
  (~ (min-x min-y) e
     (bad-pos e min-x min-y)))

(cl-defmethod bad-center ((e elem))
  (~ (w-max w min-y) e
     (let ((wm (or w-max 78)))
       (bad-pos e (- (/ wm 2) (/ w 2)) min-y))))

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

(cl-defmethod bad-pos-inside ((inner elem) (outer elem))
  (~ ((ow w) (oh h)) outer
     (~ (ix iy min-x min-y (bx x) (by y) (bw w) (bh h)) inner
        (let* ((max-scale 2)
               (x-mas (- ow bw))
               (y-mas (- oh bh))
               (new-x (+ (* ix (/ x-mas max-scale))
                         (if (z ix)
                             min-x
                           (if (= ix max-scale)
                               (- (% bw max-scale) 1)
                             0))))
               (new-y (+ (* iy (/ y-mas max-scale))
                         (if (z iy)
                             min-y
                           (if (= iy max-scale)
                               (- (% bh max-scale) (if (cl-oddp bh) 2 0))
                             0)))))
          (bad-pos inner new-x new-y)
          (setf ix (m (++ ix) (1+ max-scale)))
          (when (z ix)
            (setf iy (m (++ iy) (1+ max-scale))))))))

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

(<- 'bad-move)