From aa2d6f929f7cd084417a9ec0e09a5e8d812212d7 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Wed, 1 Sep 1993 22:45:42 +0000 Subject: [PATCH] Add some new functionality to the X graphics interface to allow access to mouse, keyboard, and focus events that are used by the interface itself. These events can be used to build useful user interfaces. --- v7/src/runtime/runtime.pkg | 5 +- v7/src/runtime/x11graph.scm | 99 +++++++++++++++++++++++++++++-------- v8/src/runtime/runtime.pkg | 5 +- 3 files changed, 87 insertions(+), 22 deletions(-) diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg index 7f6c36d83..eecdc8d87 100644 --- a/v7/src/runtime/runtime.pkg +++ b/v7/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: runtime.pkg,v 14.191 1993/08/31 00:32:09 ziggy Exp $ +$Id: runtime.pkg,v 14.192 1993/09/01 22:45:42 cph Exp $ Copyright (c) 1988-1993 Massachusetts Institute of Technology @@ -2178,6 +2178,7 @@ MIT in each case. |# x-graphics/draw-point x-graphics/draw-text x-graphics/discard-events + x-graphics/enable-keyboard-focus x-graphics/font-structure x-graphics/get-colormap x-graphics/get-default @@ -2191,8 +2192,10 @@ MIT in each case. |# x-graphics/query-pointer x-graphics/raise-window x-graphics/read-button + x-graphics/read-user-event x-graphics/reset-clip-rectangle x-graphics/resize-window + x-graphics/select-user-events x-graphics/set-background-color x-graphics/set-border-color x-graphics/set-border-width diff --git a/v7/src/runtime/x11graph.scm b/v7/src/runtime/x11graph.scm index e9aaffbec..a49b8ead3 100644 --- a/v7/src/runtime/x11graph.scm +++ b/v7/src/runtime/x11graph.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: x11graph.scm,v 1.28 1993/04/27 09:14:12 cph Exp $ +$Id: x11graph.scm,v 1.29 1993/09/01 22:45:36 cph Exp $ Copyright (c) 1989-1993 Massachusetts Institute of Technology @@ -52,6 +52,7 @@ MIT in each case. |# (x-window-beep 1) (x-window-clear 1) + (x-window-event-mask 1) (x-window-iconify 1) (x-window-id 1) (x-window-lower 1) @@ -137,7 +138,14 @@ MIT in each case. |# ;; This mask contains button-down, configure, delete-window, map, unmap, ;; and visibility. -(define-integrable event-mask #x5c05) +(define-integrable default-event-mask #x5c05) + +;; This mask additionally contains take-focus. +(define-integrable system-event-mask #x7c05) + +;; This mask contains button-down, button-up, enter, focus-in, +;; focus-out, key-press, leave, and motion. +(define-integrable user-event-mask #x01fb) ;;;; Protection lists @@ -389,6 +397,14 @@ MIT in each case. |# (loop))))) (if (not block-events?) (unblock-thread-events)))) + +(define (read-event-of-type device event-type) + (let ((display (x-graphics/display device))) + (let loop () + (let ((event (read-event display))) + (if (fix:= (vector-ref event 0) event-type) + event + (loop)))))) (define (process-event display event) (let ((handler (vector-ref event-handlers (vector-ref event 0)))) @@ -437,10 +453,30 @@ MIT in each case. |# ((2) (set-x-window/visibility! window 'OBSCURED))) false)) -(define-event-handler event-type:button-down - (lambda (window event) - (enqueue! (x-display/event-queue (x-window/display window)) event) - true)) +(let ((mouse-event-handler + (lambda (window event) + (vector-set! event 2 + (x-graphics-map-x-coordinate window + (vector-ref event 2))) + (vector-set! event 3 + (x-graphics-map-y-coordinate window + (vector-ref event 3))) + (enqueue! (x-display/event-queue (x-window/display window)) event) + true))) + (define-event-handler event-type:button-down mouse-event-handler) + (define-event-handler event-type:button-up mouse-event-handler) + (define-event-handler event-type:motion mouse-event-handler)) + +(let ((user-event-handler + (lambda (window event) + (enqueue! (x-display/event-queue (x-window/display window)) event) + true))) + ;; ENTER and LEAVE events should be modified to have X,Y coordinates. + (define-event-handler event-type:enter user-event-handler) + (define-event-handler event-type:focus-in user-event-handler) + (define-event-handler event-type:focus-out user-event-handler) + (define-event-handler event-type:key-press user-event-handler) + (define-event-handler event-type:leave user-event-handler)) ;;;; Standard Operations @@ -478,7 +514,7 @@ MIT in each case. |# geometry (and (not (default-object? suppress-map?)) suppress-map?)))) - (x-window-set-event-mask xw event-mask) + (x-window-set-event-mask xw default-event-mask) (let ((window (make-x-window xw display))) (add-to-protection-list! (x-display/window-list display) window xw) window)))) @@ -624,6 +660,14 @@ MIT in each case. |# (x-display-get-default (x-graphics-device/xd device) resource-name class-name)) +(define (x-graphics/starbase-filename device) + (x-window-starbase-filename (x-graphics-device/xw device))) + +(define (x-graphics/window-id device) + (x-window-id (x-graphics-device/xw device))) + +;;;; Event-Handling Operations + (define (x-graphics/set-input-hint device input?) (x-window-set-input-hint (x-graphics-device/xw device) input?)) @@ -631,8 +675,25 @@ MIT in each case. |# ;; Tell the window to participate in the TAKE-FOCUS protocol. Since ;; there is no handler for this event, focus will never be given to ;; the window. - (x-window-set-event-mask (x-graphics-device/xw device) - (fix:or #x2000 event-mask))) + (let ((xw (x-graphics-device/xw device))) + (x-window-set-event-mask xw + (fix:or system-event-mask + (fix:and user-event-mask + (x-window-event-mask xw)))))) + +(define (x-graphics/enable-keyboard-focus device) + (let ((xw (x-graphics-device/xw device))) + (x-window-set-event-mask xw + (fix:or default-event-mask + (fix:and user-event-mask + (x-window-event-mask xw)))))) + +(define (x-graphics/select-user-events device mask) + (let ((xw (x-graphics-device/xw device))) + (x-window-set-event-mask + xw + (fix:or (fix:and user-event-mask mask) + (fix:and system-event-mask (x-window-event-mask xw)))))) (define (x-graphics/query-pointer device) (let* ((window (x-graphics-device/xw device)) @@ -642,20 +703,18 @@ MIT in each case. |# (vector-ref result 4)))) (define (x-graphics/read-button device) - (let ((event (read-event (x-graphics/display device)))) - (let ((window (vector-ref event 1))) - (values (x-graphics-map-x-coordinate window (vector-ref event 2)) - (x-graphics-map-y-coordinate window (vector-ref event 3)) - (vector-ref event 4))))) + (let ((event + (read-event-of-type (x-graphics/display device) + event-type:button-down))) + (values (vector-ref event 2) + (vector-ref event 3) + (vector-ref event 4)))) + +(define (x-graphics/read-user-event device) + (read-event (x-graphics/display device))) (define (x-graphics/discard-events device) (discard-events (x-graphics/display device))) - -(define (x-graphics/starbase-filename device) - (x-window-starbase-filename (x-graphics-device/xw device))) - -(define (x-graphics/window-id device) - (x-window-id (x-graphics-device/xw device))) ;;;; Font Operations diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg index 7f6c36d83..eecdc8d87 100644 --- a/v8/src/runtime/runtime.pkg +++ b/v8/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: runtime.pkg,v 14.191 1993/08/31 00:32:09 ziggy Exp $ +$Id: runtime.pkg,v 14.192 1993/09/01 22:45:42 cph Exp $ Copyright (c) 1988-1993 Massachusetts Institute of Technology @@ -2178,6 +2178,7 @@ MIT in each case. |# x-graphics/draw-point x-graphics/draw-text x-graphics/discard-events + x-graphics/enable-keyboard-focus x-graphics/font-structure x-graphics/get-colormap x-graphics/get-default @@ -2191,8 +2192,10 @@ MIT in each case. |# x-graphics/query-pointer x-graphics/raise-window x-graphics/read-button + x-graphics/read-user-event x-graphics/reset-clip-rectangle x-graphics/resize-window + x-graphics/select-user-events x-graphics/set-background-color x-graphics/set-border-color x-graphics/set-border-width -- 2.25.1