;;; Draggable demo that does not rely on utilities

(require 'quickdraw)
(import 'ccl::while)

;(defmacro while (c &body b) `(do () ((not ,c)) ,@b))

(defclass myclass (view) ())

(defclass draggable () ())

(defmethod view-click-event-handler ((d draggable) loc)
  (if (double-click-p)
    (inspect d)
    (while (mouse-down-p)
      (let ( (p (view-mouse-position d)) )
        (when (not (= p loc))
          (set-view-position d (+ (view-position d) (- p loc)))
          (event-dispatch)
          (window-update-event-handler (view-container d)))))))

(defclass highlighted () ())

(defun frame-view (v)
  (let ( (p (view-position v)) )
    (set-pen-mode v :patxor)
    (set-pen-size v #@(2 2))
    (frame-rect (view-container v)
                (add-points p #@(-1 -1))
                (add-points p (add-points (view-size v) #@(1 1))))
    (set-pen-mode v :patcopy)))

(defmethod view-mouse-enter-event-handler ((h highlighted))
  (frame-view h)
  (call-next-method))

(defmethod view-mouse-leave-event-handler ((h highlighted))
  (frame-view h)
  (call-next-method))

(defmethod view-click-event-handler ((h highlighted) loc)
  (declare (ignore loc))
  (frame-view h)
  (call-next-method)
  (frame-view h))

(setf w (make-instance 'window :view-size #@(550 350)
                       :window-title "Demo"))

(dotimes (i 5)
  (let ( (txt (make-instance 'static-text-dialog-item
                :dialog-item-text "Lisp Rules!"
                :view-size #@(120 25)
                :view-font '("Times" 24)))
         (v (make-instance 'myclass :view-size #@(120 25)
                           :view-position
                           (make-point (random 400)
                                       (random 300)))) )
    (add-subviews w v)
    (add-subviews v txt)))

; (defclass myclass (draggable view) ())
; (defclass myclass (highlighted draggable view) ())