;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*- ;;; Reason: Don't calculate with a sheet's width/height if they are NIL. Can happen ;;; if the sheet is a screen being resized. ;;; Reason: Make sure the mouse-sheet's width & height are non-null before ;;; trying to glitch the mouse. Prevents mX screen-resizing from ;;; going to cold-load stream complaining about a bad arg to ">". ;;; 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 149149, M/S 2151 ;;; AUSTIN, TEXAS 78714-9149 ;;; ;;; Copyright (C) 1989 Texas Instruments Incorporated. ;;; All rights reserved. ;;; Written 06/15/90 16:52:31 by GRENINGER, ;;; while running on MX56 from band TEST ;;; With SYSTEM 6.41, GC 6.4, VIRTUAL-MEMORY 6.3, MICRONET 6.0, MICRONET-COMM 6.4, ;;; DISK-IO 6.4, DISK-LABEL 6.1, BASIC-PATHNAME 6.5, MAC-PATHNAME 6.0, NETWORK-SUPPORT-COLD 6.2, ;;; BASIC-NAMESPACE 6.8, BASIC-FILE 6.13, RPC 6.2, NFS-MX 6.7, EH 6.8, MAKE-SYSTEM 6.4, ;;; MEMORY-AUX 6.0, COMPILER 6.18, TV 6.26, NVRAM 6.3, UCL 6.0, INPUT-EDITOR 6.0, ;;; MACTOOLBOX 2.25, METER 6.2, ZWEI 6.22, DEBUG-TOOLS 6.5, WINDOW-MX 6.12, PRINTER 6.8, ;;; MAC-PRINTER-TYPES 6.2, CLIPBOARD 6.1, TI-CLOS 6.52, CLEH 6.5, NETWORK-PATHNAME 6.2, ;;; NETWORK-NAMESPACE 6.1, DATALINK 6.0, CHAOSNET 6.8, NETWORK-SUPPORT 6.1, NETWORK-SERVICE 6.3, ;;; DATALINK-DISPLAYS 6.0, MX-DATALINK 6.1, NAMESPACE-EDITOR 6.6, IP 3.65, NFS-MX-SERVER 6.0, ;;; MX-SERIAL 6.1, PRINTER-TYPES 6.2, IMAGEN 6.1, MAIL-DAEMON 6.6, MAIL-READER 6.8, ;;; TELNET 6.1, VT100 6.0, STREAMER-TAPE 6.6, DECNET 1.72, VISIDOC 6.7, PROFILE 6.3, ;;; Experimental BUG 11.19, Experimental CLX 7.0, Experimental CLUE 7.0, Experimental CLIO 1.0, ;;; microcode 191, Band Name: Rel 6.2 internal #!C ; From file MOUSE.LISP#> WINDOW; Sys: #10R TV#: (COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "TV")) (SI:*LISP-MODE* :COMMON-LISP) (*READTABLE* COMMON-LISP-READTABLE) (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*)) (COMPILER#:PATCH-SOURCE-FILE "SYS: WINDOW; MOUSE.#" (DEFUN MOUSE-INPUT (&OPTIONAL (WAIT-FLAG T)) "Wait until mouse moves or a button goes up or down, then report what happened. The values are the delta-x, the delta-y (amounts of mouse motion), buttons-newly-pushed, buttons-newly-raised, and the relevant mouse X and Y (the current position normally, but if any buttons changed, the position then)." ;; Await a change in hardware status from what it was last time (COND (WAIT-FLAG ;; This sleep makes it reasonable for the mouse process to be high priority. ;; It insures that moving the mouse does not lock out lower priority ;; processes for a long time. This constant may want to be tweaked. A ;; value of 1 (1/60 of a second) does not noticably affect mouse response. (PROCESS-SLEEP 1) (PROCESS-WAIT "MOUSE" #'(LAMBDA () (IF (mac-system-p) (lispm-or-mac-mouse-wakeup) (OR MOUSE-WAKEUP MOUSE-RECONSIDER)))))) ;; Set some global variables used for mouse transport. CJJ 05/06/88. ;; Added by KJF for CJJ on 08/16/88 for Multiple Monitor (MMON) support. (SETF *unglitched-mouse-x-speed* mouse-x-speed *unglitched-mouse-y-speed* mouse-y-speed ;; Remember previous mouse position for mouse transport along mouse trajectory. CJJ 08/15/88. *previous-unglitched-mouse-x* *unglitched-mouse-x* *previous-unglitched-mouse-y* *unglitched-mouse-y* *unglitched-mouse-x* mouse-x *unglitched-mouse-y* mouse-y) ;; Clear wakeup flag unless there are buffered mouse button transitions, since we ;; might not read all of them before calling MOUSE-INPUT again. (SETQ MOUSE-WAKEUP (NOT (= MOUSE-BUTTONS-BUFFER-IN-INDEX MOUSE-BUTTONS-BUFFER-OUT-INDEX))) ;; Compute delta-X and delta-Y in screen coordinates (LET ((DELTA-X (- MOUSE-X MOUSE-LAST-X)) (DELTA-Y (- MOUSE-Y MOUSE-LAST-Y)) (GLITCH-X NIL) (GLITCH-Y NIL) NEW-BUTTONS CHANGED-BUTTONS) (INCF MOUSE-LAST-X DELTA-X) (INCF MOUSE-LAST-Y DELTA-Y) ;; Compute change in button status (MULTIPLE-VALUE-SETQ (NEW-BUTTONS MOUSE-LAST-BUTTONS-TIME MOUSE-LAST-BUTTONS-X MOUSE-LAST-BUTTONS-Y) (MOUSE-BUTTONS)) (SETQ CHANGED-BUTTONS (LOGXOR NEW-BUTTONS MOUSE-LAST-BUTTONS) MOUSE-LAST-BUTTONS NEW-BUTTONS) ;; Force blinker to stay within mouse-sheet. If the mouse moves during this ;; computation, it will glitch back. So we only SETQ the variables ;; if the mouse position actually needs to be changed, rather than using ;; MAX and MIN which would be more readable. (when (and (sheet-width mouse-sheet) (sheet-height mouse-sheet)) (IF (> 0 MOUSE-X) (SETQ GLITCH-X 0)) (IF (<= (SHEET-WIDTH MOUSE-SHEET) MOUSE-X) (SETQ GLITCH-X (1- (SHEET-WIDTH MOUSE-SHEET)))) (IF (> 0 MOUSE-Y) (SETQ GLITCH-Y 0)) (IF (<= (SHEET-HEIGHT MOUSE-SHEET) MOUSE-Y) (SETQ GLITCH-Y (1- (SHEET-HEIGHT MOUSE-SHEET)))) ;; If mouse blinker needs to be glitched, do so (IF (OR GLITCH-X GLITCH-Y) (WITHOUT-INTERRUPTS (%OPEN-MOUSE-CURSOR) (IF GLITCH-X (SETQ MOUSE-LAST-X (SETQ MOUSE-X GLITCH-X))) (IF GLITCH-Y (SETQ MOUSE-LAST-Y (SETQ MOUSE-Y GLITCH-Y))) (SETQ MOUSE-CURSOR-STATE MOUSE-CURSOR-CLOSED-STATE PREPARED-SHEET NIL)))) (VALUES DELTA-X DELTA-Y (LOGAND NEW-BUTTONS CHANGED-BUTTONS) (BOOLE 2 NEW-BUTTONS CHANGED-BUTTONS) ;BOOLE 2 is ANDCA (IF (ZEROP CHANGED-BUTTONS) MOUSE-LAST-X MOUSE-LAST-BUTTONS-X) (IF (ZEROP CHANGED-BUTTONS) MOUSE-LAST-Y MOUSE-LAST-BUTTONS-Y)))) )) #!C ; From file BLINKERS.LISP#> WINDOW; SYS: #10R TV#: (COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "TV")) (SI:*LISP-MODE* :COMMON-LISP) (*READTABLE* COMMON-LISP-READTABLE) (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*)) (COMPILER#:PATCH-SOURCE-FILE "SYS: WINDOW; BLINKERS.#" (DEFMETHOD (BLINKER :SET-CURSORPOS) (X Y &AUX (OLD-PHASE PHASE)) "Set the position of a blinker relative to the sheet it is on. Args in terms of raster units. If blinker was following cursor, it will no longer be doing so." (WITH-BLINKER-READY T ;; Handle range checking for X and Y. (SETf X (+ (MAX (FLOOR X) 0) (SHEET-INSIDE-LEFT SHEET))) (when (sheet-width sheet) (setf x (min x (SHEET-INSIDE-RIGHT SHEET)))) (setf Y (MIN (+ (MAX (FLOOR Y) 0) (SHEET-INSIDE-TOP SHEET)))) (when (sheet-height sheet) (setf y (min y (SHEET-INSIDE-BOTTOM SHEET)))) (COND ( ;; Don't open if visibility NIL (especially the mouse cursor!) (NULL VISIBILITY) (SETQ X-POS X Y-POS Y FOLLOW-P NIL)) ((OR (NEQ X X-POS) ;Only blink if actually moving blinker (NEQ Y Y-POS)) (OPEN-BLINKER SELF) (SETQ X-POS X Y-POS Y FOLLOW-P NIL TIME-UNTIL-BLINK 0) ;; If this is the mouse blinker, and it is not being tracked ;; by microcode, then it is important to turn it back on ;; immediately. (AND (NEQ VISIBILITY :BLINK) OLD-PHASE (BLINK SELF)))))) ))