Previous: Without Object Sets Example, Up: A SERVE-EVENT Example [Contents][Index]
This example involves more work, but you get a little more for your effort. It
defines two objects, input-box
and slider
, and establishes a
:key-press
handler for each object, key-pressed
and
slider-pressed
. We have two object sets because we handle events on the
windows manifesting these objects differently, but the events come over the
same display connection.
(in-package "SERVER-EXAMPLE") (defstruct (input-box (:print-function print-input-box) (:constructor make-input-box (display window))) "Our program knows about input-boxes, and it doesn't care how they are implemented." display ; The CLX display on which my input-box is displayed. window) ; The CLX window in which the user types. ;;; (defun print-input-box (object stream n) (declare (ignore n)) (format stream "#<Input-Box ~S>" (input-box-display object))) (defvar *input-box-windows* (system:make-object-set "Input Box Windows" #'ext:default-clx-event-handler)) (defun key-pressed (input-box event-key event-window root child same-screen-p x y root-x root-y modifiers time key-code send-event-p) "This is our :key-press event handler." (declare (ignore event-key root child same-screen-p x y root-x root-y time send-event-p)) (format t "KEY-PRESSED (Window = ~D) = ~S.~%" (xlib:window-id event-window) ;; See Hemlock Command Implementor's Manual for convenient ;; input mapping function. (ext:translate-character (input-box-display input-box) key-code modifiers))) ;;; (ext:serve-key-press *input-box-windows* #'key-pressed)
(defstruct (slider (:print-function print-slider) (:include input-box) (:constructor %make-slider (display window window-width max))) "Our program knows about sliders too, and these provide input values zero to max." bits-per-value ; bits per discrete value up to max. max) ; End value for slider. ;;; (defun print-slider (object stream n) (declare (ignore n)) (format stream "#<Slider ~S 0..~D>" (input-box-display object) (1- (slider-max object)))) ;;; (defun make-slider (display window max) (%make-slider display window (truncate (xlib:drawable-width window) max) max)) (defvar *slider-windows* (system:make-object-set "Slider Windows" #'ext:default-clx-event-handler)) (defun slider-pressed (slider event-key event-window root child same-screen-p x y root-x root-y modifiers time key-code send-event-p) "This is our :key-press event handler for sliders. Probably this is a mouse thing, but for simplicity here we take a character typed." (declare (ignore event-key root child same-screen-p x y root-x root-y time send-event-p)) (format t "KEY-PRESSED (Window = ~D) = ~S --> ~D.~%" (xlib:window-id event-window) ;; See Hemlock Command Implementor's Manual for convenient ;; input mapping function. (ext:translate-character (input-box-display slider) key-code modifiers) (truncate x (slider-bits-per-value slider)))) ;;; (ext:serve-key-press *slider-windows* #'slider-pressed)
(defun server-example () "An example of using the SYSTEM:SERVE-EVENT function and object sets to handle CLX events." (let* ((display (ext:open-clx-display)) (screen (display-default-screen display)) (black (screen-black-pixel screen)) (white (screen-white-pixel screen)) (iwindow (create-window :parent (screen-root screen) :x 0 :y 0 :width 200 :height 200 :background white :border black :border-width 2 :event-mask (xlib:make-event-mask :key-press))) (swindow (create-window :parent (screen-root screen) :x 0 :y 300 :width 200 :height 50 :background white :border black :border-width 2 :event-mask (xlib:make-event-mask :key-press))) (input-box (make-input-box display iwindow)) (slider (make-slider display swindow 15))) ;; Wrap code in UNWIND-PROTECT, so we clean up after ourselves. (unwind-protect (progn ;; Enable event handling on the display. (ext:enable-clx-event-handling display #'ext:object-set-event-handler) ;; Add the windows to the appropriate object sets. (system:add-xwindow-object iwindow input-box *input-box-windows*) (system:add-xwindow-object swindow slider *slider-windows*) ;; Map the windows to the screen. (map-window iwindow) (map-window swindow) ;; Make sure we send all our requests. (display-force-output display) ;; Call server for 100,000 events or immediate timeouts. (dotimes (i 100000) (system:serve-event))) ;; Disable event handling on this display. (ext:disable-clx-event-handling display) (delete-window iwindow display) (delete-window swindow display) ;; Close the display. (xlib:close-display display))))
(defun delete-window (window display) ;; Remove the windows from the object sets before destroying them. (system:remove-xwindow-object window) ;; Destroy the window. (destroy-window window) ;; Pick off any events the X server has already queued for our ;; windows, so we don't choke since SYSTEM:SERVE-EVENT is no longer ;; prepared to handle events for us. (loop (unless (deleting-window-drop-event display window) (return)))) (defun deleting-window-drop-event (display win) "Check for any events on win. If there is one, remove it from the event queue and return t; otherwise, return nil." (xlib:display-finish-output display) (let ((result nil)) (xlib:process-event display :timeout 0 :handler #'(lambda (&key event-window &allow-other-keys) (if (eq event-window win) (setf result t) nil))) result))
Previous: Without Object Sets Example, Up: A SERVE-EVENT Example [Contents][Index]