3.4 Obtaining mouse information
You can access the character that is associated with a mouse event by using the function mouse-event-char. This function takes a mouse event as an argument and returns a mouse event character that describes the mouse action of the event. These mouse event characters can be associated with a mouse event:
#\mouse-moved #\mouse-right-down #\mouse-right-up #\mouse-middle-down #\mouse-middle-up #\mouse-left-down #\mouse-left-up #\mouse-right #\mouse-middle #\mouse-leftIf you click the mouse more than once, the appropriate characters are produced for up to eight clicks, such as
#\mouse-right-twice and#\mouse-left-eight-times. More than eight down-up transition pairs in quick succession causes a#\mouse-xxx-eight-times mouse event to be generated and a new click event to be started.These characters have the following interpretations:
#\mouse-moved
#\mouse-left-down,#\mouse-middle-down,#\mouse-right-down
#\mouse-left-up,#\mouse-middle-up,#\mouse-right-up
#\mouse-right,#\mouse-middle,#\mouse-left
#\mouse-middle,#\mouse-middle-down, and#\mouse-middle-up cannot occur. Whenever a mouse motion or button action occurs, a mouse event is generated. If the mouse input stream that is the value of the function mouse-input is queuing mouse events when such a mouse event is generated, the event is added to the stream's queue. In this way, a sequential record of all mouse events can be kept and read at will.
The following examples queue mouse events in mouse input streams. The first example shows a function that allows you to use the mouse to draw on the screen.
;;; Draw on the window by clicking the middle button, and erase
;;; by clicking the left button. Type "a" to exit.
(defun draw (window)
(let ((default-keyboard-input (keyboard-input))
(default-mouse-input (mouse-input))
event)
(unwind-protect
(progn
;; Enable mouse input queuing.
(setf (mouse-input-stream-queue-mouse-events-p window)
t)
;; Bind mouse-input and keyboard-input to the window.
(setf (mouse-input) window)
(setf (keyboard-input) window)
(loop with all-done = nil
until all-done
with drawing-p = nil and erasing-p = nil
;; Read an event from the window mouse input
;; stream.
do (setq event (read-any window))
if (mouse-event-p event)
do (case (mouse-event-char event)
(#\mouse-middle-down (setq drawing-p t))
(#\mouse-middle-up (setq drawing-p nil))
(#\mouse-left-down (setq erasing-p t))
(#\mouse-left-up (setq erasing-p nil)))
;; Check for exit characters.
else do (when (equal event \#\\a)
(setq all-done t))
if (or erasing-p drawing-p)
;; Draw a small square.
do (bitblt
window 0 0 window
(- (mouse-event-x event)
(region-origin-x
(window-inside-region window)))
(- (mouse-event-y event)
(region-origin-y
(window-inside-region window)))
4 4
(if drawing-p boole-set boole-clr))))
(setf (keyboard-input) default-keyboard-input))))
;; Invoke the function.
(draw *window*)
Notice that the example uses the Common Lisp special formunwind-protect to ensure that mouse input is rebound to the default mouse input stream. This precaution is especially important for keyboard input events because you will not be able to type to Lisp if you change the default keyboard input stream.Mouse event queueing and mouse polling can be combined to do rubberbanding. Rubberbanding is the effect that occurs when an edge of a shape follows the mouse, often in the context of resizing the shape, so that the shape appears to be stretching or contracting as the mouse moves.
The following more lengthy example demonstrates how to use rubberbanding to draw a variable-sized rectangle with the mouse.
;;; This support function draws a rectangle on the window by using
;;; the boolean operation boole-c2
(defun draw-rect (window x1 y1 x2 y2)
(draw-line
window (make-position x1 y1) (make-position x1 y2)
:operation boole-c2)
(draw-line
window (make-position x1 y2) (make-position x2 y2)
:operation boole-c2)
(draw-line
window (make-position x2 y2) (make-position x2 y1)
:operation boole-c2)
(draw-line
window (make-position x2 y1) (make-position x1 y1)
:operation boole-c2))
;;; Allow the user to draw a rectangle with the mouse left and
;;; right buttons; use rubberbanding so that the user can see the
;;; possible size of the rectangle as the mouse moves.
(defun draw-rubberband-rectangle (window)
(with-mouse-documentation
("Left: set lower-left corner, Middle: set upper-right corner")
(let ((default-mouse-input (mouse-input))
(left-border (region-origin-x
(window-inside-region window)))
(top-border (region-origin-y
(window-inside-region window)))
event first-x first-y)
(unwind-protect
(progn
;; Clear any previous events.
(loop until (not (read-any-no-hang window)))
;; Enable mouse input queuing.
(setf (mouse-input-stream-queue-mouse-events-p
window) t)
;; Bind mouse input and keyboard input to the window.
(setf (mouse-input) window)
(loop
until (and (mouse-event-p event)
(eq (mouse-event-char event)
#\mouse-middle-down))
for event = (read-any window)
;; Left click--set rectangle's lower-left corner.
do
(when (and (mouse-event-p event)
(eq (mouse-event-char event)
#\mouse-left-down))
(setq first-x (mouse-x)) ; Save the left edge.
(setq first-y (mouse-y)) ; Save the bottom edge.)
;; Rubberbanding--draw the current rectangle.
;; If these values are known.
if (and first-x first-y) w
do
;; Draw and erase the rectangle.
(let ((mx (mouse-x)) (my (mouse-y)))
(dotimes (i 2)
(draw-rect window
(- first-x left-border)
(- first-y top-border)
(- mx left-border)
(- my top-border)))))
(setf (mouse-input-stream-queue-mouse-events-p
window) nil)
;; Right click--draw rectangle.
(draw-rect window
(- first-x left-border)
(- first-y top-border)
(- (mouse-x) left-border)
(- (mouse-y) top-border)))
(setf (mouse-input) default-mouse-input)))))
;; Invoke the function.
(draw-rubberband-rectangle *window*)
Generated with Harlequin WebMaker