CLIM mail archive


rubber-band lines ?

Howdy Mr. Hensel,

The following short program does this with a straight line.  While
it isn't quite what you asked for, I hope it helps.


John S. Kern
Lucid, Inc
(in-package :clim-user)

(define-application-frame test
    ((main  :application
	    :incremental-redisplay nil
	    :default-size :rest
	    :display-function 'display-main)
     (test-menu  :command-menu)))
     :inherit-from (user-command-table)
     (("EXIT"      :command cmd-exit)
      ("rubber" :command cmd-rubberband)

(defmethod display-main ((frame test) stream)

(defun ctest (root)
  (let (frame)
    (setq *frame* (make-application-frame 'test
					:parent root
					:left 0

					:top 0
					:right 500
					:bottom 500))
    (run-frame-top-level *frame*)

(defun cmd-exit ()
  (frame-exit *application-frame*)

(defun cmd-rubberband ()
  (let ((x1 0)  ;; x1, y1 represents the fix point 
	(y1 0)
	(x2 0)  ;; x2,y2 represents the point that is changing
	(y2 0)
	(mouse-button-press nil)  ;;  set to T when mouse button has
				 ;;  press to select pivot
	(stream (get-frame-pane *application-frame* 'main)))
    (tracking-pointer (stream)
		      (:pointer-button-press (event x y )
					     (setf x1 x
						   y1 y
						   x2 x
						   y2 y)
					     (draw-line* stream
						   x1 y1 x2 y2
						   :ink +flipping-ink+)
					     (setf mouse-button-press t))
		      (:pointer-motion (window x y)
				       (when Mouse-button-press
					 (draw-line* stream x1 y1
						     x2 y2 :ink +flipping-ink+)
					 ;; draw
					 (draw-line* stream x1 y1 x y
						     :ink +flipping-ink+)
					 (setf x2 x y2 y)))
		      (:pointer-button-release (event x y )
					       (cond ((eq
							mouse-button-press t)
						      (return (list x1
								    x2 y2))))))

Main Index | Thread Index