(load "\micro-graphics/load.lisp")
(load "08.lisp")
(load "08_text-shape.lisp")

(defmethod properties ((shape shape))
  '(color thickness filledp))

(defmethod properties ((point point))
  '(x y r phi))

(defmethod properties ((circle circle))
  (append  (call-next-method) (list 'radius)))

(defmethod properties ((polygon polygon))
  (append (call-next-method) (list 'closedp)))

(defmethod properties ((window window))
  '(delegate shape background))

(defclass inspected-window (window)
  ())

(defmethod install-callbacks ((w inspected-window))
  (call-next-method)

  w)

(defmethod install-right-mouse-down-callback ((w inspected-window))
  (mg:set-callback
   (mg-window w)
   :mouse-down (lambda (mgw button x y)
                       (declare (ignore mgw))
                       (ev-right-mouse-down
                        w
                        button
                        (move (make-instance 'point) x y)))))

(defmethod ev-right-mouse-down ((w inspected-window) button position)
  (let ((shape (find-clicked-shape w position)))
    (if shape
        (mouse-down-inside-shape w shape button position)
      (mouse-down-no-shape w button position))))

(defmethod mouse-down-inside-shape ((w inspected-window) shape button position)
  (set-shape w (append (items w) (menu shape button position)))
  w)

(defmethod mouse-down-no-shape ((w inspected-window) button position)
  (set-shape w (append (items w) (menu w button position)))
  w)

(defun show-menu (shape)
  (let* ((a (make-instance 'window))
        (sloty (properties shape))
        (y 20)
        (x 20)
        (slots (list
                (move
                 (set-text
                  (make-instance 'text-shape)
                  (format nil "CLASS  ->  ~a" (type-of shape)))
                 x y))))
    (setf y (+ y 20))
    (dolist (slot sloty)
      (progn
        (setf slots (cons
                    (move
                     (set-text
                      (make-instance 'text-shape)
                      (format nil "~a  ->  ~a" slot (apply 'funcall
                                                      `(,slot ,shape))))
                     x y)
                    slots))
        (setf y (+ y 20))))
    (set-shape a slots)
    a))