Kimbrough@dsg.csc.ti.COM (Kerry Kimbrough) (07/23/88)
Here's a slightly different version, using a technique that usually provides
the crispest pointer tracking -- use :pointer-motion-hint to get only a single
"hint" :motion-notify event, then query-pointer to get an up-to-the-msec fix on
the pointer position. See protocol spec, Sec. 12, describing MotionNotify events.
It really depends on how time-consuming it is to generate the tracking feedback.
In this case, the feedback is simple, so there's not much difference between
rband3 and rband2; rband3 seemed a *little* snappier to me, but I didn't do any
detailed measurement.
Note the added unwind-protect. Without it, if you're silly enough to abort out
of the event loop, you're hosed! You've grabbed the pointer and your display
object has been garbage-collected! Xperts: what's the best way to recover from
this situation? Restart the server?
(defun rband3 (&key (host-name "layla"))
(let* ((display (open-display host-name))
(screen (first (display-roots display)))
(root (screen-root screen))
(gc (create-gcontext :drawable root
:function boole-xor
:foreground (screen-black-pixel screen)
:subwindow-mode :include-inferiors
))
(lx 0) (ly 0) (lw 0) (lh 0))
(unwind-protect
(case (grab-pointer root #.(make-event-mask :pointer-motion-hint
:pointer-motion
:button-press
:button-release
)
:sync-keyboard-p t)
(:success
(macrolet ((move-outline (x y w h)
`(unless (and (= ,x lx) (= ,y ly) (= ,w lw) (= ,h lh))
(draw-rectangle root gc lx ly lw lh)
(draw-rectangle root gc ,x ,y ,w ,h)
(setq lx ,x ly ,y lw ,w lh ,h))))
(event-case (display :force-output-p t :discard-p t)
(:button-press ()
(draw-rectangle root gc lx ly lw lh)
(display-force-output display)
t)
(:motion-notify ()
(MULTIPLE-VALUE-BIND (x y) (query-pointer root)
(move-outline x y 200 200))
nil))))
(otherwise
(format t "Not grabbed!")))
(close-display display))))