[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

An example of following the mouse with CLX

I munged this together to show how to actually see how fast CLX
could follow the mouse.  Note I only call force-output when I need
to, and avoid finish-output.  Also I don't set :override-redirect
on the window, set it if you want.

David Lowry

-------------------------- cut here  ------------------------

;;;This puts up a window and then follows the pointer with a small
;;;rectangle.  Compile and load and call follow-mouse. 
;;; DDL 

;;set this to your host if you're running over a network
(defvar *machine* nil)

(defun  init-window ()
  (declare (special d s root black white xw gc erase-gc))
  (setq d (xlib:open-display (or *machine* (machine-instance))))
  (setq s (xlib:display-default-screen d))
  (setq root (xlib:screen-root s))
  (setq black (xlib:screen-black-pixel s))
  (setq white (xlib:screen-white-pixel s))

  (setq xw (xlib:create-window :parent root :x 10 :y 10 :event-mask 
                              '(:pointer-motion :button-press)
                :width 600 :height 600 :background white :border black
                :border-width 2))
  (setq gc (xlib:create-gcontext :drawable xw  :background white
                :foreground black :fill-style :solid))
  (setq erase-gc (xlib:create-gcontext :drawable xw  :background black
                :foreground white :fill-style :solid))

(defun rect (gc x y solid?)
  (xlib:draw-rectangle xw gc x y 20 20 solid?))

;;simply waits for motion events, erases the old rectangle and draws
;;a new one where the pointer is.  Click a button to exit.
(defun follow-mouse (&optional (solid? nil))
  (declare (special d xw gc erase-gc))
  (unless d (init-window))
  (xlib:map-window xw)
  (let ((old-x 0)
        (old-y 0))
    (xlib:event-case (d :discard-p t :force-output-p t)
                    (motion-notify (x y)
                                   (rect erase-gc old-x old-y solid?)
                                   (rect gc x y solid?)
                                   (setq old-x x old-y y)
                                   (xlib:display-force-output d)
                    (button-press () t)))
  (xlib:unmap-window xw)
  (xlib:display-force-output d))