(in-package #:clim-user)

(defvar *image-path* "/home/stas/image.gif")

(define-presentation-type square ())

(define-application-frame test ()
  ()
  (:panes
   (pane :application
         :incremental-redisplay t
         :display-function 'draw-piece))
  (:layouts
   (default pane)))

(defun draw-piece (frame pane)
  (declare (ignore frame))
  (with-output-as-presentation (pane t 'square)
    (draw-circle* pane 300 300 15 :ink (make-rgb-color 1 0 0))
    (draw-pattern* pane
                   (make-pattern-from-bitmap-file *image-path* :format :gif)
                   0 0)))

(define-test-command (com-drag) ((x 'float) (y 'float))
  (let ((pane (find-pane-named *application-frame* 'pane)))
    (dragging-output (pane :finish-on-release t)
                     (draw-circle* pane x y 10))))

(define-presentation-to-command-translator translator-drag
    (square com-drag test)
  (x y)
  (list x y))

(defun run ()
  (run-frame-top-level (make-application-frame 'test)))