;;; -*- Mode: COMMON-LISP; Package: X11; Base: 10; Fonts: MEDFNB, HL12B, HL12BI; -*- ;;; RESTRICTED RIGHTS LEGEND ;;;Use, duplication, or disclosure by the Government is subject to ;;;restrictions as set forth in subdivision (c)(1)(ii) of the Rights in ;;;Technical Data and Computer Software clause at 52.227-7013. ;;; ;;; TEXAS INSTRUMENTS INCORPORATED. ;;; P.O. BOX 2909 ;;; AUSTIN, TEXAS 78769 ;;; MS 2151 ;;; ;;; Copyright (C) 1988 Texas Instruments Incorporated. All rights reserved. #| This file contains the device-dependant cursor code. |# ;;; Change history: ;;; ;;; Date Author Description ;;; ------------------------------------------------------------------------------------- ;;; 03/29/89 DAN Patch 1.61; Fix EXPLORER-SET-CURSOR-POSITION to call W:MOUSE-WARP. ;;; 03/21/89 WJB Patch 1.51; Fix MAYBE-REMOVE-WINDOW to account for window borders. ;;; 03/10/89 WJB Patch 1.39; Change EXPLORER-REALIZE-CURSOR and EXPLORER-RECOLOR-CURSOR to ;;; call the new explorer-get-pixel. Reverse the ALUs used by EXPLORER-PUT-CURSOR. ;;; Fixes problems with cursor "color". ;;; 02/08/89 WJB Patch 1.9: In EXPLORER-REALIZE-CURSOR, ensure the cr-private structure ;;; has an initial value for the screen-x and screen-y slots. ;;; 12/21/88 LGO 1Fix EXPLORER-RECOLOR-CURSOR to recolor the cursor passed in, not the current cursor* ;;; 12/20/88 LGO 1Get the default cursor from a global, **default-cursor-glyph*1, initialized to 0 (the X cursor)* ;;; 12/20/88 LGO When drawing the cursor, use cr-private.fg and cr-private.bg ;;; 11/23/88 LGO Eliminate use of bitblt-under-mask from explorer-put-cursor1.* ;;; 11/02/88 WJB In EXPLORER-DISPLAY-CURSOR, transfer the value of the lock slot. ;;; 10/20/88 WJB Removed call to EXPLORER-DISPLAY-CURSOR from EXPLORER-SET-CURSOR-POSITION. ;;; More changes to locking scheme. Wrote MAYBE-RESTORE-CURSOR. ;;; 10/18/88 WJB Added cursor locking to prevent client and dispatcher process clashes. ;;; 10/03/88 WJB Wrote MAYBE-REMOVE-CURSOR. ;;; 9/29/88 WJB Changed SERVER-BITS-FROM-GLYPH to call POLY-TEXT16 to draw ;;; glyph into pixmap. ;;; 8/25/88 WJB Massive changes to make this stuff almost work. ;;; 7/27/88 DAN Coded EXPLORER-PUT-CURSOR. ;;; 7/26/88 DAN Changed INITIALIZE-EXPLORER-CURSOR to store INV-GC in the ;;; SRC-INV-GC slot. ;;; Added EXPLORER-RECOLOR-CURSOR, CURSOR-METRICS-FROM-GLYPH, and ;;; SERVER-BITS-FROM-GLYPH. ;;; 6/07/88 TWE Changed X-BITMAP-MOUSE-PATHNAME to not refer to the host KDB. ;;; 5/11/88 TWE Fixed EXPLORER-SET-CURSOR-POSITION to call ;;; EXPLORER-MOUSE-PROCESS-EVENT with the arguments in the proper ;;; order. ;;; 5/02/88 TWE Changed EXPLORER-RESTORE-CURSOR to check for a client before ;;; visually updating the cursor. ;;; 4/12/88 TWE Hacked EXPLORER-REMOVE-CURSOR to check for a client before ;;; visually updating the cursor. ;;; 3/03/88 TWE Implemented all functions except for EXPLORER-PUT-CURSOR, which ;;; is still stubbed out. Implemented the INITIALIZE-EXPLORER-CURSOR ;;; function. ;;; 2/29/88 TWE Initial creation. Moved from EVENTS.LISP. (DEFCONSTANT *SAVED-CURSOR-AREA-SIZE* 4 "Number of times larger the saved screen area is than the cursor pixmap.") ;;; Initialize the CURRENT-CURSOR variable. This can be done any time after the ;;; screens have been set up. This allows a cursor to be "realized" before ;;; there is a client connection. (DEFUN INITIALIZE-EXPLORER-CURSOR () ;; Ensure noone thinks a cursor is already displayed ;; Create the root cursor and set current cursor to it (SETQ ROOT-CURSOR (CREATE-ROOT-CURSOR *DEFAULT-CURSOR-FONT* *default-cursor-glyph*)) (SETQ CURRENT-CURSOR ROOT-CURSOR) ;; Create holder array for a cr-privite structure per screen (SETF (CURSOR-RECORD.DEV-PRIVATE ROOT-CURSOR) (MAKE-ARRAY (SCREEN-INFO.NUM-SCREENS SCREEN-INFO) :ELEMENT-TYPE 'CR-PRIVATE)) ;; Set the cursor for all root windows (LOOP FOR ROOT IN (SCREEN-INFO.WINDOWS SCREEN-INFO) DO (SETF (WINDOW.CURSOR ROOT) ROOT-CURSOR)) ;;! Monochrome dependent (EXPLORER-REALIZE-CURSOR (FIRST (SCREEN-INFO.SCREENS SCREEN-INFO)) ROOT-CURSOR) CURRENT-CURSOR) (DEFUN COPY-CURSOR-AREA (STATE GC SRC-DRAWABLE SRC-X SRC-Y DST-DRAWABLE DST-X DST-Y WIDTH HEIGHT) (LET ((*RESOURCES* (STATE.RESOURCES STATE))) (COPY-AREA STATE GC SRC-DRAWABLE SRC-X SRC-Y DST-DRAWABLE DST-X DST-Y WIDTH HEIGHT))) (DEFUN CR-PRIVATE-FOR-SCREEN (CURSOR SCREEN) (let ((private (CURSOR-RECORD.DEV-PRIVATE CURSOR))) (and private (AREF private (SCREEN.MY-NUMBER SCREEN))))) ;;; Redraw the cursor if it was removed. ;;; The cursor may be replaced and the 'state' field changed. (DEFUN EXPLORER-RESTORE-CURSOR () (LET* ((MOUSE (LOOKUP-POINTER-DEVICE)) (SCREEN (DEVICE.SCREEN MOUSE)) ;(ROOT-WINDOW (SCREEN-ROOT-WINDOW SCREEN)) (CR-PRIV (CR-PRIVATE-FOR-SCREEN CURRENT-CURSOR SCREEN)) (SCREEN-BITS (CR-PRIVATE.SCREEN-BITS CR-PRIV)) (MOUSE-X (DEVICE.X MOUSE)) (MOUSE-Y (DEVICE.Y MOUSE)) REALW REALH) (DECLARE (TYPE DEVICE MOUSE) (TYPE SCREEN SCREEN) (TYPE CR-PRIVATE CR-PRIV) (TYPE PIXMAP SCREEN-BITS)) (WHEN (= (CR-PRIVATE.STATE CR-PRIV) CR-OUT) ;; Since the buffer pixmap is some factor larger than the cursor and ;; we would always like to center the thing so as to allow the same ;; leeway for movement, in EXPLORER-MOVE-CURSOR, on each side, we place the ;; top-left corner of the cursor at the intersection of the first ;; quarter lines by shifting the position of the buffer pixmap. (LET ((SCREEN-CURSOR-X (MAX 0 (- MOUSE-X (CURSOR-RECORD.XHOT CURRENT-CURSOR) (CR-PRIVATE.X-SAVE-OFFSET CR-PRIV)))) (SCREEN-CURSOR-Y (MAX 0 (- MOUSE-Y (CURSOR-RECORD.YHOT CURRENT-CURSOR) (CR-PRIVATE.Y-SAVE-OFFSET CR-PRIV)))) ) ;; In general we're trying to store some of the bits surrounding the ;; cursor. In general, we try to center the cursor in the area we're ;; saving; that is what the previous two lines are doing. But if we're ;; at the top left already, we won't try to center the cursor; we'll just ;; save from [0,0]. (SETF (CR-PRIVATE.SCREEN-X CR-PRIV) SCREEN-CURSOR-X) (SETF (CR-PRIVATE.SCREEN-Y CR-PRIV) SCREEN-CURSOR-Y) (SETF (CR-PRIVATE.SCREEN-BITS-INVALID CR-PRIV) NIL) ;; Save area of screen around cursor. ;;!! ;;(SERVER-LOG "~%Restore: Saving bits from X=~d Y=~d" SCREEN-CURSOR-X SCREEN-CURSOR-Y) (SETQ REALW (MIN (PIXMAP.WIDTH SCREEN-BITS) (- (SCREEN.WIDTH SCREEN) SCREEN-CURSOR-X))) (SETQ REALH (MIN (PIXMAP.HEIGHT SCREEN-BITS) (- (SCREEN.HEIGHT SCREEN) SCREEN-CURSOR-Y))) (X-BITBLT GX-COPY REALW REALH (DEVICE-PRIVATE-ARRAY SCREEN) SCREEN-CURSOR-X SCREEN-CURSOR-Y (PIXMAP.ARRAY SCREEN-BITS) 0 0) (EXPLORER-PUT-CURSOR SCREEN CR-PRIV MOUSE-X MOUSE-Y))))) ;;; Shift a the current cursor by a given amount. If the change keeps ;;; the cursor within its screenBits pixmap, the whole thing is ;;; simply drawn over the old position. Otherwise, the cursor is ;;; removed and must be redrawn before we sleep. The pointer's ;;; coordinates need not have been updated before this is called. (DEFUN EXPLORER-MOVE-CURSOR (SCREEN HOT-X HOT-Y) (DECLARE (TYPE SCREEN SCREEN) (TYPE INTEGER HOT-X HOT-Y)) ;;!! ;;(SERVER-LOG "~%Moving cursor to ~D ~D" hot-x hot-y) (LET ((CR-PRIV (CR-PRIVATE-FOR-SCREEN CURRENT-CURSOR SCREEN))) (DECLARE (TYPE CR-PRIVATE CR-PRIV)) (WHEN (NOT (= (CR-PRIVATE.STATE CR-PRIV) CR-OUT)) (IF (AND (NOT (CR-PRIVATE.SCREEN-BITS-INVALID CR-PRIV)) (>= (- HOT-X (CURSOR-RECORD.XHOT CURRENT-CURSOR)) (CR-PRIVATE.SCREEN-X CR-PRIV)) (< (+ HOT-X (- (CURSOR-RECORD.XHOT CURRENT-CURSOR)) (CURSOR-RECORD.WIDTH CURRENT-CURSOR)) (+ (CR-PRIVATE.SCREEN-X CR-PRIV) (PIXMAP.WIDTH (CR-PRIVATE.SCREEN-BITS CR-PRIV)))) (>= (- HOT-Y (CURSOR-RECORD.YHOT CURRENT-CURSOR)) (CR-PRIVATE.SCREEN-Y CR-PRIV)) (< (+ HOT-Y (- (CURSOR-RECORD.YHOT CURRENT-CURSOR)) (CURSOR-RECORD.HEIGHT CURRENT-CURSOR)) (+ (CR-PRIVATE.SCREEN-Y CR-PRIV) (PIXMAP.HEIGHT (CR-PRIVATE.SCREEN-BITS CR-PRIV))))) ;; If the entire cursor at its new position remains inside the ;; box buffered in the screenBits pixmap, then its ok to just ;; place the cursor inside the box and draw the entire box ;; onto the screen. The hope is that this redrawing, rather than ;; removing the cursor and redrawing it, will cause it to flicker ;; less than it did in V10... (progn ;;(server-log "~%Moving cursor: still in box") (EXPLORER-PUT-CURSOR SCREEN CR-PRIV HOT-X HOT-Y)) ;;ELSE ;; The cursor is no longer within the screenBits pixmap, so we just ;; remove it. dix will RestoreCursor() it back onto the screen. ;;(server-log "~%Moving cursor: out of box") (EXPLORER-REMOVE-CURSOR))))) ;;; Alter the position of the current cursor. The x and y coordinates ;;; are assumed to be legal for the given screen. ;;; The pScreen, x, and y fields of the current pointer's private data ;;; are altered to reflect the new values. I.e. moving the cursor to ;;; a different screen moves the pointer there as well. Helpful... (DEFUN EXPLORER-SET-CURSOR-POSITION (SCREEN HOT-X HOT-Y GENERATE-EVENT) "SCREEN - New screen for the cursor, HOT-X, HOT-Y New absolute (X,Y) coordinate for the cursor GENERATE-EVENT T or NIL depending on whether we generate a motion event." (DECLARE (TYPE SCREEN SCREEN) (TYPE INTEGER HOT-X HOT-Y) (TYPE BOOLEAN GENERATE-EVENT) (VALUES BOOLEAN)) ;;(WHEN CURRENT-CURSOR ;;(EXPLORER-DISPLAY-CURSOR SCREEN CURRENT-CURSOR)) (LET ((MOUSE (LOOKUP-POINTER-DEVICE))) (SETF (DEVICE.SCREEN MOUSE) SCREEN) (SETF (DEVICE.X MOUSE) HOT-X) (SETF (DEVICE.Y MOUSE) HOT-Y) ;1;Make sure the Explorer knows that the mouse has been moved.* (w:mouse-warp hot-x hot-y) (WHEN GENERATE-EVENT ;; Note that the 0 indicates that no mouse buttons were changed. ;; By default this indicates a motion event. (EXPLORER-MOUSE-PROCESS-EVENT MOUSE 0 LAST-EVENT-TIME HOT-X HOT-Y)) T)) ;;; Remove the current cursor from the screen, if it hasn't been removed ;;; already. ;;; If the cursor is removed, the state field of the cursor-private ;;; structure is set to CR-OUT. In addition, EXPLORER-INPUT-AVAIL is called. (DEFUN EXPLORER-REMOVE-CURSOR () (LET* ((MOUSE (LOOKUP-POINTER-DEVICE)) (SCREEN (DEVICE.SCREEN MOUSE)) (CR-PRIV (CR-PRIVATE-FOR-SCREEN CURRENT-CURSOR SCREEN)) (SCREEN-BITS (CR-PRIVATE.SCREEN-BITS CR-PRIV)) ;(ROOT-WINDOW (SCREEN-ROOT-WINDOW SCREEN)) REALW REALH) (DECLARE (TYPE DEVICE MOUSE) (TYPE SCREEN SCREEN) (TYPE CR-PRIVATE CR-PRIV) ;;(TYPE WINDOW ROOT-WINDOW) (TYPE PIXMAP SCREEN-BITS)) (WHEN (= (CR-PRIVATE.STATE CR-PRIV) CR-IN) ;; XXX: Makes use of the devPrivate field of the screen. This *must* ;; be a pixmap representing the entire screen. How else can I get a ;; pixmap to draw to? (SETF (CR-PRIVATE.STATE CR-PRIV) CR-XING) ;; Clip to the boundries of the screen (SETQ REALW (MIN (PIXMAP.WIDTH SCREEN-BITS) (- (SCREEN.WIDTH SCREEN) (CR-PRIVATE.SCREEN-X CR-PRIV)))) (SETQ REALH (MIN (PIXMAP.HEIGHT SCREEN-BITS) (- (SCREEN.HEIGHT SCREEN) (CR-PRIVATE.SCREEN-Y CR-PRIV)))) (SETF (CR-PRIVATE.STATE CR-PRIV) CR-XING) ;;(SERVER-LOG "~%Remove cursor: X=~d Y=~d" (CR-PRIVATE.SCREEN-X CR-PRIV) (CR-PRIVATE.SCREEN-Y CR-PRIV)) (X-BITBLT GX-COPY REALW REALH (PIXMAP.ARRAY SCREEN-BITS) 0 0 (DEVICE-PRIVATE-ARRAY SCREEN) (CR-PRIVATE.SCREEN-X CR-PRIV) (CR-PRIVATE.SCREEN-Y CR-PRIV)) (SETF (CR-PRIVATE.STATE CR-PRIV) CR-OUT) ;; I'm not sure if we need this. Leave it here until we find out. (TWE) ;;(INCF IS-IT-TIME-TO-YIELD) ))) ;;; Set the current cursor. ;;; The value of currentCursor is altered. Note that the cursor is ;;; *not* placed in the frame buffer until RestoreCursor is called. ;;; Instead, the cursor is marked as out, which will cause it to ;;; be replaced. (DEFUN EXPLORER-DISPLAY-CURSOR (SCREEN CURSOR) "SCREEN Screen on which to display cursor, CURSOR Cursor to display." (DECLARE (TYPE SCREEN SCREEN) (TYPE CURSOR-RECORD CURSOR) (VALUES BOOLEAN)) (EVENT-TRACE-ENTERING "EXPLORER-DISPLAY-CURSOR") (WHEN CURRENT-CURSOR (EXPLORER-REMOVE-CURSOR)) ;; Transfer the old lock value and make the new cursor the current. (SETF (CURSOR-RECORD.LOCK CURSOR) (CURSOR-RECORD.LOCK CURRENT-CURSOR)) (SETF CURRENT-CURSOR CURSOR) ;; If cursor has never been displayed on any screen, must create holder array for cr-privates (WHEN (MEMBER (CURSOR-RECORD.DEV-PRIVATE CURSOR) '(nil :unbound)) (SETF (CURSOR-RECORD.DEV-PRIVATE CURSOR) (MAKE-ARRAY (SCREEN-INFO.NUM-SCREENS SCREEN-INFO) :ELEMENT-TYPE 'CR-PRIVATE))) (LET ((CR-PRIV (CR-PRIVATE-FOR-SCREEN CURSOR SCREEN))) ;; If cursor has never been displayed on this screen, must create and initialize cr-private. (unless CR-PRIV (EXPLORER-REALIZE-CURSOR SCREEN CURSOR) (SETQ CR-PRIV (CR-PRIVATE-FOR-SCREEN CURSOR SCREEN)))) ;; I'm not sure if we need this. Leave it here until we find out. (TWE) ;;(INCF IS-IT-TIME-TO-YIELD) (LET ((MOUSE (LOOKUP-POINTER-DEVICE))) (DECLARE (TYPE DEVICE MOUSE)) (WHEN (NEQ SCREEN (DEVICE.SCREEN MOUSE)) ;; The C version had the following item. I have no idea what XXX means. ;; /*XXX*/ (SETF (DEVICE.SCREEN MOUSE) SCREEN)) (EVENT-TRACE-LEAVING "EXPLORER-DISPLAY-CURSOR") T)) ;;; EXPLORER-PUT-CURSOR ;;; Place the current cursor in the screen at the given coordinates. ;;; screenBits must already have been filled. If 'direct' is FALSE, ;;; the cursor will be drawn into the temp pixmap after the screenBits ;;; have been copied there. The temp pixmap will then be put onto ;;; the screen. Used for more flicker-free cursor motion... ;;; ;;; Results: ;;; None. ;;; ;;; Side Effects: ;;; The state field of the private data is set to CR-IN... (DEFUN EXPLORER-PUT-CURSOR (SCREEN PRIV HOT-X HOT-Y) (DECLARE (TYPE SCREEN SCREEN) ; Screen on which to put it. (TYPE CR-PRIVATE PRIV) (TYPE INTEGER HOT-X HOT-Y)) (LET* ((CURSOR CURRENT-CURSOR) (X (- HOT-X (CURSOR-RECORD.XHOT CURSOR))) (Y (- HOT-Y (CURSOR-RECORD.YHOT CURSOR))) (TMP-PIXMAP (CR-PRIVATE.TEMP PRIV)) (TMP-ARRAY (PIXMAP.ARRAY TMP-PIXMAP)) (SRC-PIXMAP (CR-PRIVATE.SOURCE-BITS PRIV)) (SRC-ARRAY (PIXMAP.ARRAY SRC-PIXMAP)) (MSK-ARRAY (CURSOR-RECORD.MASK CURSOR)) ;; Offset into the saved image to store the cursor (SAVED-IMAGE-X-OFFSET (- X (CR-PRIVATE.SCREEN-X PRIV))) (SAVED-IMAGE-Y-OFFSET (- Y (CR-PRIVATE.SCREEN-Y PRIV))) (CURSOR-X-OFFSET 0) (CURSOR-Y-OFFSET 0) ;;(ROOT-WINDOW (SCREEN-ROOT-WINDOW SCREEN)) REALW REALH) ;; Copy the saved screen bits to a temporary (X-BITBLT GX-COPY (PIXMAP.WIDTH TMP-PIXMAP) (PIXMAP.HEIGHT TMP-PIXMAP) (PIXMAP.ARRAY (CR-PRIVATE.SCREEN-BITS PRIV)) 0 0 TMP-ARRAY 0 0) ;; Check if origin of saved image is off the screen (left or top) ;; If so, must index into cursor image to make cursor got partly offscreen. (WHEN (MINUSP SAVED-IMAGE-X-OFFSET) (SETQ CURSOR-X-OFFSET (ABS SAVED-IMAGE-X-OFFSET)) (SETQ SAVED-IMAGE-X-OFFSET 0)) (WHEN (MINUSP SAVED-IMAGE-Y-OFFSET) (SETQ CURSOR-Y-OFFSET (ABS SAVED-IMAGE-Y-OFFSET)) (SETQ SAVED-IMAGE-Y-OFFSET 0)) (SETF (CR-PRIVATE.STATE PRIV) CR-XING) (let ((erase-alu (if (zerop (cr-private.bg priv)) gx-and-inverted gx-or)) (draw-alu (if (zerop (cr-private.fg priv)) gx-and-inverted gx-or))) ;;Set the foreground and background from pre-computed pixmap (x-bitblt erase-alu (- (PIXMAP.WIDTH SRC-PIXMAP) CURSOR-X-OFFSET) (- (PIXMAP.HEIGHT SRC-PIXMAP) CURSOR-Y-OFFSET) MSK-ARRAY CURSOR-X-OFFSET CURSOR-Y-OFFSET TMP-ARRAY SAVED-IMAGE-X-OFFSET SAVED-IMAGE-Y-OFFSET) (x-bitblt draw-alu (- (PIXMAP.WIDTH SRC-PIXMAP) CURSOR-X-OFFSET) (- (PIXMAP.HEIGHT SRC-PIXMAP) CURSOR-Y-OFFSET) SRC-ARRAY CURSOR-X-OFFSET CURSOR-Y-OFFSET TMP-ARRAY SAVED-IMAGE-X-OFFSET SAVED-IMAGE-Y-OFFSET)) #+comment (BITBLT-UNDER-MASK GX-COPY (- (PIXMAP.WIDTH SRC-PIXMAP) CURSOR-X-OFFSET) (- (PIXMAP.HEIGHT SRC-PIXMAP) CURSOR-Y-OFFSET) MSK-ARRAY CURSOR-X-OFFSET CURSOR-Y-OFFSET SRC-ARRAY CURSOR-X-OFFSET CURSOR-Y-OFFSET TMP-ARRAY SAVED-IMAGE-X-OFFSET SAVED-IMAGE-Y-OFFSET) ;; Clip to the boundries of the screen (SETQ REALW (MIN (PIXMAP.WIDTH TMP-PIXMAP) (- (SCREEN.WIDTH SCREEN) (CR-PRIVATE.SCREEN-X PRIV)))) (SETQ REALH (MIN (PIXMAP.HEIGHT TMP-PIXMAP) (- (SCREEN.HEIGHT SCREEN) (CR-PRIVATE.SCREEN-Y PRIV)))) ;;!! ;;(SERVER-LOG "~%Put cursor: X=~d Y=~d W=~d H=~d" (CR-PRIVATE.SCREEN-X PRIV) (CR-PRIVATE.SCREEN-Y PRIV) REALW REALH) (X-BITBLT GX-COPY REALW REALH TMP-ARRAY 0 0 (DEVICE-PRIVATE-ARRAY SCREEN) (CR-PRIVATE.SCREEN-X PRIV) (CR-PRIVATE.SCREEN-Y PRIV)) ;; test code to check hotspot ;;(send (screen.dev-private screen) :draw-line (- hot-x 15) hot-y (+ hot-x 15) hot-y) ;;(send (screen.dev-private screen) :draw-line hot-x (- hot-y 15) hot-x (+ hot-y 15)) (SETF (CR-PRIVATE.STATE PRIV) CR-IN))) ;;; Given an X and Y coordinate, alter them to fit within the current ;;; cursor constraints. Used by mouse processing code to adjust ;;; position reported by hardware. ;;; The new constrained coordinates. Returns FALSE if the motion ;;; event should be discarded... (DEFUN EXPLORER-CONSTRAIN-XY (X Y) (DECLARE (TYPE INTEGER X Y) ;; Success X Y (VALUES BOOLEAN INTEGER INTEGER)) (VALUES T (MAX (BOX.LEFT CURRENT-LIMITS) (MIN (BOX.RIGHT CURRENT-LIMITS) X)) (MAX (BOX.TOP CURRENT-LIMITS) (MIN (BOX.BOTTOM CURRENT-LIMITS) Y)))) ;;; Make it so the current pointer doesn't let the cursor's ;;; hot-spot wander out of the specified box. (DEFUN CONSTRAIN-CURSOR (SCREEN PHYSICAL-LIMITS) "SCREEN Screen to which it should be constrained, BOX Box in which..." (DECLARE (TYPE SCREEN SCREEN) (TYPE BOX PHYSICAL-LIMITS) (IGNORE SCREEN)) (SETQ CURRENT-LIMITS (COPY-BOX PHYSICAL-LIMITS))) ;;; Return a box within which the given cursor may move on the given ;;; screen. We assume that the HotBox is actually on the given screen, ;;; since dix knows that size. (DEFUN EXPLORER-CURSOR-LIMITS (SCREEN CURSOR HOT-LIMITS) "SCREEN Screen on which limits are desired, CURSOR Cursor whose limits are desired, HOT-LIMITS Limits for pCursor's hot point. Returns: BOX object for limits for hot spot." (DECLARE (TYPE SCREEN SCREEN) (TYPE CURSOR-RECORD CURSOR) (TYPE BOX HOT-LIMITS) (VALUES BOX) (IGNORE SCREEN CURSOR)) (COPY-BOX HOT-LIMITS)) (DEFUN 2D-FONT-TO-1D-FONT (BYTE1 BYTE2 FONT-INFO-REC) (+ (* (1+ (- (FONT-INFO-RECORD.LAST-COL FONT-INFO-REC) (FONT-INFO-RECORD.FIRST-COL FONT-INFO-REC))) (- BYTE1 (FONT-INFO-RECORD.FIRST-ROW FONT-INFO-REC))) (- BYTE2 (FONT-INFO-RECORD.FIRST-COL FONT-INFO-REC)))) (DEFUN GLYPH-IN-FONT (FONT CH) (LET* ((FONT-INFO-REC (FONT-RECORD.FI FONT)) (FIRST-CHAR (2D-FONT-TO-1D-FONT (FONT-INFO-RECORD.FIRST-ROW FONT-INFO-REC) (FONT-INFO-RECORD.FIRST-COL FONT-INFO-REC) FONT-INFO-REC)) (LAST-CHAR (2D-FONT-TO-1D-FONT (FONT-INFO-RECORD.LAST-ROW FONT-INFO-REC) (FONT-INFO-RECORD.LAST-COL FONT-INFO-REC) FONT-INFO-REC)) (THIS-CHAR (2D-FONT-TO-1D-FONT (LDB #O1010 CH) (LDB #O0010 CH) FONT-INFO-REC))) (<= FIRST-CHAR THIS-CHAR LAST-CHAR))) (DEFUN CURSOR-METRICS-FROM-GLYPH (FONT CH) (WHEN (GLYPH-IN-FONT FONT CH) (LET* ((CM (MAKE-CURSOR-RECORD)) (FONT-INFO (FONT-RECORD.FI FONT)) (MAX-BOUNDS (FONT-INFO-RECORD.MAX-BOUNDS FONT-INFO)) (METRICS (FONT-RECORD.CI FONT)) (CHAR-INFO (IF METRICS (AREF METRICS (2D-FONT-TO-1D-FONT (LDB #O1010 CH) (LDB #O0010 CH) (FONT-RECORD.FI FONT))) (FONT-INFO-RECORD.MAX-BOUNDS (FONT-RECORD.FI FONT))))) (SETF (CURSOR-RECORD.XHOT CM) (- (X-CHAR-INFO.LEFT-SIDE-BEARING CHAR-INFO))) (SETF (CURSOR-RECORD.YHOT CM) (X-CHAR-INFO.ASCENT CHAR-INFO)) (SETF (CURSOR-RECORD.WIDTH CM) (X-CHAR-INFO.CHARACTER-WIDTH MAX-BOUNDS)) (SETF (CURSOR-RECORD.HEIGHT CM) (+ (X-CHAR-INFO.DESCENT MAX-BOUNDS) (X-CHAR-INFO.ASCENT MAX-BOUNDS))) CM))) (DEFUN SERVER-BITS-FROM-GLYPH (FONT CH CURSOR-REC) (LET* ((FONT-INFO (FONT-RECORD.FI FONT)) (MAX-BOUNDS (FONT-INFO-RECORD.MAX-BOUNDS FONT-INFO)) (MAX-WIDTH (X-CHAR-INFO.CHARACTER-WIDTH MAX-BOUNDS)) (MAX-HEIGHT (+ (X-CHAR-INFO.ASCENT MAX-BOUNDS) (X-CHAR-INFO.DESCENT MAX-BOUNDS))) (BITS (CREATE-PIXMAP (DEFAULT-SCREEN) MAX-WIDTH MAX-HEIGHT 1 (if ch 0 1)))) (when ch (let ((TMP-GC (CREATE-SCRATCH-GC NIL 1)) (BYTES (MAKE-ARRAY 4 :ELEMENT-TYPE 'CARD8))) (SETF (GCONTEXT.FOREGROUND-PIXEL TMP-GC) 1) (SETF (GCONTEXT.BACKGROUND-PIXEL TMP-GC) 0) (SETF (GCONTEXT.FONT TMP-GC) FONT) (SETF (AREF BYTES 0) 1) ;string-length (SETF (AREF BYTES 1) 0) ;delta-x (SETF (AREF BYTES 2) (LDB #O1010 CH)) (SETF (AREF BYTES 3) (LDB #O0010 CH)) (POLY-TEXT16 TMP-GC BITS (CURSOR-RECORD.XHOT CURSOR-REC) (CURSOR-RECORD.YHOT CURSOR-REC) 4 BYTES 0) (FREE-SCRATCH-GC TMP-GC))) (PIXMAP.ARRAY BITS))) (DEFUN EXPLORER-RECOLOR-CURSOR (SCREEN CURSOR DISPLAYED) (LET ((CRPRIV (cr-private-for-screen cursor screen))) (when crpriv (when DISPLAYED (EXPLORER-REMOVE-CURSOR)) (SETF (CR-PRIVATE.FG CRPRIV) (EXPLORER-GET-PIXEL (CURSOR-RECORD.FORE-RED CURSOR) (CURSOR-RECORD.FORE-GREEN CURSOR) (CURSOR-RECORD.FORE-BLUE CURSOR))) (SETF (CR-PRIVATE.BG CRPRIV) (EXPLORER-GET-PIXEL (CURSOR-RECORD.BACK-RED CURSOR) (CURSOR-RECORD.BACK-GREEN CURSOR) (CURSOR-RECORD.BACK-BLUE CURSOR))) ))) (DEFUN EXPLORER-REALIZE-CURSOR (SCREEN CURSOR) "Realize a cursor for a specific screen. Eventually it will have to deal with the allocation of a special pixel from the system colormap, but for now it's fairly simple. Just have to create pixmaps. Side Effects: A CR-PRIVATE-RECORD is allocated and filled and stuffed into the cursor structure given us." (LET ((PRIV (MAKE-CR-PRIVATE)) ;; Size for pixmaps used to save screen image around cursor -- some multiple of cursor size (BUF-WIDTH (* *SAVED-CURSOR-AREA-SIZE* (CURSOR-RECORD.WIDTH CURSOR))) (BUF-HEIGHT (* *SAVED-CURSOR-AREA-SIZE* (CURSOR-RECORD.HEIGHT CURSOR))) ;; Offsets from origin of cursor to origin of screen save box (X-SAVE-OFFSET (TRUNCATE (* (CURSOR-RECORD.WIDTH CURSOR) *SAVED-CURSOR-AREA-SIZE* ) 2)) (Y-SAVE-OFFSET (TRUNCATE (* (CURSOR-RECORD.HEIGHT CURSOR) *SAVED-CURSOR-AREA-SIZE* ) 2))) (SETF (CR-PRIVATE.FG PRIV) (EXPLORER-GET-PIXEL (CURSOR-RECORD.FORE-RED CURSOR) (CURSOR-RECORD.FORE-GREEN CURSOR) (CURSOR-RECORD.FORE-BLUE CURSOR))) (SETF (CR-PRIVATE.BG PRIV) (EXPLORER-GET-PIXEL (CURSOR-RECORD.BACK-RED CURSOR) (CURSOR-RECORD.BACK-GREEN CURSOR) (CURSOR-RECORD.BACK-BLUE CURSOR))) (SETF (CR-PRIVATE.STATE PRIV) CR-OUT) ;; Create the holder array for cr-private array if none exists (UNLESS (CURSOR-RECORD.DEV-PRIVATE CURSOR) (SETF (CURSOR-RECORD.DEV-PRIVATE CURSOR) (MAKE-ARRAY (SCREEN-INFO.NUM-SCREENS SCREEN-INFO) :ELEMENT-TYPE 'CR-PRIVATE))) (SETF (AREF (CURSOR-RECORD.DEV-PRIVATE CURSOR) (SCREEN.MY-NUMBER SCREEN)) PRIV) (UNLESS (NUMBERP (CR-PRIVATE.SCREEN-X PRIV)) ;; Initialze the screen x & y (SETF (CR-PRIVATE.SCREEN-X PRIV) 0) (SETF (CR-PRIVATE.SCREEN-Y PRIV) 0)) ;; Create the two pixmaps for the off-screen manipulation of the cursor image. The screenBits ;; pixmap is used to hold the contents of the screen before the cursor is put down and the ;; temp pixmap exists to avoid having to create a pixmap each time the cursor is rop'ed in. ;; Both are made the same depth as the screen, for obvious reasons. (SETF (CR-PRIVATE.SCREEN-BITS PRIV) (CREATE-PIXMAP SCREEN BUF-WIDTH BUF-HEIGHT (SCREEN.ROOT-DEPTH SCREEN))) (SETF (CR-PRIVATE.TEMP PRIV) (CREATE-PIXMAP SCREEN BUF-WIDTH BUF-HEIGHT (SCREEN.ROOT-DEPTH SCREEN))) (SETF (CR-PRIVATE.X-SAVE-OFFSET PRIV) X-SAVE-OFFSET) (SETF (CR-PRIVATE.Y-SAVE-OFFSET PRIV) Y-SAVE-OFFSET) ;; Create a pixmap to hold the cursor image the create the image. ;; The source pixmap determines which pixels get the fg or bg colors ;; and the mask determines which pixels are unchanged (thus determining the ;; "shape" of the cursor. (SETF (CR-PRIVATE.SOURCE-BITS PRIV) (CREATE-PIXMAP SCREEN (CURSOR-RECORD.WIDTH CURSOR) (CURSOR-RECORD.HEIGHT CURSOR) (SCREEN.ROOT-DEPTH SCREEN))) ;; Initialize the cursor-bits by passing the source through the mask (EXPLORER-STENCIL-PIXELS (CURSOR-RECORD.SOURCE CURSOR) (CURSOR-RECORD.MASK CURSOR) (PIXMAP.ARRAY (CR-PRIVATE.SOURCE-BITS PRIV)) 1 0) )) (DEFUN EXPLORER-STENCIL (SOURCE MASK WIDTH HEIGHT INVERT) "2Return the data for a bitmap made by squishing the source bitmap data through the mask bitmap data. If invert is TRUE, the source data are inverted before being squished through. Returns an array of data suitable for passing to Put-Image.*" (DECLARE (IGNORE WIDTH HEIGHT)) (LET* ((SRC-DIMENSIONS (ARRAY-DIMENSIONS SOURCE)) ; (msk-dimensions (ARRAY-DIMENSIONS mask)) (SRC-D1 (CAR SRC-DIMENSIONS)) (SRC-D2 (IF (CADR SRC-DIMENSIONS) (CADR SRC-DIMENSIONS) 0)) ; (msk-d1 (CAR msk-dimensions)) ; (msk-d2 (IF (CADR msk-dimensions) (CADR msk-dimensions) 0)) (RESULT (MAKE-ARRAY SRC-DIMENSIONS))) (LOOP FOR I FROM 0 BELOW SRC-D1 DO (LOOP FOR J FROM 0 BELOW SRC-D2 FOR SRC = (AREF SOURCE I J) FOR MSK = (AREF MASK I J) DO (SETF (AREF RESULT I J) (LOGAND (IF INVERT (LOGNOT SRC) SRC) MSK)))) RESULT)) (DEFUN EXPLORER-STENCIL-PIXELS (SOURCE MASK DEST FG-PIXEL BG-PIXEL) "Return the data for a bitmap made by squishing the SOURCE bitmap data through the MASK bitmap data. SOURCE and MASK should be 2D bit arrays of the same size. DEST should be of the same dimensions as SOURCE and have an element type appropriate for storing the FG and BG pixel values. FG-PIXEL is stored in DEST wherever MASK and SOURCE are both 1. BG-PIXEL is stored in DEST wherever MASK is 1 and SOURCE is 0." (LET* ((SRC-DIMENSIONS (ARRAY-DIMENSIONS SOURCE)) (SRC-D1 (CAR SRC-DIMENSIONS)) (SRC-D2 (CADR SRC-DIMENSIONS))) (LOOP FOR I FROM 0 BELOW SRC-D1 DO (LOOP FOR J FROM 0 BELOW SRC-D2 DO (SETF (AREF DEST I J) (IF (NOT (ZEROP (AREF MASK I J))) (IF (NOT (ZEROP (AREF SOURCE I J))) FG-PIXEL BG-PIXEL) 0))))) DEST) (DEFUN EXPLORER-UNREALIZE-CURSOR (SCREEN CURSOR) "Free up the extra state created by explorer-realize-cursor. All the pixmaps, etc. created by explorer-realize-cursor are destroyed and the private structure is freed." (LET (PRIV ) (IF (EQL CURSOR CURRENT-CURSOR) (EXPLORER-REMOVE-CURSOR) (SETQ CURRENT-CURSOR NIL)) (SETQ PRIV (AREF (CURSOR-RECORD.DEV-PRIVATE CURSOR) (SCREEN.MY-NUMBER SCREEN))) ; (destroy-pixmap (cr-private.source priv)) ; (destroy-pixmap (cr-private.inv-source priv)) ; (destroy-pixmap (cr-private.screen-bits priv)) ; (destroy-pixmap (cr-private.temp priv)) ;;XXX: Deallocate pixels ;;(FREE-GC (CR-PRIVATE.SRC-GC PRIV)) ;;(FREE-GC (CR-PRIVATE.INV-SRC-GC PRIV)) (REMOVE-RESOURCE PRIV))) (DEFUN IS-WORTH-CHECKING (D) (AND (OR (EQ (DRAWABLE.TYPE D) 'WINDOW) (EQ (DRAWABLE.TYPE D) 'PIXMAP)) (WINDOW.REALIZED-P D) (EQL (WINDOW.CLASS D) INPUT-OUTPUT))) (DEFUN EXPLORER-CURSOR-LOC (SCREEN) "If the current cursor is both on and in the given screen, return the Box describing the extent of the cursor. If the cursor is either on a different screen or not currently in the frame buffer, return NIL." (COND ((NULL CURRENT-CURSOR) ;;FIREWALL: Might be called when initially putting down the cursor. NIL) (T (LET* ((DEVICE (LOOKUP-POINTER-DEVICE)) (PRIV (DEVICE.PUBLIC.DEVICE-PRIVATE DEVICE)) (CRPRIV (AREF (CURSOR-RECORD.DEV-PRIVATE CURRENT-CURSOR) (SCREEN.MY-NUMBER SCREEN)))) (IF (AND (EQ (DEVICE.SCREEN PRIV) SCREEN) (EQL (CR-PRIVATE.STATE CRPRIV) CR-IN)) ;;If the cursor is actually on the same screen, stuff the cursor's limits in the given BoxRec. Perhaps this ;;should be done when the cursor is moved? Probably not important... (VALUES (MAKE-BOX :LEFT (CR-PRIVATE.SCREEN-X CRPRIV) :WIDTH (PIXMAP.WIDTH (CR-PRIVATE.SCREEN-BITS CRPRIV)) :TOP (CR-PRIVATE.SCREEN-Y CRPRIV) :HEIGHT (PIXMAP.HEIGHT (CR-PRIVATE.SCREEN-BITS CRPRIV))))))))) (DEFUN ORG-OVERLAP (BOX XORG YORG X Y W H) "Overlap Box, origins, and rectangle." (BOX-OVERLAP BOX (+ X XORG) (+ Y YORG) (+ X XORG W) (+ Y YORG H))) (DEFUN BOX-OVERLAP (BOX X1 Y1 X2 Y2) (AND (<= (BOX.LEFT BOX) X2) (<= X1 (BOX.RIGHT BOX)) (<= (BOX.TOP BOX) Y2) (<= Y1 (BOX.BOTTOM BOX)))) (DEFUN MAYBE-REMOVE-CURSOR (DRAWABLE &optional FORCE) "Called by server graphics functions before reading or writing DRAWABLE. When FORCE is true, remove the cursor if it is anywhere on DRAWABLE's screen. Should only be called within the body of WITH-CURSOR-LOCKED/:SERVER" ;;(SERVER-LOG "~%**MAYBE-REMOVE** LOCK = ~A DRAWABLE = ~A" (CURSOR-RECORD.LOCK CURRENT-CURSOR) DRAWABLE) (LET ((SCREEN (DRAWABLE-TRAIT.SCREEN (DRAWABLE.TRAIT DRAWABLE)))) (WHEN (AND SCREEN CURRENT-CURSOR (CURSOR-RECORD.DEV-PRIVATE CURRENT-CURSOR)) (LET ((CR-PRIV (AREF (CURSOR-RECORD.DEV-PRIVATE CURRENT-CURSOR) (SCREEN.MY-NUMBER SCREEN)))) (COND (FORCE (INDIVISIBLY (WHEN (= (CR-PRIVATE.STATE CR-PRIV) CR-IN) (EXPLORER-REMOVE-CURSOR) T))) (:ELSE (WHEN (AND (= (CR-PRIVATE.STATE CR-PRIV) CR-IN) (WINDOW-P DRAWABLE)) (LET* ((LEFT (WINDOW.ABSOLUTE-X-CORNER DRAWABLE)) (TOP (WINDOW.ABSOLUTE-Y-CORNER DRAWABLE)) (RIGHT (+ LEFT (WINDOW.OUTSIDE-WIDTH DRAWABLE))) (BOTTOM (+ TOP (WINDOW.OUTSIDE-HEIGHT DRAWABLE))) (CURSOR-LEFT (CR-PRIVATE.SCREEN-X CR-PRIV)) (CURSOR-TOP (CR-PRIVATE.SCREEN-Y CR-PRIV)) (CURSOR-RIGHT (+ CURSOR-LEFT (PIXMAP.WIDTH (CR-PRIVATE.SCREEN-BITS CR-PRIV)))) (CURSOR-BOTTOM (+ CURSOR-TOP (PIXMAP.HEIGHT (CR-PRIVATE.SCREEN-BITS CR-PRIV))))) (WHEN (NOT (OR (<= CURSOR-RIGHT LEFT) (<= RIGHT CURSOR-LEFT) (<= CURSOR-BOTTOM TOP) (<= BOTTOM CURSOR-TOP))) ;;(SERVER-LOG " - REMOVED!") (INDIVISIBLY (SETF (CR-PRIVATE.SCREEN-BITS-INVALID CR-PRIV) T) ;; Ensure no one has removed the cursor since first check (WHEN (= (CR-PRIVATE.STATE CR-PRIV) CR-IN) (EXPLORER-REMOVE-CURSOR) T))))))))))) (DEFUN MAYBE-RESTORE-CURSOR () "Called by servers after finished with graphics." (LET* ((MOUSE (LOOKUP-POINTER-DEVICE)) (SCREEN (DEVICE.SCREEN MOUSE)) (CR-PRIV (CR-PRIVATE-FOR-SCREEN CURRENT-CURSOR SCREEN))) ;;(SERVER-LOG "~%**MAYBE-RESTORE** LOCK = ~A" (CURSOR-RECORD.LOCK CURRENT-CURSOR)) ;; Either get exclusive lock on the cursor, or don't restore -- we depend ;; on the other locker to restore cursor when done. (WITH-CURSOR-LOCKED (NIL T) (WHEN (= (CR-PRIVATE.STATE CR-PRIV) CR-OUT) ;;(server-log " - RESTORED!") (EXPLORER-RESTORE-CURSOR))))) ;(DEFUN explorer-get-image (psrc x y w h format planemask pBits) ; "Remove the cursor if it overlaps the image to be gotten." ; (DECLARE (IGNORE pbits)) ; (LET ((client (CAR (global-state.states *globals*))) ; box) ; (IF (is-worth-checking psrc) ; (IF (SETQ box (explorer-cursor-loc (drawable-screen psrc))) ; (IF (org-overlap box (window.absolute-inside-x psrc) ; (window.absolute-inside-y psrc) x y w h) ; (explorer-remove-cursor)))) ; (get-image client format psrc x y w h planemask))) ;??? ;;; The following is clearly non-functioning at this time (DEFUN PUSH-PIXELS (GC BITMAP DEST WIDTH HEIGHT X Y) ;; squeegees the forground color of pGC through pBitMap into pDrawable. ;; pBitMap is a stencil (dx by dy of it is used, it may be bigger) which ;; is placed on the drawable at xOrg, yOrg. Where a 1 bit is set in the ;; bitmap, the fill style is put onto the drawable using the GC's logical ;; function. The drawable is not changed where the bitmap has a zero bit ;; or outside the area covered by the stencil. (DECLARE (TYPE PIXMAP BITMAP DEST)) (LET (;(client (CAR (global-state.states *globals*))) ; (shadow-gc (gcontext.device-private gc)) BOX XORG YORG) ;;Check to see if the cursor needs to be removed (IF (IS-WORTH-CHECKING DEST) (IF (SETQ BOX (EXPLORER-CURSOR-LOC (DRAWABLE-SCREEN DEST))) (PROGN (SETQ XORG (+ (WINDOW.ABSOLUTE-INSIDE-X DEST) X)) (SETQ YORG (+ (WINDOW.ABSOLUTE-INSIDE-Y DEST) Y)) (IF (BOX-OVERLAP BOX XORG YORG (+ XORG WIDTH) (+ YORG HEIGHT)) (EXPLORER-REMOVE-CURSOR))))) ; (compare-gcs gc shadow-gc) ;??? ; (* pShadowGC->PushPixels) (pShadowGC, pBitMap, pDst, w, h, x, y); ; (x-bitblt xalu width height source source-x source-y dest dest-x dest-y) (X-BITBLT (GCONTEXT.ALU GC) WIDTH HEIGHT (PIXMAP.ARRAY BITMAP) 0 0 (PIXMAP.ARRAY DEST) X Y) ))