CLIM mail archive
[Prev][Next][Index][Thread]

Re: :MULTIPLE-WINDOW option on mouse tracking operators From: Lawrence.G.Mayka@att.com Date: Wed, 4 May 94 09:35:45 CDT

   In the attached sample program, though, only CLIM:TRACKING-POINTER
   seems to actually operate successfully across pane boundaries.  Am I
   misunderstanding or misapplying this feature, or has it basically been
   dropped from CLIM?

Sorry, I forgot the program.  It's below.


        Lawrence G. Mayka
        AT&T Bell Laboratories
        lgm@ieain.att.com

Standard disclaimer.

---
(in-package :cl-user)

(defpackage multiwin (:use))

(clim:define-application-frame multiwin ()
  ((panes :initform (make-array 2)))
  (:panes
   (pane-0 :application
	   :label "Pane 0")
   (pane-1 :application
	   :label "Pane 1")
   (interactor :interactor)
   (mouse-doc :pointer-documentation))
  (:layouts
   (default
    (clim:vertically ()
      (clim:horizontally ()
        pane-0
        pane-1)
      interactor
      mouse-doc))))

(defmethod pane->number ((self multiwin) pane)
  (with-slots (panes) self
    (position pane panes)))

(defmethod number->pane ((self multiwin) number)
  (with-slots (panes) self
    (aref panes number)))

(defmethod (setf number->pane) (pane (self multiwin) number)
  (with-slots (panes) self
    (setf (aref panes number) pane)))

(defmethod clim:run-frame-top-level :before ((self multiwin) &key)
  (setf (number->pane self 0) (clim:get-frame-pane self 'pane-0)
	(number->pane self 1) (clim:get-frame-pane self 'pane-1)))

(define-multiwin-command (multiwin::quit :menu t :name t)
    ()
   (clim:frame-exit clim:*application-frame*))

(defclass point-in-pane ()
  ((point :initarg point :reader point)
   (pane :initarg pane :reader pane)))

(define-multiwin-command (multiwin::make-point :menu t :name t)
    ((pane '(integer 0 (2)))
     (x 'real)
     (y 'real))
   (let* ((point (clim:make-point x y))
          (stream (number->pane clim:*application-frame* pane))
          (point-in-pane (make-instance 'point-in-pane 'point point 'pane stream)))
     (clim:with-output-as-presentation (stream point-in-pane 'point-in-pane)
       (clim:draw-point stream point
                        :ink clim:+red+
                        :line-thickness 3))))

(clim:define-gesture-name multiwin::make-point :pointer-button (:left))

(clim:define-presentation-to-command-translator multiwin::make-point
    (clim:blank-area multiwin::make-point multiwin
                     :gesture multiwin::make-point)
    (window x y)
    (let ((pane-number (pane->number clim:*application-frame* window)))
      `(,pane-number ,x ,y)))

(clim:define-gesture-name multiwin::drag-circle :pointer-button (:left :control))

(define-multiwin-command (multiwin::drag-circle :menu t :name t)
    ((start 'point-in-pane :gesture multiwin::drag-circle))
   (let ((pane (pane start))
         (point (point start)))
     (clim:dragging-output (pane :multiple-window t
				 :finish-on-release nil)
       (clim:draw-circle pane point 20
			 :ink clim:+green+
                         :filled nil
			 :line-thickness 5))))

(clim:define-gesture-name multiwin::make-line :pointer-button (:left :meta))

(define-multiwin-command (multiwin::make-line :menu t :name t)
    ((start 'point-in-pane :gesture multiwin::make-line))
   (let ((pane (pane start))
         (point (point start)))
     (multiple-value-bind (x y) (clim:point-position point)
       (multiple-value-bind (start-x start-y end-x end-y)
           (clim:pointer-place-rubber-band-line* :stream pane
                                                 :start-x x
                                                 :start-y y
                                                 :multiple-window t
                                                 #-allegro :finish-on-release
                                                 #-allegro  nil)
         (clim:draw-line* pane start-x start-y end-x end-y
                          :ink clim:+blue+
                          :line-thickness 3)))))

(clim:define-gesture-name multiwin::make-rectangle
                          :pointer-button (:left :control :meta))

(define-multiwin-command (multiwin::make-rectangle :menu t :name t)
    ((start 'point-in-pane :gesture multiwin::make-rectangle))
   (let ((pane (pane start))
         (point (point start)))
     (multiple-value-bind (x y) (clim:point-position point)
       (multiple-value-bind (left top right bottom)
           (clim:pointer-input-rectangle* :stream pane
					  :left x
                                          :top y
					  :multiple-window t
                                          #-allegro :finish-on-release
                                          #-allegro  nil)
         (clim:draw-rectangle* pane left top right bottom
                               :ink clim:+cyan+
                               :filled nil
                               :line-thickness 3)))))

(clim:define-gesture-name multiwin::drag-record
                          :pointer-button (:left :shift :meta))

(define-multiwin-command (multiwin::drag-record :menu t :name t)
    ((start 'point-in-pane :gesture multiwin::drag-record))
   (let ((pane (pane start))
         (point (point start)))
     (multiple-value-bind (x y) (clim:point-position point)
       (let ((record (clim:with-new-output-record (pane)
                       (clim:draw-ellipse* pane x y 20 0 0 10
                                           :ink clim:+yellow+
                                           :filled nil
                                           :line-thickness 4))))
         (clim:drag-output-record pane record
                                  :multiple-window t
                                  :finish-on-release nil)))))

(clim:define-gesture-name multiwin::track-mouse
                          :pointer-button (:left :shift :control :meta))

(define-multiwin-command (multiwin::track-mouse :menu t :name t)
    ((start 'point-in-pane :gesture multiwin::track-mouse))
   (let ((pane (pane start)))
     (block track
       (clim:tracking-pointer (pane :multiple-window t)
         (:pointer-button-press (event x y)
          (let ((new-pane (clim:event-sheet event)))
            (clim:draw-point* new-pane x y
                              :line-thickness 7
                              :ink clim:+magenta+)
            (return-from track)))))))
References:
Main Index | Thread Index