(FILECREATED "14-Aug-85 13:13:29" {ERIS}<LISPCORE>SOURCES>LLKEY.;60 100920
changes to: (VARS LLKEYCOMS)
previous date: "13-Aug-85 18:59:44" {ERIS}<LISPCORE>SOURCES>LLKEY.;59)
(* Copyright (c) 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT LLKEYCOMS)
(RPAQQ LLKEYCOMS [(COMS (* Access to keyboard)
(FNS BKSYSCHARCODE \CLEARSYSBUF \GETKEY \INTCHAR \NSYSBUFCHARS \SAVESYSBUF
\SYSBUFP \GETSYSBUF \PUTSYSBUF \PEEKSYSBUF)
(INITVARS (\LONGSYSBUF))
(INITVARS (\\KEYBOARDWAITBOX.GLOBALRESOURCE))
(DECLARE: DONTCOPY (RESOURCES \KEYBOARDWAITBOX))
(DECLARE: DONTCOPY (CONSTANTS (\SYSBUFSIZE 200))
(MACROS \GETREALSYSBUF)))
[DECLARE: DOCOPY DONTEVAL@LOAD (COMS (* Here because it must be done in init before PROC
loaded)
(P (MOVD? (QUOTE NILL)
(QUOTE CARET]
(COMS (* Key handler)
(FNS \KEYBOARDINIT \KEYBOARDEVENTFN \ALLOCLOCKED \SETIOPOINTERS \KEYBOARDOFF
\KEYBOARDON \KEYHANDLER \KEYHANDLER1 \RESETKEYBOARD \DOMOUSETRANSITIONS
\DOTRANSITIONS \DECODETRANSITION MOUSECHORDWAIT \TRACKCURSOR)
(INITVARS (\MOUSECHORDTICKS)
(\MOUSECHORDMILLISECONDS 50))
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\KEYBOARDINIT)))
[DECLARE: DONTCOPY (MACROS .NOTELASTUSERACTION)
(CONSTANTS ALLUP \CTRLMASK \METABIT)
(CONSTANTS * DLMOUSEBITS)
(CONSTANTS * DLMOUSESTATES)
(CONSTANTS * TRANSITIONFLAGS)
(MACROS \TRANSINDEX ARMEDCODE TRANSITIONSHIFTCODE TRANSITIONCODE
TRANSITIONFLAGS)
(EXPORT (RECORDS KEYACTION)
(CONSTANTS \NKEYS))
(RECORDS RING)
(COMS (* can get rid of shiftstate after clients have been fixed)
(RECORDS SHIFTSTATE)
(GLOBALVARS \SHIFTSTATE \MOUSETIMERTEMP))
(CONSTANTS NRINGINDEXWORDS)
(CONSTANTS (\SYSBUFFER.FIRST (UNFOLD NRINGINDEXWORDS BYTESPERWORD))
(\SYSBUFFER.LAST (IPLUS \SYSBUFFER.FIRST (SUB1 \SYSBUFSIZE]
(DECLARE: EVAL@COMPILE (VARS \KEYNAMES))
(VARS \ORIGKEYACTIONS \DLIONKEYACTIONS \DORADOKEYACTIONS \DOVEKEYACTIONS)
(INITVARS (\KEYBOARD.META 128)
(\MODIFIED.KEYACTIONS))
(GLOBALVARS \SYSBUFFER \LONGSYSBUF \INTERRUPTSTATE \MODIFIED.KEYACTIONS \RCLKSECOND
\LASTUSERACTION \MOUSECHORDTICKS \LASTKEYSTATE \KEYBOARDEVENTQUEUE
\KEYBUFFERING \CURRENTKEYACTION \DEFAULTKEYACTION \COLORCURSORHEIGHT
SCREENWIDTH SCREENHEIGHT \TIMER.INTERRUPT.PENDING \ORIGKEYACTIONS
\KEYBOARD.META \MOUSECHORDMILLISECONDS \DORADOKEYACTIONS \DLIONKEYACTIONS
\DOVEKEYACTIONS))
(COMS (* Key interpretation)
(FNS KEYACTION KEYACTIONTABLE \KEYACTION1 KEYDOWNP \KEYNAMETONUMBER MODIFY.KEYACTIONS
METASHIFT SHIFTDOWNP)
(MACROS \KEYNAMETONUMBER \TEMPCOPYTIMER)
(EXPORT (MACROS XKEYDOWNP KEYDOWNP KEYDOWNP1 \NEWKEYDOWNP)))
[COMS (FNS \SHOWCOLORCURSOR)
(INITVARS (\COLORCURSORBM)
(\COLORCURSORDOWN)
(\ColorCursorBBT)
(\COLORCURSOR))
(EXPORT (MACROS COLORNUMBERBITSPERPIXEL \BITADDRESSOFPIXEL .TAKE.DOWN.COLOR.CURSOR)
(CONSTANTS (COLORSCREENWIDTH 640)
(COLORSCREENHEIGHT 480]
(COMS (* A raw keyboard device/stream)
(FNS \INIT.KEYBOARD.STREAM)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\INIT.KEYBOARD.STREAM)))
(EXPORT (GLOBALVARS \KEYBOARD.DEVICE \KEYBOARD.STREAM)))
(COMS (* Hook for a periodic interrupt)
(FNS \DOBUFFEREDTRANSITIONS \TIMER.INTERRUPTFRAME \PERIODIC.INTERRUPTFRAME)
(INITVARS (\KEYBUFFERING)
(\PERIODIC.INTERRUPT)
(\TIMER.INTERRUPT.PENDING)
(\PERIODIC.INTERRUPT.FREQUENCY 77)))
(LOCALVARS . T)
[COMS (* cursor and mouse related functions.)
(FNS ADJUSTCURSORPOSITION CREATEPOSITION CURSOR CURSORCREATE CURSORHOTSPOT
CURSORPOSITION \SETCURSORPOSITION FLIPCURSOR FLIPCURSORBAR LASTMOUSEX LASTMOUSEY
POSITIONP SETCURSOR)
(FNS GETMOUSESTATE \EVENTKEYS)
[EXPORT (CONSTANTS (CURSORHEIGHT 16)
(CURSORWIDTH 16))
(DECLARE: EVAL@COMPILE (ADDVARS (GLOBALVARS LASTMOUSEX LASTMOUSEY
LASTMOUSEBUTTONS LASTMOUSETIME
LASTKEYBOARD]
(INITVARS (\MOUSEHOTSPOTX 0)
(\MOUSEHOTSPOTY 15))
(GLOBALVARS \MOUSEHOTSPOTX \MOUSEHOTSPOTY \MOUSETIMEBOX \COLORCURSOR)
(DECLARE: DONTCOPY (EXPORT (MACROS \SETMOUSEXY))
(MACROS \XMOUSECOORD \YMOUSECOORD))
[DECLARE: DONTEVAL@LOAD DOCOPY (VARS (\SFPosition (CREATEPOSITION]
(DECLARE: DOEVAL@COMPILE (VARS (SCREENHEIGHT 808]
[COMS (DECLARE: DONTCOPY (RECORDS KEYBOARDEVENT)
(CONSTANTS (\KEYBOARDEVENT.FIRST NRINGINDEXWORDS)
\KEYBOARDEVENT.SIZE
(\KEYBOARDEVENT.LAST (PLUS \KEYBOARDEVENT.FIRST (TIMES
\KEYBOARDEVENT.SIZE 383]
(COMS (FNS MACHINETYPE SETMAINTPANEL)
(* DLion beeper)
(FNS BEEPON BEEPOFF))
(EXPORT (GLOBALVARS \EM.MOUSEX \EM.MOUSEY \EM.CURSORX \EM.CURSORY \EM.UTILIN \EM.REALUTILIN
\EM.KBDAD0 \EM.KBDAD1 \EM.KBDAD2 \EM.KBDAD3 \EM.KBDAD4 \EM.KBDAD5
\EM.DISPINTERRUPT \EM.DISPLAYHEAD \EM.CURSORBITMAP \MACHINETYPE
\COLORCURSORBM \COLORCURSOR \COLORCURSORDOWN \ColorCursorBBT
\COLORCURSORWIDTH \COLORSCREENCURSORLINEBASE \COLORSCREENCURSORLINE
\COLORCURSORBASE \COLORSCREENWIDTHINBITS \COLORSCREENRASTERWIDTH
\COLORCURSORRASTERWIDTH \DEFAULTKEYACTION \CURRENTKEYACTION
\PERIODIC.INTERRUPT \PERIODIC.INTERRUPT.FREQUENCY))
(FNS WITHOUT-INTERRUPTS)
(COMS (* Compile locked fns together for locality)
(BLOCKS (NIL FLIPCURSORBAR \KEYHANDLER \KEYHANDLER1 \TRACKCURSOR
\PERIODIC.INTERRUPTFRAME \TIMER.INTERRUPTFRAME \DOBUFFEREDTRANSITIONS
\DOTRANSITIONS \DOMOUSETRANSITIONS \DECODETRANSITION \EVENTKEYS)))
[DECLARE: DONTCOPY
(ADDVARS [INEWCOMS (ALLOCAL (ADDVARS (LOCKEDFNS \KEYHANDLER \KEYHANDLER1
\CONTEXTAPPLY \LOCKPAGES \SMASHLINK
\INCUSECOUNT LLSH \MAKEFREEBLOCK
\DECUSECOUNT \MAKENUMBER \ADDBASE
\PERIODIC.INTERRUPTFRAME
\DOBUFFEREDTRANSITIONS
\TIMER.INTERRUPTFRAME \TRACKCURSOR
FLIPCURSORBAR)
(LOCKEDVARS \InterfacePage \MOUSEHOTSPOTX
\MOUSEHOTSPOTY \PENDINGINTERRUPT
\COLORCURSORBM \COLORCURSORDOWN
\COLORDISPLAYBITSPERPIXEL
\ColorCursorBBT \COLORCURSORWIDTH
\COLORSCREENCURSORLINE
\COLORSCREENCURSORLINEBASE
\COLORCURSORBASE
\COLORSCREENWIDTHINBITS
\COLORSCREENRASTERWIDTH
\COLORCURSORRASTERWIDTH
\PERIODIC.INTERRUPT
\PERIODIC.INTERRUPT.FREQUENCY
\LASTUSERACTION \MOUSECHORDTICKS
\KEYBOARDEVENTQUEUE \KEYBUFFERING
SCREENWIDTH SCREENHEIGHT
\TIMER.INTERRUPT.PENDING
\EM.MOUSEX \EM.MOUSEY \EM.CURSORX
\EM.CURSORY \EM.UTILIN
\EM.REALUTILIN \EM.KBDAD0
\EM.KBDAD1 \EM.KBDAD2 \EM.KBDAD3
\EM.DISPINTERRUPT \EM.CURSORBITMAP
\EM.KBDAD4 \EM.KBDAD5 \MISCSTATS
\RCLKSECOND]
(RDCOMS (FNS \SETIOPOINTERS]
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML
WITHOUT-INTERRUPTS)
(LAMA METASHIFT
MOUSECHORDWAIT])
(* Access to keyboard)
(DEFINEQ
(BKSYSCHARCODE
[LAMBDA (CHAR) (* rrb "30-Dec-83 11:56")
(OR (\PUTSYSBUF CHAR)
(PROGN (SETQ \LONGSYSBUF (NCONC \LONGSYSBUF (bind C while (SETQ C (\GETREALSYSBUF))
collect C)))
(\PUTSYSBUF CHAR])
(\CLEARSYSBUF
[LAMBDA (ALLFLG) (* mpl "27-Jun-85 20:04")
(DECLARE (GLOBALVARS \PROCESSES))
(COND
((OR ALLFLG (TTY.PROCESSP))
(SETQ \LONGSYSBUF)
(replace (RING READ) of \SYSBUFFER with 0)))
(COND
(ALLFLG (for PROC in \PROCESSES do (replace PROCTYPEAHEAD of PROC with NIL)))
((THIS.PROCESS)
(replace PROCTYPEAHEAD of (THIS.PROCESS) with NIL])
(\GETKEY
[LAMBDA NIL (* lmm "18-Apr-85 00:07")
(DECLARE (GLOBALVARS \KEYBOARDWAIT1 \KEYBOARDWAIT2))
(COND
[(AND (THIS.PROCESS)
(fetch PROCTYPEAHEAD of (THIS.PROCESS)))
(pop (fetch PROCTYPEAHEAD of (THIS.PROCESS]
(T (WAIT.FOR.TTY)
(OR (\GETSYSBUF)
(GLOBALRESOURCE (\KEYBOARDWAITBOX) (* Busy-wait loop that gets next character)
(\CLOCK0 \KEYBOARDWAITBOX)
(bind C
do (COND
((SETQ C (\GETSYSBUF))
(\BOXIPLUS (LOCF (fetch KEYBOARDWAITTIME of \MISCSTATS))
(CLOCKDIFFERENCE \KEYBOARDWAITBOX))
(RETURN C)))
(\TTYBACKGROUND)
(\WAIT.FOR.TTY])
(\INTCHAR
[LAMBDA (CODE FLAG TABLE) (* lmm "21-Apr-85 15:48")
(* sets the bit which says that character CODE is armed
as an interrupt)
(OR TABLE (SETQ TABLE \DEFAULTKEYACTION))
(OR (\THINCHARCODEP CODE)
(ERROR "CHARACTER NOT IN CHARSET 0" CODE))
(PROG1 (NEQ 0 (ARMEDCODE TABLE CODE))
(change (ARMEDCODE TABLE CODE)
(if FLAG
then 1
else 0])
(\NSYSBUFCHARS
[LAMBDA NIL (* JonL " 7-May-84 01:50")
(* Tells how many characters can be \GETSYSBUFed.
Used by \SAVESYSBUF.)
(IPLUS (LENGTH \LONGSYSBUF)
(PROG ((R (fetch (RING READ) of \SYSBUFFER))
(W (fetch (RING WRITE) of \SYSBUFFER)))
(RETURN (COND
((EQ 0 R)
0)
((IGREATERP W R)
(IDIFFERENCE W R))
(T (IDIFFERENCE W (IDIFFERENCE R \SYSBUFSIZE])
(\SAVESYSBUF
[LAMBDA NIL (* JonL " 7-May-84 01:50")
(DECLARE (GLOBALVARS \SAVEDSYSBUFFER))
(PROG (TA (BUF \SAVEDSYSBUFFER)
(NC (\NSYSBUFCHARS))
(J 0))
[COND
((TTY.PROCESSP)
[COND
([AND (THIS.PROCESS)
(SETQ TA (fetch PROCTYPEAHEAD of (THIS.PROCESS]
(replace PROCTYPEAHEAD of (THIS.PROCESS) with NIL)
(add NC (LENGTH TA))
[COND
((IGREATERP NC (NCHARS BUF))
(SETQ BUF (ALLOCSTRING NC]
(for CH in TA do (RPLCHARCODE BUF (add J 1)
CH)))
((IGREATERP NC (NCHARS BUF))
(SETQ BUF (ALLOCSTRING NC]
(for I from (ADD1 J) to NC
do
(* Test on J means that we'll ignore extra chars typed since we got the length. Test on \GETSYSBUF so we don't get
screwed if buffer gets cleared while during this loop)
(RPLCHARCODE BUF I (OR (\GETSYSBUF)
(PROGN (SETQ NC (SUB1 I))
(RETURN]
(RETURN (AND (NOT (EQ 0 NC))
(SUBSTRING BUF 1 NC])
(\SYSBUFP
[LAMBDA NIL (* JonL " 7-May-84 01:52")
(OR [AND (TTY.PROCESSP)
(OR \LONGSYSBUF (NOT (EQ 0 (fetch (RING READ) of \SYSBUFFER]
(AND (THIS.PROCESS)
(fetch PROCTYPEAHEAD of (THIS.PROCESS])
(\GETSYSBUF
[LAMBDA NIL (* lmm " 9-JUL-83 00:56")
(OR (AND \LONGSYSBUF (pop \LONGSYSBUF))
(\GETREALSYSBUF])
(\PUTSYSBUF
[LAMBDA (CHAR) (* rmk: "27-Nov-84 17:51")
(PROG ((R (fetch (RING READ) of \SYSBUFFER))
(W (fetch (RING WRITE) of \SYSBUFFER)))
(RETURN (COND
((EQ R W) (* Full)
NIL)
(T (\PUTBASEFAT \SYSBUFFER W CHAR)
(AND (EQ 0 R)
(replace (RING READ) of \SYSBUFFER with W))
(* Return random non-NIL value to indicate success for
BKSYSBUF)
[replace (RING WRITE) of \SYSBUFFER with (COND
((EQ \SYSBUFFER.LAST W)
\SYSBUFFER.FIRST)
(T (ADD1 W]
T])
(\PEEKSYSBUF
[LAMBDA (STREAM) (* bvm: " 8-Feb-85 17:50")
(PROG (R)
WAIT(until (\SYSBUFP) do (BLOCK))
(RETURN (if (TTY.PROCESSP)
then (if \LONGSYSBUF
then (CAR \LONGSYSBUF)
elseif (NEQ (SETQ R (fetch (RING READ) of \SYSBUFFER))
0)
then (* Here's the vanilla case)
(\GETBASEFAT \SYSBUFFER R)
else (* Foo an interrupt could have sneaked in here and
gobbled down the remaining characters)
(GO WAIT))
elseif (THIS.PROCESS)
then (CAR (fetch PROCTYPEAHEAD of (THIS.PROCESS)))
else (SHOULDNT])
)
(RPAQ? \LONGSYSBUF )
(RPAQ? \\KEYBOARDWAITBOX.GLOBALRESOURCE )
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
[PUTDEF (QUOTE \KEYBOARDWAITBOX)
(QUOTE RESOURCES)
(QUOTE (NEW (CREATECELL \FIXP]
)
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ \SYSBUFSIZE 200)
(CONSTANTS (\SYSBUFSIZE 200))
)
(DECLARE: EVAL@COMPILE
[PUTPROPS \GETREALSYSBUF MACRO
(NIL (PROG ((R (fetch (RING READ)
of \SYSBUFFER)))
(RETURN (AND (NOT (EQ 0 R))
(PROG1 (\GETBASEFAT \SYSBUFFER R)
(AND [EQ (fetch (RING WRITE)
of \SYSBUFFER)
(replace (RING READ)
of \SYSBUFFER with (COND
((EQ \SYSBUFFER.LAST R)
\SYSBUFFER.FIRST)
(T (ADD1 R]
(replace (RING READ)
of \SYSBUFFER with 0]
)
)
(DECLARE: DOCOPY DONTEVAL@LOAD
(* Here because it must be done in init before PROC loaded)
(MOVD? (QUOTE NILL)
(QUOTE CARET))
)
(* Key handler)
(DEFINEQ
(\KEYBOARDINIT
[LAMBDA NIL (* lmm "23-May-85 15:57")
(DECLARE (GLOBALVARS \SAVEDSYSBUFFER)) (* Sets up keyboard decoding tables.)
(SETQ \CURRENTKEYACTION (SETQ \DEFAULTKEYACTION (create KEYACTION)))
(for X in \ORIGKEYACTIONS do (KEYACTION (CAR X)
(CDR X)))
(SETQ \INTERRUPTSTATE (\ALLOCLOCKED 2))
(PROGN (SETQ \SYSBUFFER (\ALLOCBLOCK (FOLDHI (ADD1 \SYSBUFFER.LAST)
WORDSPERCELL)))
(replace (RING READ) of \SYSBUFFER with 0)
(replace (RING WRITE) of \SYSBUFFER with \SYSBUFFER.FIRST))
(SETQ \SAVEDSYSBUFFER (ALLOCSTRING \SYSBUFSIZE NIL NIL T))
(SETQ \LASTUSERACTION (LOCF (fetch LASTUSERACTION of \MISCSTATS)))
(PROGN (SETQ \KEYBOARDEVENTQUEUE (\ALLOCLOCKED (FOLDHI (PLUS \KEYBOARDEVENT.LAST
\KEYBOARDEVENT.SIZE)
WORDSPERCELL)))
(replace (RING READ) of \KEYBOARDEVENTQUEUE with 0)
(replace (RING WRITE) of \KEYBOARDEVENTQUEUE with \KEYBOARDEVENT.FIRST))
(SETQ \LASTKEYSTATE (create KEYBOARDEVENT))
(SETQ \SHIFTSTATE (create SHIFTSTATE))
(SETQ \MOUSETIMERTEMP (SETUPTIMER 0 NIL (QUOTE TICKS)))
(MOUSECHORDWAIT \MOUSECHORDMILLISECONDS)
(\KEYBOARDON])
(\KEYBOARDEVENTFN
[LAMBDA (FDEV EVENT EXTRA) (* mpl "20-Jul-85 22:30")
(DECLARE (GLOBALVARS \KEYBOARD.BEFORETYPE \DORADOKEYACTIONS \DLIONKEYACTIONS))
(SELECTQ EVENT
((BEFORELOGOUT BEFOREMAKESYS BEFORESYSOUT BEFORESAVEVM)
(SETQ \KEYBOARD.BEFORETYPE \MACHINETYPE))
[(AFTERLOGOUT AFTERMAKESYS AFTERSYSOUT AFTERSAVEVM)
(if (NEQ \MACHINETYPE \KEYBOARD.BEFORETYPE)
then (for X in (SELECTC \MACHINETYPE
(\DORADO \DORADOKEYACTIONS)
(\DANDELION \DLIONKEYACTIONS)
(\DAYBREAK \DOVEKEYACTIONS)
NIL)
do (KEYACTION (CAR X)
(CDR X)
\DEFAULTKEYACTION))
(MOUSECHORDWAIT (MOUSECHORDWAIT]
((AFTERDOSAVEVM AFTERDOMAKESYS)
NIL)
NIL])
(\ALLOCLOCKED
[LAMBDA (NCELLS) (* lmm "20-Apr-85 13:08")
(* allocate a block of NCELLS cells and lock it)
(PROG [(BLOCK (\ALLOCBLOCK NCELLS NIL (IMIN NCELLS CELLSPERPAGE]
(\LOCKCELL BLOCK (FOLDHI (IPLUS (fetch (POINTER WORDINPAGE) of BLOCK)
(UNFOLD NCELLS WORDSPERCELL))
WORDSPERPAGE))
(RETURN BLOCK])
(\SETIOPOINTERS
[LAMBDA NIL (* mpl "20-Jul-85 21:44")
(SELECTC (SETTOPVAL (QUOTE \MACHINETYPE)
(fetch MachineType of \InterfacePage))
((LIST \DOLPHIN \DORADO)
(SETTOPVAL (QUOTE \EM.MOUSEX)
(EMADDRESS MOUSEX.EM))
(SETTOPVAL (QUOTE \EM.MOUSEY)
(EMADDRESS MOUSEY.EM))
(SETTOPVAL (QUOTE \EM.CURSORX)
(EMADDRESS CURSORX.EM))
(SETTOPVAL (QUOTE \EM.CURSORY)
(EMADDRESS CURSORY.EM))
(PROGN (SETTOPVAL (QUOTE \EM.REALUTILIN)
(EMADDRESS UTILIN.EM))
(SETTOPVAL (QUOTE \EM.UTILIN)
(EMADDRESS UTILIN.EM)))
(SETTOPVAL (QUOTE \EM.KBDAD0)
(EMADDRESS KBDAD0.EM))
(SETTOPVAL (QUOTE \EM.KBDAD1)
(EMADDRESS KBDAD1.EM))
(SETTOPVAL (QUOTE \EM.KBDAD2)
(EMADDRESS KBDAD2.EM))
(SETTOPVAL (QUOTE \EM.KBDAD3)
(EMADDRESS KBDAD3.EM))
(SETTOPVAL (QUOTE \EM.KBDAD4)
(LOCF (fetch FAKEKBDAD4 of \InterfacePage)))
(\PUTBASE \EM.KBDAD4 0 ALLUP)
(SETTOPVAL (QUOTE \EM.KBDAD5)
(LOCF (fetch FAKEKBDAD5 OF \InterfacePage)))
(\PUTBASE \EM.KBDAD5 0 ALLUP)
(SETTOPVAL (QUOTE \EM.DISPINTERRUPT)
(EMADDRESS DISPINTERRUPT.EM))
(SETTOPVAL (QUOTE \EM.CURSORBITMAP)
(EMADDRESS CURSORBITMAP.EM))
(SETTOPVAL (QUOTE \EM.DISPLAYHEAD)
(EMADDRESS DCB.EM))
(SETTOPVAL (QUOTE SCREENWIDTH)
(UNFOLD (fetch ScreenWidth of \InterfacePage)
BITSPERWORD)))
(\DANDELION (SETTOPVAL (QUOTE \EM.MOUSEX)
(fetch DLMOUSEXPTR of \IOPAGE))
(SETTOPVAL (QUOTE \EM.MOUSEY)
(fetch DLMOUSEYPTR of \IOPAGE))
(SETTOPVAL (QUOTE \EM.CURSORX)
(fetch DLCURSORXPTR of \IOPAGE))
(SETTOPVAL (QUOTE \EM.CURSORY)
(fetch DLCURSORYPTR of \IOPAGE))
[PROGN (SETTOPVAL (QUOTE \EM.REALUTILIN)
(fetch DLUTILINPTR of \IOPAGE))
(* Where the hardware bits live, vs.
where the Lisp software sees them after
reinterpretation by keyhandler)
(SETTOPVAL (QUOTE \EM.UTILIN)
(LOCF (fetch (IFPAGE FAKEMOUSEBITS) of \InterfacePage]
(SETTOPVAL (QUOTE \EM.KBDAD0)
(fetch DLKBDAD0PTR of \IOPAGE))
(SETTOPVAL (QUOTE \EM.KBDAD1)
(fetch DLKBDAD1PTR of \IOPAGE))
(SETTOPVAL (QUOTE \EM.KBDAD2)
(fetch DLKBDAD2PTR of \IOPAGE))
(SETTOPVAL (QUOTE \EM.KBDAD3)
(fetch DLKBDAD3PTR of \IOPAGE))
(SETTOPVAL (QUOTE \EM.KBDAD4)
(fetch DLKBDAD4PTR of \IOPAGE))
(SETTOPVAL (QUOTE \EM.KBDAD5)
(fetch DLKBDAD5PTR of \IOPAGE))
(SETTOPVAL (QUOTE \EM.DISPINTERRUPT)
(fetch DLDISPINTERRUPTPTR of \IOPAGE))
(SETTOPVAL (QUOTE \EM.CURSORBITMAP)
(fetch DLCURSORBITMAPPTR of \IOPAGE))
(SETTOPVAL (QUOTE \EM.DISPLAYHEAD)
NIL)
(SETTOPVAL (QUOTE SCREENWIDTH)
1024))
[\DAYBREAK (PROG ((KBDBASE (\DoveMisc.GetKBDBase)))
(SETTOPVAL (QUOTE \EM.KBDAD0)
(\ADDBASE KBDBASE 1))
(SETTOPVAL (QUOTE \EM.KBDAD1)
(\ADDBASE KBDBASE 2))
(SETTOPVAL (QUOTE \EM.KBDAD2)
(\ADDBASE KBDBASE 3))
(SETTOPVAL (QUOTE \EM.KBDAD3)
(\ADDBASE KBDBASE 4))
(SETTOPVAL (QUOTE \EM.KBDAD4)
(\ADDBASE KBDBASE 5))
(SETTOPVAL (QUOTE \EM.KBDAD5)
(\ADDBASE KBDBASE 6))
(SETTOPVAL (QUOTE \EM.MOUSEX)
(\DoveMisc.GetMouseXBase))
(SETTOPVAL (QUOTE \EM.MOUSEY)
(\DoveMisc.GetMouseYBase))
(SETTOPVAL (QUOTE \EM.CURSORBITMAP)
(\DoveDisplay.GetCursorBitmapBase))
(* These three set this way to prevent address faults)
(SETTOPVAL (QUOTE \EM.DISPINTERRUPT)
(fetch DLDISPINTERRUPTPTR of \IOPAGE))
(SETTOPVAL (QUOTE \EM.CURSORX)
(fetch DLCURSORXPTR of \IOPAGE))
(SETTOPVAL (QUOTE \EM.CURSORY)
(fetch DLCURSORYPTR of \IOPAGE))
[PROGN (SETTOPVAL (QUOTE \EM.REALUTILIN)
KBDBASE) (* Where the hardware bits live, vs.
where the Lisp software sees them after
reinterpretation by keyhandler)
(SETTOPVAL (QUOTE \EM.UTILIN)
(LOCF (fetch (IFPAGE FAKEMOUSEBITS) of \InterfacePage]
(SETTOPVAL (QUOTE SCREENWIDTH)
(\DoveDisplay.ScreenWidth]
(RAID])
(\KEYBOARDOFF
[LAMBDA NIL (* lmm "30-MAR-83 20:40")
(\PUTBASE \EM.DISPINTERRUPT 0 (LOGAND (LOGXOR 65535 \LispKeyMask)
(\GETBASE \EM.DISPINTERRUPT 0])
(\KEYBOARDON
[LAMBDA (NOCHECK) (* lmm "30-MAR-83 20:39")
(\SETIOPOINTERS)
(\PUTBASE \EM.DISPINTERRUPT 0 (LOGOR \LispKeyMask (\GETBASE \EM.DISPINTERRUPT 0])
(\KEYHANDLER
[LAMBDA NIL (* lmm "30-MAR-83 20:40")
(\KEYHANDLER1])
(\KEYHANDLER1
[LAMBDA NIL (* bvm: " 8-Jul-85 17:39")
(PROG ((OLD0 ALLUP)
(OLD1 ALLUP)
(OLD2 ALLUP)
(OLD3 ALLUP)
(OLD4 ALLUP)
(OLD5 ALLUP)
(OLDU ALLUP)
(LOOPCNT 10)
(PERIODCNT 60)
CURSORX CURSORY YHOT)
(SETQ \KEYBUFFERING NIL)
(replace (RING READ) of \KEYBOARDEVENTQUEUE with 0)
LP (\CONTEXTSWITCH \KbdFXP)
[COND
(\PERIODIC.INTERRUPT (* eventually can be replaced with general timer
mechanism)
(COND
((IGREATERP PERIODCNT 0)
(* Continue counting down to zero)
(SETQ PERIODCNT (SUB1 PERIODCNT)))
((\CAUSEINTERRUPT \KbdFXP (FUNCTION \PERIODIC.INTERRUPTFRAME))
(* When we've counted down, then keep trying to cause
the interrupt, and reset the counter when it finally
happens)
(SETQ PERIODCNT (SUB1 (OR \PERIODIC.INTERRUPT.FREQUENCY 1]
[if (OR (NEQ (\GETBASE \EM.MOUSEX 0)
CURSORX)
(NEQ (\GETBASE \EM.MOUSEY 0)
CURSORY))
then (\TRACKCURSOR (SETQ CURSORX (\GETBASE \EM.MOUSEX 0))
(SETQ CURSORY (\GETBASE \EM.MOUSEY 0]
(if (OR (NEQ OLD0 (\GETBASE \EM.KBDAD0 0))
(NEQ OLD1 (\GETBASE \EM.KBDAD1 0))
(NEQ OLD2 (\GETBASE \EM.KBDAD2 0))
(NEQ OLD3 (\GETBASE \EM.KBDAD3 0))
(NEQ OLD4 (\GETBASE \EM.KBDAD4 0))
(NEQ OLD5 (\GETBASE \EM.KBDAD5 0))
(NEQ OLDU (\GETBASE \EM.REALUTILIN 0)))
then (if (EQ 0 (LOGAND (\GETBASE \EM.KBDAD2 0)
2114))
then (* Ctrl-shift-DEL panic interrupt -- switch to TeleRaid
immediately)
(swap (fetch (IFPAGE TELERAIDFXP) of \InterfacePage)
(fetch (IFPAGE KbdFXP) of \InterfacePage))
(SETQ OLD2 (\GETBASE \EM.KBDAD2 0))
(GO LP))
[PROG ((W (fetch (RING WRITE) of \KEYBOARDEVENTQUEUE))
(R (fetch (RING READ) of \KEYBOARDEVENTQUEUE))
WPTR)
(COND
((EQ R W) (* eventqueue full!)
(RETURN)))
(SETQ WPTR (\ADDBASE \KEYBOARDEVENTQUEUE W))
(\RCLK (LOCF (fetch TIME of WPTR)))
[with KEYBOARDEVENT WPTR (PROGN (SETQ W0 (SETQ OLD0 (\GETBASE \EM.KBDAD0 0)))
(SETQ W1 (SETQ OLD1 (\GETBASE \EM.KBDAD1 0)))
(SETQ W2 (SETQ OLD2 (\GETBASE \EM.KBDAD2 0)))
(SETQ W3 (SETQ OLD3 (\GETBASE \EM.KBDAD3 0)))
(SETQ W4 (SETQ OLD4 (\GETBASE \EM.KBDAD4 0)))
(SETQ W5 (SETQ OLD5 (\GETBASE \EM.KBDAD5 0)))
(SETQ WU (SETQ OLDU (\GETBASE \EM.REALUTILIN
0]
(COND
((EQ R 0) (* Queue was empty)
(replace (RING READ) of \KEYBOARDEVENTQUEUE with W)))
(replace (RING WRITE) of \KEYBOARDEVENTQUEUE
with (COND
((IGEQ W \KEYBOARDEVENT.LAST)
\KEYBOARDEVENT.FIRST)
(T (IPLUS W \KEYBOARDEVENT.SIZE]
(OR \KEYBUFFERING (SETQ \KEYBUFFERING T)))
[if \KEYBUFFERING
then (if (EQ \KEYBUFFERING T)
then (if (\CAUSEINTERRUPT \KbdFXP (FUNCTION \DOBUFFEREDTRANSITIONS))
then (SETQ \KEYBUFFERING (QUOTE STARTED))
(* don't call until \DOBUFFEREDTRANSITIONS is done)
))
else (COND
(\PENDINGINTERRUPT (COND
((\CAUSEINTERRUPT \KbdFXP (FUNCTION \INTERRUPTFRAME))
(SETQ \PENDINGINTERRUPT]
[COND
((ILEQ (SETQ LOOPCNT (SUB1 LOOPCNT))
0) (* Only do this once in a while)
(SETQ LOOPCNT (COND
((\UPDATETIMERS) (* Timer was updated, so do it next time around, too,
in case we just came back from RAID or other bcpl code)
1)
(T 20]
(if [AND \TIMER.INTERRUPT.PENDING (IGREATERP (\BOXIDIFFERENCE (\RCLK (LOCF (fetch
DLMOUSETEMP
of \MISCSTATS)
))
(LOCF (fetch DLMOUSETIMER
of \MISCSTATS)))
0)
(if (EQ \TIMER.INTERRUPT.PENDING (QUOTE \MOUSECHANGE))
then (SETQ OLDU NIL)
T
else (\CAUSEINTERRUPT \KbdFXP (FUNCTION \TIMER.INTERRUPTFRAME]
then (SETQ \TIMER.INTERRUPT.PENDING))
(GO LP])
(\RESETKEYBOARD
[LAMBDA NIL (* bvm: "13-Aug-85 18:25")
(\SETIOPOINTERS) (* Called with lisp keyboard disabled whenever Lisp is
resumed from bcpl logout or copysys.)
(SETQ \KEYBUFFERING NIL)
(COND
((OR (EQ \MACHINETYPE \DANDELION)
(EQ \MACHINETYPE \DAYBREAK)) (* Initialize fake mouse bits to all up)
(\PUTBASE \EM.UTILIN 0 ALLUP)))
(with KEYBOARDEVENT \LASTKEYSTATE (SETQ W0 (\GETBASE \EM.KBDAD0 0))
(SETQ W1 (\GETBASE \EM.KBDAD1 0))
(SETQ W2 (\GETBASE \EM.KBDAD2 0))
(SETQ W3 (\GETBASE \EM.KBDAD3 0))
(SETQ W4 (\GETBASE \EM.KBDAD4 0))
(SETQ W5 (\GETBASE \EM.KBDAD5 0))
(SETQ WU (\GETBASE \EM.REALUTILIN 0))
(SETQ LOCK (XKEYDOWNP (QUOTE LOCK)))
(SETQ MOUSESTATE \DLMOUSE.UP))
(SETQ \TIMER.INTERRUPT.PENDING)
(replace (RING READ) of \KEYBOARDEVENTQUEUE with 0)
(replace (RING READ) of \SYSBUFFER with 0)
(\KEYBOARDON])
(\DOMOUSETRANSITIONS
[LAMBDA (REALSTATE) (* lmm "22-Apr-85 15:53")
(PROG (LRSTATE (REALUTILIN (fetch (KEYBOARDEVENT WU) of REALSTATE)))
[COND
((OR (NULL \MOUSECHORDTICKS)
(EQ (SETQ LRSTATE (LOGXOR (LOGAND REALUTILIN \MOUSE.ALLBITS)
\MOUSE.ALLBITS))
0)) (* Not interpreting chording, or both LEFT and RIGHT
are up -- real state and virtual state the same)
(change (fetch (KEYBOARDEVENT MOUSESTATE) of \LASTKEYSTATE)
\DLMOUSE.UP)
(SETQ \TIMER.INTERRUPT.PENDING))
(T (* Either L or R or both are down, so have to decide
about Middle)
(SELECTC (fetch (KEYBOARDEVENT MOUSESTATE) of \LASTKEYSTATE)
[\DLMOUSE.WAITING (* was waiting for new mouse)
(if (IGREATERP (\BOXIDIFFERENCE (\TEMPCOPYTIMER
(fetch (KEYBOARDEVENT
TIME)
of REALSTATE))
(LOCF (fetch DLMOUSETIMER
of \MISCSTATS)))
0)
then (change (fetch (KEYBOARDEVENT MOUSESTATE)
of \LASTKEYSTATE)
\DLMOUSE.NORMAL)
(SETQ \TIMER.INTERRUPT.PENDING)
(* leave REALUTILIN alone)
else (SETQ REALUTILIN (LOGOR REALUTILIN \MOUSE.LRBIT))
(* Turn off the L and/or R bits)
(if (EQ LRSTATE \MOUSE.LRBIT)
then (* Both L and R down at once, interpret as MIDDLE
without waiting)
(SETQ REALUTILIN (LOGAND (LOGXOR ALLUP
\MOUSE.MIDDLEBIT)
REALUTILIN))
(change (fetch (KEYBOARDEVENT MOUSESTATE)
of \LASTKEYSTATE)
\DLMOUSE.MIDDLE)
(SETQ \TIMER.INTERRUPT.PENDING]
[\DLMOUSE.UP (change REALUTILIN (LOGOR REALUTILIN \MOUSE.LRBIT))
(* Turn off the L and/or R bits)
(if (EQ LRSTATE \MOUSE.LRBIT)
then (* Both L and R down at once, interpret as MIDDLE
without waiting)
(SETQ REALUTILIN (LOGAND (LOGXOR ALLUP \MOUSE.MIDDLEBIT)
REALUTILIN))
(change (fetch (KEYBOARDEVENT MOUSESTATE) of
\LASTKEYSTATE)
\DLMOUSE.MIDDLE)
else (* Only one of L and R down.
Set timer, and ignore the down bit for now)
(* set timer)
(\BLT (LOCF (fetch DLMOUSETIMER of \MISCSTATS))
(LOCF (fetch (KEYBOARDEVENT TIME) of REALSTATE))
WORDSPERCELL)
(\BOXIPLUS (LOCF (fetch DLMOUSETIMER of \MISCSTATS))
\MOUSECHORDTICKS)
(change (fetch (KEYBOARDEVENT MOUSESTATE) of
\LASTKEYSTATE)
\DLMOUSE.WAITING)
(SETQ \TIMER.INTERRUPT.PENDING (QUOTE \MOUSECHANGE]
(\DLMOUSE.MIDDLE (* State is middle and at least one of L and R is still
down, so consider it to be still only middle)
(SETQ REALUTILIN (LOGAND (LOGXOR ALLUP \MOUSE.MIDDLEBIT)
(LOGOR REALUTILIN \MOUSE.LRBIT)))
(SELECTC LRSTATE
(\MOUSE.LEFTBIT
(* Right came up. Henceforth treat right transparently)
(change (fetch (KEYBOARDEVENT
MOUSESTATE)
of \LASTKEYSTATE)
\DLMOUSE.MIDDLE&RIGHT))
(\MOUSE.RIGHTBIT
(* Left came up. Henceforth treat left transparently)
(change (fetch (KEYBOARDEVENT
MOUSESTATE)
of \LASTKEYSTATE)
\DLMOUSE.MIDDLE&LEFT))
NIL))
[\DLMOUSE.MIDDLE&RIGHT (* Only ignore LEFT)
(SETQ REALUTILIN (LOGAND (LOGXOR ALLUP
\MOUSE.MIDDLEBIT)
(LOGOR REALUTILIN
\MOUSE.LEFTBIT]
[\DLMOUSE.MIDDLE&LEFT (* Only ignore RIGHT)
(SETQ REALUTILIN (LOGAND (LOGXOR ALLUP \MOUSE.MIDDLEBIT)
(LOGOR REALUTILIN
\MOUSE.RIGHTBIT]
(PROGN (* Remaining state is \DLMOUSE.NORMAL which means treat
mouse normally, and the only interesting transition is
back to \DLMOUSE.UP)]
(replace (KEYBOARDEVENT WU) of REALSTATE with REALUTILIN])
(\DOTRANSITIONS
[LAMBDA (KEYBASE OLD NEW) (* lmm "22-Apr-85 16:04")
(* OLD and NEW are keyboard state words that are known to have changed. KEYBASE is the number in hardware order of
the key corresponding to the first bit in these words. This function figures out the indices of transitioning keys
and calls the decoder.)
(for I (BITMASK ←(LLSH 1 15)) from 0 to 15
do [OR (EQ 0 (LOGAND BITMASK (LOGXOR OLD NEW)))
(\DECODETRANSITION (IPLUS I KEYBASE)
(EQ 0 (LOGAND NEW BITMASK]
(SETQ BITMASK (LRSH BITMASK 1)))
T])
(\DECODETRANSITION
[LAMBDA (KEYNUMBER DOWNFLG) (* lmm "23-Apr-85 10:08")
(* KEYNUMBER is the key number in the hardware keyboard layout, DOWNFLG is T if the key just went down.
PENDINGINTERRUPT, bound in \KEYHANDLER, is set to the decoded character if it is an interrupt.)
(.NOTELASTUSERACTION)
(PROG (ASCIICODE (TI (\TRANSINDEX KEYNUMBER DOWNFLG)))
(SELECTC (TRANSITIONFLAGS \CURRENTKEYACTION TI)
(IGNORE.TF (RETURN))
[LOCKSHIFT.TF (SETQ ASCIICODE (COND
((fetch (KEYBOARDEVENT SHIFTORLOCK) of \LASTKEYSTATE)
(TRANSITIONSHIFTCODE \CURRENTKEYACTION TI))
(T (TRANSITIONCODE \CURRENTKEYACTION TI]
[NOLOCKSHIFT.TF (SETQ ASCIICODE (COND
((fetch (KEYBOARDEVENT SHIFT) of \LASTKEYSTATE)
(TRANSITIONSHIFTCODE \CURRENTKEYACTION TI))
(T (TRANSITIONCODE \CURRENTKEYACTION TI]
(EVENT.TF (RETURN))
(1SHIFTUP.TF (replace (KEYBOARDEVENT 1SHIFT) of \LASTKEYSTATE with NIL)
(RETURN))
(1SHIFTDOWN.TF (replace (KEYBOARDEVENT 1SHIFT) of \LASTKEYSTATE with T)
(RETURN))
(2SHIFTUP.TF (replace (KEYBOARDEVENT 2SHIFT) of \LASTKEYSTATE with NIL)
(RETURN))
(2SHIFTDOWN.TF (replace (KEYBOARDEVENT 2SHIFT) of \LASTKEYSTATE with T)
(RETURN))
(LOCKUP.TF (replace (KEYBOARDEVENT LOCK) of \LASTKEYSTATE with NIL)
(RETURN))
(LOCKDOWN.TF (replace (KEYBOARDEVENT LOCK) of \LASTKEYSTATE with T)
(RETURN))
(LOCKTOGGLE.TF (replace (KEYBOARDEVENT LOCK) of \LASTKEYSTATE
with (NOT (fetch (KEYBOARDEVENT LOCK) of \LASTKEYSTATE)))
(RETURN))
(CTRLUP.TF (replace (KEYBOARDEVENT CTRL) of \LASTKEYSTATE with NIL)
(RETURN))
(CTRLDOWN.TF (replace (KEYBOARDEVENT CTRL) of \LASTKEYSTATE with T)
(RETURN))
(METAUP.TF (replace (KEYBOARDEVENT META) of \LASTKEYSTATE with NIL)
(RETURN))
(METADOWN.TF (replace (KEYBOARDEVENT META) of \LASTKEYSTATE with T)
(RETURN))
(FONTUP.TF (replace (KEYBOARDEVENT FONT) of \LASTKEYSTATE with NIL)
(RETURN))
(FONTDOWN.TF (replace (KEYBOARDEVENT FONT) of \LASTKEYSTATE with T)
(RETURN))
(FONTTOGGLE.TF (replace (KEYBOARDEVENT FONT) of \LASTKEYSTATE
with (NOT (fetch (KEYBOARDEVENT FONT) of \LASTKEYSTATE)))
(RETURN))
(USERMODE1UP.TF (replace (KEYBOARDEVENT USERMODE1) of \LASTKEYSTATE with NIL)
(RETURN))
(USERMODE1DOWN.TF (replace (KEYBOARDEVENT USERMODE1) of \LASTKEYSTATE
with T)
(RETURN))
(USERMODE1TOGGLE.TF (replace (KEYBOARDEVENT USERMODE1) of \LASTKEYSTATE
with (NOT (fetch (KEYBOARDEVENT USERMODE1) of \LASTKEYSTATE)
))
(RETURN))
(USERMODE2UP.TF (replace (KEYBOARDEVENT USERMODE2) of \LASTKEYSTATE with NIL)
(RETURN))
(USERMODE2DOWN.TF (replace (KEYBOARDEVENT USERMODE2) of \LASTKEYSTATE
with T)
(RETURN))
(USERMODE2TOGGLE.TF (replace (KEYBOARDEVENT USERMODE2) of \LASTKEYSTATE
with (NOT (fetch (KEYBOARDEVENT USERMODE2) of \LASTKEYSTATE)
))
(RETURN))
(USERMODE3UP.TF (replace (KEYBOARDEVENT USERMODE3) of \LASTKEYSTATE with NIL)
(RETURN))
(USERMODE3DOWN.TF (replace (KEYBOARDEVENT USERMODE3) of \LASTKEYSTATE
with T)
(RETURN))
(USERMODE3TOGGLE.TF (replace (KEYBOARDEVENT USERMODE3) of \LASTKEYSTATE
with (NOT (fetch (KEYBOARDEVENT USERMODE3) of \LASTKEYSTATE)
))
(RETURN))
(SHOULDNT))
(AND (fetch (KEYBOARDEVENT CTRL) of \LASTKEYSTATE)
(SETQ ASCIICODE (LOGAND ASCIICODE \CTRLMASK)))
[COND
((AND (OR (fetch (KEYBOARDEVENT META) of \LASTKEYSTATE)
(fetch (KEYBOARDEVENT FONT) of \LASTKEYSTATE))
(ILESSP ASCIICODE \KEYBOARD.META))
(SETQ ASCIICODE (LOGOR ASCIICODE \KEYBOARD.META]
(COND
((ASSOC ASCIICODE (fetch INTERRUPTLIST of \CURRENTKEYACTION))
(SETQ PENDINGINTERRUPT T)
(replace WAITINGINTERRUPT of \INTERRUPTSTATE with T)
(replace INTCHARCODE of \INTERRUPTSTATE with ASCIICODE))
(T (\PUTSYSBUF ASCIICODE])
(MOUSECHORDWAIT
[LAMBDA MSECS (* MPL "21-Jun-85 16:31")
(DECLARE (GLOBALVARS \RCLKMILLISECOND))
(PROG1 (AND \MOUSECHORDTICKS \MOUSECHORDMILLISECONDS)
(COND
((IGREATERP MSECS 0)
(SETQ \MOUSECHORDTICKS (AND (ARG MSECS 1)
(IMIN MAX.SMALLP (ITIMES (SETQ \MOUSECHORDMILLISECONDS
(OR (SMALLP (ARG MSECS 1))
50))
\RCLKMILLISECOND])
(\TRACKCURSOR
[LAMBDA (CURSORX CURSORY) (* mpl "20-Jul-85 22:26")
(DECLARE (GLOBALVARS SCREENHEIGHT SCREENWIDTH))
(.NOTELASTUSERACTION)
(if \COLORCURSORBM
then (* cursor is on the color screen.)
(if (IGREATERP CURSORX COLORSCREENWIDTH)
then (* Large cursor values are either out of bounds to the
right or are negative values
(16-bit bcpl signed numbers))
(if (IGREATERP CURSORX 32767)
then (* Cursor value is negative)
(SETQ CURSORX 0)
else (SETQ CURSORX COLORSCREENWIDTH)))
[if (IGREATERP CURSORY (SUB1 COLORSCREENHEIGHT))
then (* Large cursor values are either out of bounds to the
bottom or are negative values
(16-bit bcpl signed numbers))
(if (IGREATERP CURSORY 32767)
then (* Cursor value is negative)
(SETQ CURSORY 0)
else (SETQ CURSORY (SUB1 COLORSCREENHEIGHT]
(COND
((NULL \COLORCURSORDOWN) (* unless the cursor is down, take it down from it
current position.)
(.TAKE.DOWN.COLOR.CURSOR) (* put the cursor image up in its new position.)
(\SHOWCOLORCURSOR CURSORX CURSORY))) (* update the cursor position.)
(\PUTBASE \EM.MOUSEX 0 CURSORX)
(\PUTBASE \EM.CURSORX 0 CURSORX)
(\PUTBASE \EM.MOUSEY 0 CURSORY)
(\PUTBASE \EM.CURSORY 0 CURSORY)
else (* move cursor if the mouse position has changed.)
(if [OR [COND
((IGEQ CURSORX (IDIFFERENCE SCREENWIDTH \MOUSEHOTSPOTX))
(* Large cursor values are either out of bounds to the
right or are negative values
(16-bit bcpl signed numbers))
(COND
[(IGREATERP CURSORX 32767) (* Cursor value is negative)
(COND
((ILESSP (IPLUS (SUB1 (IDIFFERENCE CURSORX 65535))
\MOUSEHOTSPOTX)
0)
(* Cursor pos + hotspot is still off to the left (the IPLUS is an optimization of (\XMOUSECOORD)), so clip to
effective zero)
(SETQ CURSORX (COND
((EQ \MACHINETYPE \DANDELION)
(* Temporary workaround)
0)
(T (UNSIGNED (IMINUS \MOUSEHOTSPOTX)
BITSPERWORD]
(T (SETQ CURSORX (SUB1 (IDIFFERENCE SCREENWIDTH \MOUSEHOTSPOTX]
(if (IGEQ CURSORY (IDIFFERENCE SCREENHEIGHT CURSORHEIGHT))
then (* Large cursor values are either out of bounds to the
bottom or are negative values
(16-bit bcpl signed numbers))
(LET ((YHOT (IDIFFERENCE \MOUSEHOTSPOTY CURSORHEIGHT)))
(* Negative distance of CURSORY hotspot from top of
cursor)
(if (IGREATERP CURSORY 32767)
then (* Cursor value is negative)
[COND
((ILESSP (IDIFFERENCE (SUB1 (IDIFFERENCE CURSORY 65535))
YHOT)
0) (* Cursor pos + hotspot is still off to the top, so
clip to effective zero)
(SETQ CURSORY (COND
((OR (EQ \MACHINETYPE \DANDELION)
(EQ \MACHINETYPE \DAYBREAK))
(* Temporary workaround)
0)
(T (UNSIGNED YHOT BITSPERWORD]
elseif (IGEQ CURSORY (SETQ YHOT (IPLUS SCREENHEIGHT YHOT)))
then (SETQ CURSORY (SUB1 YHOT]
then
(* If need to clip mouse, do so here. note simple optimization only checks for one dimension per click, but that's
ok. \SETMOUSEXY MACRO takes dlion complexities into account.)
(\SETMOUSEXY CURSORX CURSORY)) (* Now track mouse by copying mouse position into
cursor position)
(\PUTBASE \EM.CURSORX 0 CURSORX)
(\PUTBASE \EM.CURSORY 0 CURSORY)
(* * The daybreak is special. We have to kick the IOP to track the cursor)
(COND
((EQ \MACHINETYPE \DAYBREAK)
(\DoveDisplay.SetCursorPosition CURSORX CURSORY])
)
(RPAQ? \MOUSECHORDTICKS )
(RPAQ? \MOUSECHORDMILLISECONDS 50)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\KEYBOARDINIT)
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS .NOTELASTUSERACTION MACRO (NIL (\BLT \LASTUSERACTION (LOCF (fetch SECONDSTMP of \MISCSTATS))
WORDSPERCELL)))
)
(DECLARE: EVAL@COMPILE
(RPAQQ ALLUP 65535)
(RPAQQ \CTRLMASK 159)
(RPAQQ \METABIT 128)
(CONSTANTS ALLUP \CTRLMASK \METABIT)
)
(RPAQQ DLMOUSEBITS ((\MOUSE.LEFTBIT 4)
(\MOUSE.RIGHTBIT 2)
(\MOUSE.MIDDLEBIT 1)
(\MOUSE.ALLBITS 7)
(\MOUSE.LRBIT 6)))
(DECLARE: EVAL@COMPILE
(RPAQQ \MOUSE.LEFTBIT 4)
(RPAQQ \MOUSE.RIGHTBIT 2)
(RPAQQ \MOUSE.MIDDLEBIT 1)
(RPAQQ \MOUSE.ALLBITS 7)
(RPAQQ \MOUSE.LRBIT 6)
(CONSTANTS (\MOUSE.LEFTBIT 4)
(\MOUSE.RIGHTBIT 2)
(\MOUSE.MIDDLEBIT 1)
(\MOUSE.ALLBITS 7)
(\MOUSE.LRBIT 6))
)
(RPAQQ DLMOUSESTATES ((\DLMOUSE.UP 0)
(\DLMOUSE.WAITING 1)
(\DLMOUSE.NORMAL 2)
(\DLMOUSE.MIDDLE 3)
(\DLMOUSE.MIDDLE&LEFT 4)
(\DLMOUSE.MIDDLE&RIGHT 5)))
(DECLARE: EVAL@COMPILE
(RPAQQ \DLMOUSE.UP 0)
(RPAQQ \DLMOUSE.WAITING 1)
(RPAQQ \DLMOUSE.NORMAL 2)
(RPAQQ \DLMOUSE.MIDDLE 3)
(RPAQQ \DLMOUSE.MIDDLE&LEFT 4)
(RPAQQ \DLMOUSE.MIDDLE&RIGHT 5)
(CONSTANTS (\DLMOUSE.UP 0)
(\DLMOUSE.WAITING 1)
(\DLMOUSE.NORMAL 2)
(\DLMOUSE.MIDDLE 3)
(\DLMOUSE.MIDDLE&LEFT 4)
(\DLMOUSE.MIDDLE&RIGHT 5))
)
(RPAQQ TRANSITIONFLAGS (CTRLDOWN.TF CTRLUP.TF IGNORE.TF EVENT.TF LOCKDOWN.TF LOCKSHIFT.TF
LOCKTOGGLE.TF LOCKUP.TF NOLOCKSHIFT.TF 1SHIFTDOWN.TF 1SHIFTUP.TF
2SHIFTDOWN.TF 2SHIFTUP.TF METADOWN.TF METAUP.TF FONTDOWN.TF
FONTUP.TF FONTTOGGLE.TF USERMODE1UP.TF USERMODE1DOWN.TF
USERMODE1TOGGLE.TF USERMODE2UP.TF USERMODE2DOWN.TF
USERMODE2TOGGLE.TF USERMODE3UP.TF USERMODE3DOWN.TF
USERMODE3TOGGLE.TF))
(DECLARE: EVAL@COMPILE
(RPAQQ CTRLDOWN.TF 5)
(RPAQQ CTRLUP.TF 4)
(RPAQQ IGNORE.TF 0)
(RPAQQ EVENT.TF 1)
(RPAQQ LOCKDOWN.TF 8)
(RPAQQ LOCKSHIFT.TF 2)
(RPAQQ LOCKTOGGLE.TF 14)
(RPAQQ LOCKUP.TF 7)
(RPAQQ NOLOCKSHIFT.TF 3)
(RPAQQ 1SHIFTDOWN.TF 6)
(RPAQQ 1SHIFTUP.TF 9)
(RPAQQ 2SHIFTDOWN.TF 11)
(RPAQQ 2SHIFTUP.TF 10)
(RPAQQ METADOWN.TF 13)
(RPAQQ METAUP.TF 12)
(RPAQQ FONTDOWN.TF 24)
(RPAQQ FONTUP.TF 25)
(RPAQQ FONTTOGGLE.TF 26)
(RPAQQ USERMODE1UP.TF 15)
(RPAQQ USERMODE1DOWN.TF 16)
(RPAQQ USERMODE1TOGGLE.TF 17)
(RPAQQ USERMODE2UP.TF 18)
(RPAQQ USERMODE2DOWN.TF 19)
(RPAQQ USERMODE2TOGGLE.TF 20)
(RPAQQ USERMODE3UP.TF 21)
(RPAQQ USERMODE3DOWN.TF 22)
(RPAQQ USERMODE3TOGGLE.TF 23)
(CONSTANTS CTRLDOWN.TF CTRLUP.TF IGNORE.TF EVENT.TF LOCKDOWN.TF LOCKSHIFT.TF LOCKTOGGLE.TF LOCKUP.TF
NOLOCKSHIFT.TF 1SHIFTDOWN.TF 1SHIFTUP.TF 2SHIFTDOWN.TF 2SHIFTUP.TF METADOWN.TF METAUP.TF
FONTDOWN.TF FONTUP.TF FONTTOGGLE.TF USERMODE1UP.TF USERMODE1DOWN.TF USERMODE1TOGGLE.TF
USERMODE2UP.TF USERMODE2DOWN.TF USERMODE2TOGGLE.TF USERMODE3UP.TF USERMODE3DOWN.TF
USERMODE3TOGGLE.TF)
)
(DECLARE: EVAL@COMPILE
[PUTPROPS \TRANSINDEX MACRO ((KEYNUMBER DOWNFLG)
(COND (DOWNFLG (IPLUS \NKEYS KEYNUMBER))
(T KEYNUMBER]
(PUTPROPS ARMEDCODE MACRO ((TABLE CHAR)
(\GETBASEBIT (fetch (KEYACTION ARMED)
TABLE)
CHAR)))
(PUTPROPS TRANSITIONSHIFTCODE MACRO ((TABLE CHAR)
(\GETBASE (fetch (KEYACTION SHIFTCODES)
TABLE)
CHAR)))
(PUTPROPS TRANSITIONCODE MACRO ((TABLE CHAR)
(\GETBASE (fetch (KEYACTION CODES)
TABLE)
CHAR)))
(PUTPROPS TRANSITIONFLAGS MACRO ((TABLE CHAR)
(\GETBASEBYTE (fetch (KEYACTION FLAGS)
TABLE)
CHAR)))
)
(* FOLLOWING DEFINITIONS EXPORTED)
[DECLARE: EVAL@COMPILE
(BLOCKRECORD KEYACTION (FLAGS CODES SHIFTCODES ARMED INTERRUPTLIST)
FLAGS ←(\ALLOCBLOCK (FOLDHI (IPLUS \NKEYS \NKEYS)
BYTESPERCELL))
CODES ←(\ALLOCBLOCK (FOLDHI (PLUS \NKEYS \NKEYS)
WORDSPERCELL))
SHIFTCODES ←(\ALLOCBLOCK (FOLDHI (PLUS \NKEYS \NKEYS)
WORDSPERCELL))
ARMED ←(\ALLOCBLOCK (FOLDHI (ADD1 \MAXTHINCHAR)
BITSPERCELL))
(CREATE (\ALLOCBLOCK 5 PTRBLOCK.GCT))
[TYPE? (AND (\BLOCKDATAP DATUM)
(EQ (\#BLOCKDATACELLS DATUM)
5)
(OR (NULL (FETCH (KEYACTION INTERRUPTLIST) OF DATUM))
(LISTP (FETCH INTERRUPTLIST OF DATUM)))
(\BLOCKDATAP (FETCH (KEYACTION FLAGS)
DATUM))
(\BLOCKDATAP (FETCH (KEYACTION CODES)
DATUM))
(\BLOCKDATAP (FETCH (KEYACTION ARMED)
DATUM])
]
(DECLARE: EVAL@COMPILE
(RPAQQ \NKEYS 112)
(CONSTANTS \NKEYS)
)
(* END EXPORTED DEFINITIONS)
[DECLARE: EVAL@COMPILE
(BLOCKRECORD RING ((READ WORD)
(WRITE WORD)))
]
(* can get rid of shiftstate after clients have been fixed)
[DECLARE: EVAL@COMPILE
(ACCESSFNS SHIFTSTATE [[DUMMYSHIFT (NOT (EQ 0 (LOGAND (\GETBASEBYTE DATUM 0)
(LOGOR 1 2]
[DUMMY1SHIFT [NOT (EQ 0 (LOGAND 1 (\GETBASEBYTE DATUM 0]
(\PUTBASEBYTE DATUM 0 (COND
(NEWVALUE (LOGOR 1 (\GETBASEBYTE DATUM 0)))
(T (LOGAND (\GETBASEBYTE DATUM 0)
(LOGXOR \CHARMASK 1]
[DUMMY2SHIFT [NOT (EQ 0 (LOGAND 2 (\GETBASEBYTE DATUM 0]
(\PUTBASEBYTE DATUM 0 (COND
(NEWVALUE (LOGOR 2 (\GETBASEBYTE DATUM 0)))
(T (LOGAND (\GETBASEBYTE DATUM 0)
(LOGXOR \CHARMASK 2]
[DUMMYLOCK [NOT (EQ 0 (LOGAND 4 (\GETBASEBYTE DATUM 0]
(\PUTBASEBYTE DATUM 0 (COND
(NEWVALUE (LOGOR 4 (\GETBASEBYTE DATUM 0)))
(T (LOGAND (\GETBASEBYTE DATUM 0)
(LOGXOR \CHARMASK 4]
[DUMMYSHIFTORLOCK (NOT (EQ 0 (\GETBASEBYTE DATUM 0)))
(\PUTBASEBYTE DATUM 0 (COND
(NEWVALUE (HELP " Can't turn on SHIFTORLOCK")
)
(T 0]
[DUMMYCTRL (NOT (EQ 0 (\GETBASEBYTE DATUM 1)))
(\PUTBASEBYTE DATUM 1 (COND
(NEWVALUE 1)
(T 0]
[DUMMYMETA (NOT (EQ 0 (\GETBASEBYTE DATUM 2)))
(\PUTBASEBYTE DATUM 2 (COND
(NEWVALUE 1)
(T 0]
[DUMMYFONT (NEQ 0 (LOGAND (LLSH 1 3)
(\GETBASEBYTE DATUM 3)))
(\PUTBASEBYTE DATUM 3 (COND
(NEWVALUE (LOGOR (LLSH 1 3)
(\GETBASEBYTE DATUM 3)))
(T (LOGAND (\GETBASEBYTE DATUM 3)
(LOGXOR \CHARMASK (LLSH 1 3]
[DUMMYUSERMODE1 (NEQ 0 (LOGAND (LLSH 1 0)
(\GETBASEBYTE DATUM 3)))
(\PUTBASEBYTE DATUM 3 (COND
(NEWVALUE (LOGOR (LLSH 1 0)
(\GETBASEBYTE DATUM 3)))
(T (LOGAND (\GETBASEBYTE DATUM 3)
(LOGXOR \CHARMASK (LLSH 1 0]
[DUMMYUSERMODE2 (NEQ 0 (LOGAND (LLSH 1 1)
(\GETBASEBYTE DATUM 3)))
(\PUTBASEBYTE DATUM 3 (COND
(NEWVALUE (LOGOR (LLSH 1 1)
(\GETBASEBYTE DATUM 3)))
(T (LOGAND (\GETBASEBYTE DATUM 3)
(LOGXOR \CHARMASK (LLSH 1 1]
(DUMMYUSERMODE3 (NEQ 0 (LOGAND (LLSH 1 2)
(\GETBASEBYTE DATUM 3)))
(\PUTBASEBYTE DATUM 3 (COND
(NEWVALUE (LOGOR (LLSH 1 2)
(\GETBASEBYTE DATUM 3)))
(T (LOGAND (\GETBASEBYTE DATUM 3)
(LOGXOR \CHARMASK (LLSH 1 2]
(CREATE (\ALLOCBLOCK (FOLDHI 3 BYTESPERCELL))))
]
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \SHIFTSTATE \MOUSETIMERTEMP)
)
(DECLARE: EVAL@COMPILE
(RPAQQ NRINGINDEXWORDS 2)
(CONSTANTS NRINGINDEXWORDS)
)
(DECLARE: EVAL@COMPILE
(RPAQ \SYSBUFFER.FIRST (UNFOLD NRINGINDEXWORDS BYTESPERWORD))
(RPAQ \SYSBUFFER.LAST (IPLUS \SYSBUFFER.FIRST (SUB1 \SYSBUFSIZE)))
[CONSTANTS (\SYSBUFFER.FIRST (UNFOLD NRINGINDEXWORDS BYTESPERWORD))
(\SYSBUFFER.LAST (IPLUS \SYSBUFFER.FIRST (SUB1 \SYSBUFSIZE]
)
)
(DECLARE: EVAL@COMPILE
(RPAQQ \KEYNAMES ((5 %%)
(4 $)
(6 ~)
(e E)
(7 &)
(d D)
(u U)
(v V)
(0 %))
(k K)
(- %)
(p P)
(/ ?)
(\ %| FONT)
(LF SAME)
(BS <-)
(3 #)
(2 @)
(w W)
(q Q)
(s S)
(a A)
(9 %()
(i I)
(x X)
(o O)
(l L)
(, <)
(' %")
(%] })
(BLANK-MIDDLE OPEN)
(BLANK-TOP KEYBOARD)
(1 !)
(ESC ESCAPE ->)
(TAB =>)
(f F)
(CTRL PROP'S)
(c C)
(j J)
(b B)
(z Z)
(LSHIFT)
(%. >)
(; :)
(CR <-%|)
(← ↑)
(DEL DELETE)
(SKIP NEXT)
(r R)
(t T)
(g G)
(y Y)
(h H)
(8 *)
(n N)
(m M)
(LOCK)
(SPACE)
(%[ {)
(= +)
(RSHIFT)
(BLANK-BOTTOM STOP)
(MOVE)
(UNDO)
(UTIL0)
(UTIL1)
(UTIL2)
(UTIL3)
(UTIL4)
(UTIL5)
(UTIL6)
(UTIL7)
(PAD1 LEFTKEY)
(PAD2 LEFTMIDDLEKEY)
(PAD3 MIDDLEKEY)
(PAD4 RIGHTMIDDLEKEY)
(PAD5 RIGHTKEY)
(LEFT RED MOUSERED)
(RIGHT BLUE MOUSEBLUE)
(MIDDLE YELLOW MOUSEYELLOW)
(MARGINS)
(K41)
(K42)
(K43)
(K44)
(K45)
(K46)
(K47)
(K48)
(COPY)
(FIND)
(AGAIN)
(HELP)
(DEF'N EXPAND)
(K4E)
(ALWAYS-ON-1)
(ALWAYS-ON-2)
(CENTER)
(K52)
(BOLD)
(ITALICS)
(UNDERLINE)
(SUPERSCRIPT)
(SUBSCRIPT)
(LARGER SMALLER)
(K59)
(K5A)
(K5B)
(K5C)
(DEFAULTS)
(K5E)
(K5F)))
)
(RPAQQ \ORIGKEYACTIONS ((0 (53 %% NOLOCKSHIFT))
(1 (52 $ NOLOCKSHIFT))
(2 (54 ~ NOLOCKSHIFT))
(3 (e E LOCKSHIFT))
(4 (55 & NOLOCKSHIFT))
(5 (d D LOCKSHIFT))
(6 (u U LOCKSHIFT))
(7 (v V LOCKSHIFT))
(8 (48 %) NOLOCKSHIFT))
(9 (k K LOCKSHIFT))
(10 (- - NOLOCKSHIFT))
(11 (p P LOCKSHIFT))
(12 (/ ? NOLOCKSHIFT))
(13 (\ %| NOLOCKSHIFT))
(14 (10 96 NOLOCKSHIFT))
(15 (1 1 NOLOCKSHIFT))
(16 (51 # NOLOCKSHIFT))
(17 (50 @ NOLOCKSHIFT))
(18 (w W LOCKSHIFT))
(19 (q Q LOCKSHIFT))
(20 (s S LOCKSHIFT))
(21 (a A LOCKSHIFT))
(22 (57 %( NOLOCKSHIFT))
(23 (i I LOCKSHIFT))
(24 (x X LOCKSHIFT))
(25 (o O LOCKSHIFT))
(26 (l L LOCKSHIFT))
(27 (, < NOLOCKSHIFT))
(28 (' %" NOLOCKSHIFT))
(29 (%] } NOLOCKSHIFT))
(30 (194 194 NOLOCKSHIFT))
(31 (193 193 NOLOCKSHIFT))
(32 (49 ! NOLOCKSHIFT))
(33 (27 27 NOLOCKSHIFT))
(34 (9 9 NOLOCKSHIFT))
(35 (f F LOCKSHIFT))
(36 CTRLDOWN . CTRLUP)
(37 (c C LOCKSHIFT))
(38 (j J LOCKSHIFT))
(39 (b B LOCKSHIFT))
(40 (z Z LOCKSHIFT))
(41 1SHIFTDOWN . 1SHIFTUP)
(42 (%. > NOLOCKSHIFT))
(43 (; : NOLOCKSHIFT))
(44 (13 13 NOLOCKSHIFT))
(45 (← ↑ NOLOCKSHIFT))
(46 (127 127 NOLOCKSHIFT))
(47 (%( %[ NOLOCKSHIFT))
(48 (r R LOCKSHIFT))
(49 (t T LOCKSHIFT))
(50 (g G LOCKSHIFT))
(51 (y Y LOCKSHIFT))
(52 (h H LOCKSHIFT))
(53 (56 * NOLOCKSHIFT))
(54 (n N LOCKSHIFT))
(55 (m M LOCKSHIFT))
(56 LOCKDOWN . LOCKUP)
(57 (32 32 NOLOCKSHIFT))
(58 (%[ { NOLOCKSHIFT))
(59 (= + NOLOCKSHIFT))
(60 2SHIFTDOWN . 2SHIFTUP)
(61 (195 195 NOLOCKSHIFT))
(63 (%) %] NOLOCKSHIFT))
(77 EVENT . EVENT)
(78 EVENT . EVENT)
(79 EVENT . EVENT)
(102 LOCKDOWN)
(103 LOCKUP)))
(RPAQQ \DLIONKEYACTIONS ((2 (54 ↑ NOLOCKSHIFT))
(10 (- ← NOLOCKSHIFT))
(13)
(14 (10 10 NOLOCKSHIFT))
(33 (\ %| NOLOCKSHIFT))
(45 (96 ~ NOLOCKSHIFT))
(93 (27 27 NOLOCKSHIFT))))
(RPAQQ \DORADOKEYACTIONS ((2 (54 ~ NOLOCKSHIFT))
(10 (- - NOLOCKSHIFT))
(13 (\ %| NOLOCKSHIFT))
(14 (10 96 NOLOCKSHIFT))
(33 (27 27 NOLOCKSHIFT))
(45 (← ↑ NOLOCKSHIFT))))
(RPAQQ \DOVEKEYACTIONS ((10 (- ← NOLOCKSHIFT))
(13)
(2 (54 94 NOLOCKSHIFT))
(14 (10 10 NOLOCKSHIFT))
(33 (\ %| NOLOCKSHIFT))
(93 (27 27 NOLOCKSHIFT))
(71 (39 34 NOLOCKSHIFT))
(108 (96 126 NOLOCKSHIFT))
(98 (48 48 NOLOCKSHIFT))
(94 (49 49 NOLOCKSHIFT))
(69 (50 50 NOLOCKSHIFT))
(70 (51 51 NOLOCKSHIFT))
(84 (52 52 NOLOCKSHIFT))
(85 (53 53 NOLOCKSHIFT))
(87 (54 54 NOLOCKSHIFT))
(81 (55 55 NOLOCKSHIFT))
(82 (56 56 NOLOCKSHIFT))
(83 (57 57 NOLOCKSHIFT))
(76 (127 127 NOLOCKSHIFT))
(65 (\ %| NOLOCKSHIFT))
(105 (46 46 NOLOCKSHIFT))
(106 (44 44 NOLOCKSHIFT))
(72 (+ + NOLOCKSHIFT))
(73 (- - NOLOCKSHIFT))
(74 (42 42 NOLOCKSHIFT))
(75 (/ / NOLOCKSHIFT))))
(RPAQ? \KEYBOARD.META 128)
(RPAQ? \MODIFIED.KEYACTIONS )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \SYSBUFFER \LONGSYSBUF \INTERRUPTSTATE \MODIFIED.KEYACTIONS \RCLKSECOND \LASTUSERACTION
\MOUSECHORDTICKS \LASTKEYSTATE \KEYBOARDEVENTQUEUE \KEYBUFFERING \CURRENTKEYACTION
\DEFAULTKEYACTION \COLORCURSORHEIGHT SCREENWIDTH SCREENHEIGHT \TIMER.INTERRUPT.PENDING
\ORIGKEYACTIONS \KEYBOARD.META \MOUSECHORDMILLISECONDS \DORADOKEYACTIONS \DLIONKEYACTIONS
\DOVEKEYACTIONS)
)
(* Key interpretation)
(DEFINEQ
(KEYACTION
[LAMBDA (KEYNAME ACTIONS TABLE) (* lmm "22-May-85 07:41")
(LET ((NUMB (OR (SMALLP KEYNAME)
(\KEYNAMETONUMBER KEYNAME)))
(TABLE (OR TABLE \DEFAULTKEYACTION)))
(CONS (\KEYACTION1 (\TRANSINDEX NUMB T)
(AND ACTIONS (OR (CAR ACTIONS)
(QUOTE IGNORE)))
TABLE)
(\KEYACTION1 (\TRANSINDEX NUMB NIL)
(AND ACTIONS (OR (CDR ACTIONS)
(QUOTE IGNORE)))
TABLE])
(KEYACTIONTABLE
[LAMBDA (OLD)
(if OLD
then (create KEYACTION copying OLD)
else (PROG1 (SETQ OLD (create KEYACTION))
(for X in \ORIGKEYACTIONS do (KEYACTION (CAR X)
(CDR X)
OLD])
(\KEYACTION1
[LAMBDA (TI ACTION TABLE) (* lmm "18-Apr-85 06:14")
(PROG1 (SELECTC (TRANSITIONFLAGS TABLE TI)
(IGNORE.TF (QUOTE IGNORE))
[(LIST LOCKSHIFT.TF NOLOCKSHIFT.TF)
(LIST (TRANSITIONCODE TABLE TI)
(TRANSITIONSHIFTCODE TABLE TI)
(COND
((EQ LOCKSHIFT.TF (TRANSITIONFLAGS TABLE TI))
(QUOTE LOCKSHIFT))
(T (QUOTE NOLOCKSHIFT]
(EVENT.TF (QUOTE EVENT))
(CTRLDOWN.TF (QUOTE CTRLDOWN))
(CTRLUP.TF (QUOTE CTRLUP))
(1SHIFTDOWN.TF (QUOTE 1SHIFTDOWN))
(1SHIFTUP.TF (QUOTE 1SHIFTUP))
(2SHIFTDOWN.TF (QUOTE 2SHIFTDOWN))
(2SHIFTUP.TF (QUOTE 2SHIFTUP))
(LOCKDOWN.TF (QUOTE LOCKDOWN))
(LOCKUP.TF (QUOTE LOCKUP))
(LOCKTOGGLE.TF (QUOTE LOCKTOGGLE))
(METADOWN.TF (QUOTE METADOWN))
(METAUP.TF (QUOTE METAUP))
(FONTUP.TF (QUOTE FONTUP))
(FONTDOWN.TF (QUOTE FONTDOWN))
(FONTTOGGLE.TF (QUOTE FONTTOGGLE))
(USERMODE1UP.TF (QUOTE USERMODE1UP))
(USERMODE1DOWN.TF (QUOTE USERMODE1DOWN))
(USERMODE1TOGGLE.TF (QUOTE USERMODE1TOGGLE))
(USERMODE2UP.TF (QUOTE USERMODE2UP))
(USERMODE2DOWN.TF (QUOTE USERMODE2DOWN))
(USERMODE2TOGGLE.TF (QUOTE USERMODE2TOGGLE))
(USERMODE3UP.TF (QUOTE USERMODE3UP))
(USERMODE3DOWN.TF (QUOTE USERMODE3DOWN))
(USERMODE3TOGGLE.TF (QUOTE USERMODE3TOGGLE))
(SHOULDNT))
(SELECTQ ACTION
((NIL NOCHANGE))
(IGNORE (change (TRANSITIONFLAGS TABLE TI)
IGNORE.TF))
(EVENT (change (TRANSITIONFLAGS TABLE TI)
EVENT.TF))
(CTRLUP (change (TRANSITIONFLAGS TABLE TI)
CTRLUP.TF))
(CTRLDOWN (change (TRANSITIONFLAGS TABLE TI)
CTRLDOWN.TF))
(1SHIFTUP (change (TRANSITIONFLAGS TABLE TI)
1SHIFTUP.TF))
(1SHIFTDOWN (change (TRANSITIONFLAGS TABLE TI)
1SHIFTDOWN.TF))
(2SHIFTUP (change (TRANSITIONFLAGS TABLE TI)
2SHIFTUP.TF))
(2SHIFTDOWN (change (TRANSITIONFLAGS TABLE TI)
2SHIFTDOWN.TF))
(LOCKUP (change (TRANSITIONFLAGS TABLE TI)
LOCKUP.TF))
(LOCKDOWN (change (TRANSITIONFLAGS TABLE TI)
LOCKDOWN.TF))
(LOCKTOGGLE (change (TRANSITIONFLAGS TABLE TI)
LOCKTOGGLE.TF))
(METAUP (change (TRANSITIONFLAGS TABLE TI)
METAUP.TF))
(METADOWN (change (TRANSITIONFLAGS TABLE TI)
METADOWN.TF))
(FONTUP (change (TRANSITIONFLAGS TABLE TI)
FONTUP.TF))
(FONTDOWN (change (TRANSITIONFLAGS TABLE TI)
FONTDOWN.TF))
(FONTTOGGLE (change (TRANSITIONFLAGS TABLE TI)
FONTTOGGLE.TF))
(USERMODE1UP (change (TRANSITIONFLAGS TABLE TI)
USERMODE1UP.TF))
(USERMODE1DOWN (change (TRANSITIONFLAGS TABLE TI)
USERMODE1DOWN.TF))
(USERMODE1TOGGLE (change (TRANSITIONFLAGS TABLE TI)
USERMODE1TOGGLE.TF))
(USERMODE2UP (change (TRANSITIONFLAGS TABLE TI)
USERMODE2UP.TF))
(USERMODE2DOWN (change (TRANSITIONFLAGS TABLE TI)
USERMODE2DOWN.TF))
(USERMODE2TOGGLE (change (TRANSITIONFLAGS TABLE TI)
USERMODE2TOGGLE.TF))
(USERMODE3UP (change (TRANSITIONFLAGS TABLE TI)
USERMODE3UP.TF))
(USERMODE3DOWN (change (TRANSITIONFLAGS TABLE TI)
USERMODE3DOWN.TF))
(USERMODE3TOGGLE (change (TRANSITIONFLAGS TABLE TI)
USERMODE3TOGGLE.TF))
(PROG (CODE SHIFTCODE ACT)
(COND
((AND [OR [\CHARCODEP (SETQ CODE (\GETCHARCODE (CAR (LISTP ACTION]
(SETQ CODE (APPLY* (FUNCTION CHARCODE)
(CAR (LISTP ACTION]
[OR [\CHARCODEP (SETQ SHIFTCODE
(\GETCHARCODE (CAR (SETQ ACT (LISTP (CDR ACTION]
(SETQ SHIFTCODE (APPLY* (FUNCTION CHARCODE)
(CAR ACT]
(OR (NULL (SETQ ACT (CDR ACT)))
(LISTP ACT))
(SELECTQ (CAR ACT)
((LOCKSHIFT T)
(change (TRANSITIONFLAGS TABLE TI)
LOCKSHIFT.TF))
((NOLOCKSHIFT NIL)
(change (TRANSITIONFLAGS TABLE TI)
NOLOCKSHIFT.TF))
NIL))
(change (TRANSITIONCODE TABLE TI)
CODE)
(change (TRANSITIONSHIFTCODE TABLE TI)
SHIFTCODE))
(T (\ILLEGAL.ARG ACTION])
(KEYDOWNP
[LAMBDA (KEYNAME) (* lmm "18-Apr-85 02:09")
(* T if the indicated key is instantaneously down.)
(\NEWKEYDOWNP (\KEYNAMETONUMBER KEYNAME])
(\KEYNAMETONUMBER
[LAMBDA (KEYNAME) (* rmk: " 2-SEP-83 10:29")
(DECLARE (GLOBALVARS \KEYNAMES)) (* The fast case is when KEYNAME is lower-case)
(for X N in \KEYNAMES as I from 0 when (EQMEMB KEYNAME X) do (RETURN I)
finally (RETURN (OR (AND (NEQ KEYNAME (SETQ N (L-CASE KEYNAME)))
(for Y in \KEYNAMES as I from 0 when (EQMEMB N Y)
do (RETURN I)))
(\ILLEGAL.ARG KEYNAME])
(MODIFY.KEYACTIONS
[LAMBDA (KeyActions SaveCurrent?) (* JonL "11-MAY-83 18:29")
(PROG1 [if SaveCurrent?
then (SETQ \MODIFIED.KEYACTIONS (for ITEM in KeyActions
collect (CONS (CAR ITEM)
(KEYACTION (CAR ITEM]
(for X in KeyActions do (KEYACTION (CAR X)
(CDR X])
(METASHIFT
[LAMBDA FLG (* bvm: "29-APR-82 15:22")
(* Sets interpretation of swat key to first arg, where
T means meta-shift, NIL means original setting.
Returns previous setting)
(PROG ((METASTATUS (QUOTE (METADOWN . METAUP)))
OLDSETTING)
[SETQ OLDSETTING (KEYACTION (QUOTE BLANK-BOTTOM)
(AND (IGREATERP FLG 0)
(COND
((EQ (ARG FLG 1)
T)
METASTATUS)
(T (OR (ARG FLG 1)
(CDR (ASSOC (QUOTE BLANK-BOTTOM)
\ORIGKEYACTIONS]
(RETURN (COND
((EQUAL OLDSETTING METASTATUS)
T)
(T OLDSETTING])
(SHIFTDOWNP
[LAMBDA (SHIFT) (* lmm "18-Apr-85 01:07")
(* Tells whether a given shift is down)
(SELECTQ SHIFT
(LOCK (fetch (KEYBOARDEVENT LOCK) of \LASTKEYSTATE))
(META (fetch (KEYBOARDEVENT META) of \LASTKEYSTATE))
(SHIFT (OR (fetch (KEYBOARDEVENT 1SHIFT) of \LASTKEYSTATE)
(fetch (KEYBOARDEVENT 2SHIFT) of \LASTKEYSTATE)))
(1SHIFT (fetch (KEYBOARDEVENT 1SHIFT) of \LASTKEYSTATE))
(2SHIFT (fetch (KEYBOARDEVENT 2SHIFT) of \LASTKEYSTATE))
(SHIFTORLOCK (OR (fetch (KEYBOARDEVENT 1SHIFT) of \LASTKEYSTATE)
(fetch (KEYBOARDEVENT 2SHIFT) of \LASTKEYSTATE)
(fetch (KEYBOARDEVENT LOCK) of \LASTKEYSTATE)))
(CTRL (fetch (KEYBOARDEVENT CTRL) of \LASTKEYSTATE))
(FONT (fetch (KEYBOARDEVENT FONT) of \LASTKEYSTATE))
(USERMODE1 (fetch (KEYBOARDEVENT USERMODE1) of \LASTKEYSTATE))
(USERMODE2 (fetch (KEYBOARDEVENT USERMODE2) of \LASTKEYSTATE))
(USERMODE3 (fetch (KEYBOARDEVENT USERMODE3) of \LASTKEYSTATE))
(\ILLEGAL.ARG SHIFT])
)
(DECLARE: EVAL@COMPILE
[PUTPROPS \KEYNAMETONUMBER MACRO (X (LET [(CE (CONSTANTEXPRESSIONP (CAR X]
(COND (CE (\KEYNAMETONUMBER (CAR CE)))
(T (QUOTE IGNOREMACRO]
(PUTPROPS \TEMPCOPYTIMER MACRO ((X)
(PROGN (\BLT \MOUSETIMERTEMP (LOCF X)
WORDSPERCELL)
\MOUSETIMERTEMP)))
)
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
[PUTPROPS XKEYDOWNP MACRO ((KEYNAME)
(KEYDOWNP1 (\KEYNAMETONUMBER KEYNAME]
[PUTPROPS KEYDOWNP MACRO ((KEYNAME)
(\NEWKEYDOWNP (\KEYNAMETONUMBER KEYNAME]
[PUTPROPS KEYDOWNP1 MACRO (OPENLAMBDA
(KEYNUMBER)
(DECLARE (GLOBALVARS \EM.KBDAD0 \EM.KBDAD1 \EM.KBDAD2 \EM.KBDAD3 \EM.UTILIN \EM.KBDAD4
\EM.KBDAD5))
(PROG NIL (RETURN (EQ 0 (LOGAND (LRSH (LLSH 1 15)
(PROGN (* (IMOD KEYNUMBER BITSPERWORD)
- GETD cause IMOD and BITSPERWORD not
exported to user)
(LOGAND KEYNUMBER 15)))
(\GETBASE (SELECTQ (PROGN (* (FOLDLO KEYNUMBER
BITSPERWORD)
GETD follows since FOLDLO
and BITSPERWORD not exported
to user)
(LRSH KEYNUMBER 4))
(0 \EM.KBDAD0)
(1 \EM.KBDAD1)
(2 \EM.KBDAD2)
(3 \EM.KBDAD3)
(4 \EM.UTILIN)
(5 (OR \EM.KBDAD4 (RETURN)))
(6 (OR \EM.KBDAD5 (RETURN)))
(RETURN))
0]
[PUTPROPS \NEWKEYDOWNP MACRO ((KEYNUMBER)
(EQ 0 (\GETBASEBIT \LASTKEYSTATE KEYNUMBER]
)
(* END EXPORTED DEFINITIONS)
(DEFINEQ
(\SHOWCOLORCURSOR
[LAMBDA (X Y) (* rrb "25-FEB-83 10:15")
(* puts the cursor bitmap on the screen at location X
Y)
(DECLARE (GLOBALVARS \MOUSEHOTSPOTX \MOUSEHOTSPOTY \COLORCURSORWIDTH \COLORSCREENCURSORLINEBASE
\COLORSCREENCURSORLINE \COLORCURSORBASE \COLORSCREENWIDTHINBITS
\COLORSCREENRASTERWIDTH \COLORCURSORRASTERWIDTH \ColorCursorBBT))
(* The coordinate operations may seem weird in this function because they are done in Alto bitmap coordinates {the
ones that the cursor positions are kept in} that has Y as 0 at the top of the screen.)
(PROG ((X (IDIFFERENCE X \MOUSEHOTSPOTX))
(Y (IDIFFERENCE Y (IDIFFERENCE (SUB1 \COLORCURSORHEIGHT)
\MOUSEHOTSPOTY)))
(XBASE 0)
(YBASE 0)
(WIDTH \COLORCURSORWIDTH)
(HEIGHT \COLORCURSORHEIGHT))
[COND
((IGREATERP 0 X) (* cursor is to the left of the screen.)
(SETQ XBASE (ITIMES (IMINUS X)
(COLORNUMBERBITSPERPIXEL)))
(SETQ WIDTH (IDIFFERENCE WIDTH XBASE))
(SETQ X 0))
((IGREATERP (IPLUS (SETQ X (\BITADDRESSOFPIXEL (COLORNUMBERBITSPERPIXEL)
X))
WIDTH)
\COLORSCREENWIDTHINBITS) (* some of the cursor is off the screen to the right.)
(SETQ WIDTH (IDIFFERENCE \COLORSCREENWIDTHINBITS X]
[COND
((IGREATERP 0 Y) (* cursor is to the above of the screen.)
(SETQ YBASE (IMINUS Y))
(SETQ HEIGHT (IPLUS \COLORCURSORHEIGHT Y))
(SETQ Y 0))
((IGREATERP (IPLUS Y \COLORCURSORHEIGHT)
COLORSCREENHEIGHT) (* some of the cursor is off the screen to the right.)
(SETQ HEIGHT (IDIFFERENCE COLORSCREENHEIGHT Y]
(UNINTERRUPTABLY
[COND
((EQ \COLORSCREENCURSORLINE Y)
(* the base address of the cursor destination in the color screen bitmap is incremented to avoid large number
arithmetic that results because the color screen is more that one segment.)
)
[(IGREATERP \COLORSCREENCURSORLINE Y) (* subtract the line length from the base enough times)
(bind (MINUSRW ←(IMINUS \COLORSCREENRASTERWIDTH)) until (EQ \COLORSCREENCURSORLINE
Y)
do (SETQ \COLORSCREENCURSORLINE (SUB1 \COLORSCREENCURSORLINE))
(SETQ.NOREF \COLORSCREENCURSORLINEBASE (\ADDBASE \COLORSCREENCURSORLINEBASE
MINUSRW]
(T (* add line length to base)
(until (EQ \COLORSCREENCURSORLINE Y)
do (SETQ \COLORSCREENCURSORLINE (ADD1 \COLORSCREENCURSORLINE))
(SETQ.NOREF \COLORSCREENCURSORLINEBASE (\ADDBASE \COLORSCREENCURSORLINEBASE
\COLORSCREENRASTERWIDTH]
(replace (PILOTBBT PBTWIDTH) of \ColorCursorBBT with WIDTH)
(replace (PILOTBBT PBTHEIGHT) of \ColorCursorBBT with HEIGHT)
(replace (PILOTBBT PBTDEST) of \ColorCursorBBT with (\ADDBASE
\COLORSCREENCURSORLINEBASE
(FOLDLO X BITSPERWORD)))
(replace (PILOTBBT PBTDESTBIT) of \ColorCursorBBT with (IMOD X BITSPERWORD))
[replace (PILOTBBT PBTSOURCE) of \ColorCursorBBT with (\ADDBASE \COLORCURSORBASE
(IPLUS (ITIMES YBASE
\COLORCURSORRASTERWIDTH)
(FOLDLO XBASE
BITSPERWORD]
[replace (PILOTBBT PBTSOURCEBIT) of \ColorCursorBBT with (COND
((EQ XBASE 0)
0)
(T (IMOD XBASE BITSPERWORD]
(\PILOTBITBLT \ColorCursorBBT 0))])
)
(RPAQ? \COLORCURSORBM )
(RPAQ? \COLORCURSORDOWN )
(RPAQ? \ColorCursorBBT )
(RPAQ? \COLORCURSOR )
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
(PUTPROPS COLORNUMBERBITSPERPIXEL MACRO (NIL (DECLARE (GLOBALVARS \COLORDISPLAYBITSPERPIXEL))
\COLORDISPLAYBITSPERPIXEL))
[PUTPROPS \BITADDRESSOFPIXEL MACRO (OPENLAMBDA (BITSPERPIXEL PIXEL)
(COND ((EQ BITSPERPIXEL 4)
(LLSH PIXEL 2))
(T (LLSH PIXEL 3]
(PUTPROPS .TAKE.DOWN.COLOR.CURSOR MACRO (NIL (* uses same bitblt table that the cursor was put up
with to take it down.)
(\PILOTBITBLT \ColorCursorBBT 0)))
)
(DECLARE: EVAL@COMPILE
(RPAQQ COLORSCREENWIDTH 640)
(RPAQQ COLORSCREENHEIGHT 480)
(CONSTANTS (COLORSCREENWIDTH 640)
(COLORSCREENHEIGHT 480))
)
(* END EXPORTED DEFINITIONS)
(* A raw keyboard device/stream)
(DEFINEQ
(\INIT.KEYBOARD.STREAM
[LAMBDA NIL (* lmm "23-May-85 15:47")
(DECLARE (GLOBALVARS \KEYBOARD.DEVICE \KEYBOARD.STREAM))
[\DEFINEDEVICE (QUOTE KEYBOARD)
(SETQ \KEYBOARD.DEVICE (create FDEV
DEVICENAME ←(QUOTE KEYBOARD)
CLOSEFILE ←(FUNCTION NILL)
EVENTFN ←(FUNCTION \KEYBOARDEVENTFN)
BIN ←(FUNCTION \GETKEY)
PEEKBIN ←(FUNCTION \PEEKSYSBUF)
READP ←(FUNCTION \SYSBUFP)
EOFP ←(FUNCTION NILL)
GETFILENAME ←(FUNCTION (LAMBDA (X MODE)
(if (EQ MODE (QUOTE INPUT))
then \KEYBOARD.STREAM]
(SETQ \KEYBOARD.STREAM (create STREAM
USERCLOSEABLE ← NIL
USERVISIBLE ← NIL
FULLFILENAME ←(QUOTE {KEYBOARD})
DEVICE ← \KEYBOARD.DEVICE
ACCESS ←(QUOTE INPUT])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\INIT.KEYBOARD.STREAM)
)
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \KEYBOARD.DEVICE \KEYBOARD.STREAM)
)
(* END EXPORTED DEFINITIONS)
(* Hook for a periodic interrupt)
(DEFINEQ
(\DOBUFFEREDTRANSITIONS
[LAMBDA (\INTERRUPTABLE)
(DECLARE (SPECVARS \INTERRUPTABLE)) (* bvm: "18-Jul-85 12:02")
(SETQ \KEYBUFFERING (QUOTE INPROGRESS))
(LET ((PENDINGINTERRUPT))
(DECLARE (SPECVARS PENDINGINTERRUPT)) (* Used by \DECODETRANSITION)
[bind R RPTR until (EQ 0 (SETQ R (fetch (RING READ) of \KEYBOARDEVENTQUEUE)))
do (SETQ RPTR (\ADDBASE \KEYBOARDEVENTQUEUE R))
(* get pointer to this event)
(* handle simple keyboard words by calling
\DOTRANSITIONS for each word)
[COND
((NEQ (fetch (KEYBOARDEVENT W0) of RPTR)
(fetch (KEYBOARDEVENT W0) of \LASTKEYSTATE))
(\DOTRANSITIONS 0 (fetch (KEYBOARDEVENT W0) of \LASTKEYSTATE)
(fetch (KEYBOARDEVENT W0) of RPTR))
(replace (KEYBOARDEVENT W0) of \LASTKEYSTATE with (fetch (KEYBOARDEVENT W0)
of RPTR]
[COND
((NEQ (fetch (KEYBOARDEVENT W1) of RPTR)
(fetch (KEYBOARDEVENT W1) of \LASTKEYSTATE))
(\DOTRANSITIONS 16 (fetch (KEYBOARDEVENT W1) of \LASTKEYSTATE)
(fetch (KEYBOARDEVENT W1) of RPTR))
(replace (KEYBOARDEVENT W1) of \LASTKEYSTATE with (fetch (KEYBOARDEVENT W1)
of RPTR]
[COND
((NEQ (fetch (KEYBOARDEVENT W2) of RPTR)
(fetch (KEYBOARDEVENT W2) of \LASTKEYSTATE))
(\DOTRANSITIONS 32 (fetch (KEYBOARDEVENT W2) of \LASTKEYSTATE)
(fetch (KEYBOARDEVENT W2) of RPTR))
(replace (KEYBOARDEVENT W2) of \LASTKEYSTATE with (fetch (KEYBOARDEVENT W2)
of RPTR]
[COND
((NEQ (fetch (KEYBOARDEVENT W3) of RPTR)
(fetch (KEYBOARDEVENT W3) of \LASTKEYSTATE))
(\DOTRANSITIONS 48 (fetch (KEYBOARDEVENT W3) of \LASTKEYSTATE)
(fetch (KEYBOARDEVENT W3) of RPTR))
(replace (KEYBOARDEVENT W3) of \LASTKEYSTATE with (fetch (KEYBOARDEVENT W3)
of RPTR]
[COND
((NEQ (fetch (KEYBOARDEVENT W4) of RPTR)
(fetch (KEYBOARDEVENT W4) of \LASTKEYSTATE))
(\DOTRANSITIONS 80 (fetch (KEYBOARDEVENT W4) of \LASTKEYSTATE)
(fetch (KEYBOARDEVENT W4) of RPTR))
(replace (KEYBOARDEVENT W4) of \LASTKEYSTATE with (fetch (KEYBOARDEVENT W4)
of RPTR]
[COND
((NEQ (fetch (KEYBOARDEVENT W5) of RPTR)
(fetch (KEYBOARDEVENT W5) of \LASTKEYSTATE))
(\DOTRANSITIONS 96 (fetch (KEYBOARDEVENT W5) of \LASTKEYSTATE)
(fetch (KEYBOARDEVENT W5) of RPTR))
(replace (KEYBOARDEVENT W5) of \LASTKEYSTATE with (fetch (KEYBOARDEVENT W5)
of RPTR]
(\DOMOUSETRANSITIONS RPTR)
[COND
((NEQ (fetch (KEYBOARDEVENT WU) of RPTR)
(fetch (KEYBOARDEVENT WU) of \LASTKEYSTATE))
(* simple case)
(\DOTRANSITIONS 64 (fetch (KEYBOARDEVENT WU) of \LASTKEYSTATE)
(fetch (KEYBOARDEVENT WU) of RPTR))
(replace (KEYBOARDEVENT WU) of \LASTKEYSTATE with (fetch (KEYBOARDEVENT WU)
of RPTR]
(* * now remove event from queue)
(COND
((EQ [replace (RING READ) of \KEYBOARDEVENTQUEUE with (COND
((IGEQ R \KEYBOARDEVENT.LAST)
\KEYBOARDEVENT.FIRST)
(T (IPLUS
\KEYBOARDEVENT.SIZE R]
(fetch (RING WRITE) of \KEYBOARDEVENTQUEUE))
(replace (RING READ) of \KEYBOARDEVENTQUEUE with 0]
(PROGN (* update dummy shift state)
(replace DUMMY1SHIFT of \SHIFTSTATE with (fetch (KEYBOARDEVENT 1SHIFT) of
\LASTKEYSTATE))
(replace DUMMY2SHIFT of \SHIFTSTATE with (fetch (KEYBOARDEVENT 2SHIFT) of
\LASTKEYSTATE))
(replace DUMMYLOCK of \SHIFTSTATE with (fetch (KEYBOARDEVENT LOCK) of \LASTKEYSTATE))
(replace DUMMYCTRL of \SHIFTSTATE with (fetch (KEYBOARDEVENT CTRL) of \LASTKEYSTATE))
(replace DUMMYMETA of \SHIFTSTATE with (fetch (KEYBOARDEVENT META) of \LASTKEYSTATE))
(replace DUMMYFONT of \SHIFTSTATE with (fetch (KEYBOARDEVENT FONT) of \LASTKEYSTATE))
(replace DUMMYUSERMODE1 of \SHIFTSTATE with (fetch (KEYBOARDEVENT USERMODE1)
of \LASTKEYSTATE))
(replace DUMMYUSERMODE2 of \SHIFTSTATE with (fetch (KEYBOARDEVENT USERMODE2)
of \LASTKEYSTATE))
(replace DUMMYUSERMODE3 of \SHIFTSTATE with (fetch (KEYBOARDEVENT USERMODE3)
of \LASTKEYSTATE)))
(* Note: there is a window between the test of READ above and the setting of \KEYBUFFERING below where a keyboard
transition can be ignored until the next transition causes \KEYBUFFERING to be set again)
(COND
((NOT (OR PENDINGINTERRUPT \PENDINGINTERRUPT)) (* No interrupt noticed this time or on any previous
invocation)
(SETQ \KEYBUFFERING NIL))
((NOT (\GETBASEPTR (\STKSCAN (QUOTE \INTERRUPTABLE))
0)) (* We're not interruptable, so try again later)
(SETQ \PENDINGINTERRUPT T)
(SETQ \KEYBUFFERING NIL))
(T (SETQ \PENDINGINTERRUPT NIL)
(SETQ \KEYBUFFERING NIL)
(LET ((\INTERRUPTABLE T))
(INTERRUPTED])
(\TIMER.INTERRUPTFRAME
[LAMBDA NIL (* lmm "22-Apr-85 09:47")
(* place holder for periodic interrupts)
(if NIL
then (APPLY* \PERIODIC.INTERRUPT)
(if \PERIODIC.INTERRUPT
then (SETUPTIMER (QUOTIENT (TIMES \PERIODIC.INTERRUPT.FREQUENCY \RCLKSECOND)
77)
(LOCF (fetch DLMOUSETIMER of \MISCSTATS))
(QUOTE TICKS))
(SETQ \TIMER.INTERRUPT.PENDING T])
(\PERIODIC.INTERRUPTFRAME
[LAMBDA NIL
(DECLARE (GLOBALVARS \PERIODIC.INTERRUPT)) (* lmm "16-Jul-85 16:22")
(LET ((FN \PERIODIC.INTERRUPT))
(AND FN (SPREADAPPLY* FN])
)
(RPAQ? \KEYBUFFERING )
(RPAQ? \PERIODIC.INTERRUPT )
(RPAQ? \TIMER.INTERRUPT.PENDING )
(RPAQ? \PERIODIC.INTERRUPT.FREQUENCY 77)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(* cursor and mouse related functions.)
(DEFINEQ
(ADJUSTCURSORPOSITION
[LAMBDA (DELTAX DELTAY) (* rrb "16-NOV-82 11:11")
(COND
[(POSITIONP DELTAX)
(\SETCURSORPOSITION (IPLUS (fetch XCOORD of DELTAX)
(\XMOUSECOORD))
(IPLUS (fetch YCOORD of DELTAX)
(\YMOUSECOORD]
(T (\SETCURSORPOSITION (IPLUS (OR DELTAX 0)
(\XMOUSECOORD))
(IPLUS (OR DELTAY 0)
(\YMOUSECOORD])
(CREATEPOSITION
[LAMBDA (XCOORD YCOORD) (* rmk: " 6-Aug-84 13:43")
(create POSITION
XCOORD ←(OR XCOORD 0)
YCOORD ←(OR YCOORD 0])
(CURSOR
[LAMBDA (NEWCURSOR INVERTFLG) (* rrb " 4-DEC-82 17:51")
(* installs NEWCURSOR as the cursor and returns the
current cursor state. If INVERTFLG is non-NIL, the
cursor image is inverted during installation.)
(DECLARE (GLOBALVARS DEFAULTCURSOR))
(PROG1 (create CURSOR
CURSORBITMAP ←[BITMAPCOPY (COND
(\COLORCURSORBM
(* cursor is on color display, get bw copy of cursor
bitmap since the hardware one is empty.)
\COLORCURSOR)
(T (CURSORBITMAP]
CURSORHOTSPOT ←(CURSORHOTSPOT))
(COND
((EQ NEWCURSOR T)
(SETQ NEWCURSOR DEFAULTCURSOR)))
(COND
((type? CURSOR NEWCURSOR)
(SETCURSOR NEWCURSOR INVERTFLG])
(CURSORCREATE
[LAMBDA (BITMAP X Y) (* lmm "11-MAR-82 00:57")
(* creates a cursor from a bitmap.
X and Y specify the hotspot.)
(PROG ((BM (BITMAPCREATE CURSORWIDTH CURSORHEIGHT)))
(BITBLT (OR BITMAP (CURSORBITMAP))
0 0 BM 0 0 CURSORWIDTH CURSORHEIGHT (QUOTE INPUT)
(QUOTE REPLACE))
(RETURN (create CURSOR
CURSORBITMAP ← BM
CURSORHOTSPOT ←(create POSITION
XCOORD ←(COND
((POSITIONP X)
(fetch XCOORD of X))
(T (OR (FIXP X)
0)))
YCOORD ←(COND
((POSITIONP X)
(fetch YCOORD of X))
(T (OR (FIXP Y)
(SUB1 CURSORHEIGHT])
(CURSORHOTSPOT
[LAMBDA (NEWPOSITION) (* rrb "14-JAN-81 16:16")
(* returns the current cursor hot spot and sets the hot
spot to NEWPOSITON if one is given.)
(PROG1 (create POSITION
XCOORD ← \MOUSEHOTSPOTX
YCOORD ← \MOUSEHOTSPOTY)
(COND
((POSITIONP NEWPOSITION)
(SETQ \MOUSEHOTSPOTX (fetch XCOORD of NEWPOSITION))
(SETQ \MOUSEHOTSPOTY (fetch YCOORD of NEWPOSITION])
(CURSORPOSITION
[LAMBDA (NEWPOSITION DISPLAYSTREAM OLDPOSITION) (* rmk: "23-AUG-83 18:18")
(PROG ((DD (\GETDISPLAYDATA DISPLAYSTREAM)))
(OR (POSITIONP OLDPOSITION)
(SETQ OLDPOSITION (create POSITION)))
(freplace XCOORD of OLDPOSITION with (\DSPUNTRANSFORMX (\XMOUSECOORD)
DD))
(freplace YCOORD of OLDPOSITION with (\DSPUNTRANSFORMY (\YMOUSECOORD)
DD))
(COND
((POSITIONP NEWPOSITION)
(\SETCURSORPOSITION (\DSPTRANSFORMX (fetch XCOORD of NEWPOSITION)
DD)
(\DSPTRANSFORMY (fetch YCOORD of NEWPOSITION)
DD)))
(NEWPOSITION (\ILLEGAL.ARG NEWPOSITION)))
(RETURN OLDPOSITION])
(\SETCURSORPOSITION
(LAMBDA (XPOS YPOS) (* jwo: "23-Jul-85 02:49")
(* sets cursor position, adjusts for hotspot and tty
region limits. XPOS and YPOS are the screen coordinates
of the hotspot location.)
(DECLARE (GLOBALVARS \MOUSEHOTSPOTX \MOUSEHOTSPOTY SCREENWIDTH SCREENHEIGHT))
(* if the color cursor is running, the position is the
real position so don't correct for the hotspot.)
(* Clip coordinates to between 0 and
SCREENWIDTH,CURSORYMAX)
(COND
(\COLORCURSORBM (SETQ XPOS (COND
((ILESSP XPOS 0)
0)
((IGREATERP XPOS (CONSTANT (SUB1 COLORSCREENWIDTH)))
(CONSTANT (SUB1 COLORSCREENWIDTH)))
(T XPOS)))
(SETQ YPOS (IDIFFERENCE (CONSTANT (SUB1 COLORSCREENHEIGHT))
(COND
((ILESSP YPOS 0)
0)
((IGREATERP YPOS (CONSTANT (SUB1 COLORSCREENHEIGHT)))
(CONSTANT (SUB1 COLORSCREENHEIGHT)))
(T YPOS)))))
(T (SETQ XPOS (UNSIGNED (IDIFFERENCE (COND
((ILESSP XPOS 0)
0)
((IGEQ XPOS SCREENWIDTH)
(SUB1 SCREENWIDTH))
(T XPOS))
\MOUSEHOTSPOTX)
BITSPERWORD))
(* YPOS is reflected around CURSORYMAX because the screen has (0,0) as the upper left corner.
Complicated by the fact that it needs to position the upper left corner of the cursor. (IMINUS CURSORHEIGHT) allows
the cursor to move off the bottom of the screen. When moved to LISP, cursor tracking should allow the hotspot to be
anywhere on the screen.)
(SETQ YPOS (UNSIGNED (IDIFFERENCE (IPLUS (IDIFFERENCE SCREENHEIGHT CURSORHEIGHT)
\MOUSEHOTSPOTY)
(COND
((ILESSP YPOS 0)
0)
((IGREATERP YPOS SCREENHEIGHT)
SCREENHEIGHT)
(T YPOS)))
BITSPERWORD))
(COND
((OR (EQ \MACHINETYPE \DANDELION)
(EQ \MACHINETYPE \DAYBREAK)) (* Temporary workaround)
(COND
((IGREATERP YPOS 32767)
(SETQ YPOS 0)))
(COND
((IGREATERP XPOS 32767)
(SETQ XPOS 0)))))))
(\SETMOUSEXY XPOS YPOS)
(PROGN (* change the cursor position too so that GETMOUSESTATE
will get the correct values if it is called before the
next 60 cycle interrupt.)
(\PUTBASE \EM.CURSORX 0 XPOS)
(\PUTBASE \EM.CURSORY 0 YPOS)
(COND
((EQ \MACHINETYPE \DAYBREAK) (* Need to do special stuff for daybreak IOP)
(\DoveDisplay.SetCursorPosition XPOS YPOS))))
NIL))
(FLIPCURSOR
[LAMBDA NIL (* mpl "21-Jul-85 00:08")
(PROG ((ADDR \EM.CURSORBITMAP))
(FRPTQ CURSORHEIGHT [\PUTBASE ADDR 0 (LOGXOR (\GETBASE ADDR 0)
(CONSTANT (SUB1 (EXPT 2 CURSORWIDTH]
(SETQ ADDR (\ADDBASE ADDR 1)))
(COND
((EQ \MACHINETYPE \DAYBREAK)
(\DoveDisplay.SetCursorShape])
(FLIPCURSORBAR
[LAMBDA (N) (* bvm: "13-Aug-85 17:26")
(* * Inverts the Nth line of the cursor, N = 0 being the top)
(\PUTBASE \EM.CURSORBITMAP N (LOGXOR (\GETBASE \EM.CURSORBITMAP N)
(CONSTANT MAX.SMALL.INTEGER)))
(COND
((EQ \MACHINETYPE \DAYBREAK) (* Notify IOP)
(\DoveDisplay.SetCursorShape])
(LASTMOUSEX
[LAMBDA (DS) (* rmk: "30-AUG-83 13:07")
(* returns the mouse x position in the coordinates of
the DisplayStream DS)
(\DSPUNTRANSFORMX LASTMOUSEX (\GETDISPLAYDATA DS])
(LASTMOUSEY
[LAMBDA (DS) (* rmk: "30-AUG-83 13:07")
(* returns the mouse y position in the coordinates of
the DisplayStream DS)
(\DSPUNTRANSFORMY LASTMOUSEY (\GETDISPLAYDATA DS])
(POSITIONP
[LAMBDA (X) (* rrb "25-AUG-82 11:04")
(* is X a position? For now just a cons check but
should be made a datatype.)
(AND (LISTP X)
(NUMBERP (CAR X))
(NUMBERP (CDR X))
X])
(SETCURSOR
[LAMBDA (NEWCURSOR INVERTFLG) (* MPL "21-Jun-85 16:40")
(* version of SETCURSOR that knows about the
possibility of the cursor being on the color screen.)
(OR (type? CURSOR NEWCURSOR)
(\ILLEGAL.ARG NEWCURSOR))
(COND
(\COLORCURSORBM (* cursor is on the color screen)
(\TAKEDOWNCOLORCURSOR)
(SETQ \MOUSEHOTSPOTY (fetch CURSORHOTSPOTY of NEWCURSOR))
(SETQ \MOUSEHOTSPOTX (fetch CURSORHOTSPOTX of NEWCURSOR))
(\SETCOLORCURSORBM (fetch (CURSOR CURSORBITMAP) of NEWCURSOR)))
(T [SELECTC \MACHINETYPE
(\DAYBREAK (\DoveDisplay.SetCursorShape (fetch CURSORBITMAP of NEWCURSOR)))
(PROGN (BITBLT (fetch CURSORBITMAP of NEWCURSOR)
0 0 (CURSORBITMAP)
0 0 CURSORWIDTH CURSORHEIGHT (COND
(INVERTFLG (QUOTE INVERT))
(T (QUOTE INPUT)))
(QUOTE REPLACE] (* don't need to adjust the color cursor because it is
kept in hotspot independent terms.)
(ADJUSTCURSORPOSITION (IDIFFERENCE \MOUSEHOTSPOTX (fetch CURSORHOTSPOTX of NEWCURSOR))
(IDIFFERENCE \MOUSEHOTSPOTY (fetch CURSORHOTSPOTY of NEWCURSOR)))
(* set after adjustment to avoid confusion about
hotspot during adjustment.)
(SETQ \MOUSEHOTSPOTY (fetch CURSORHOTSPOTY of NEWCURSOR))
(SETQ \MOUSEHOTSPOTX (fetch CURSORHOTSPOTX of NEWCURSOR])
)
(DEFINEQ
(GETMOUSESTATE
[LAMBDA NIL (* lmm "18-Apr-85 02:13")
(* Reads the current state of the mouse and keyboard)
(SETQ LASTMOUSEX (\XMOUSECOORD))
(SETQ LASTMOUSEY (\YMOUSECOORD))
(SETQ LASTMOUSEBUTTONS (LOGXOR (LOGAND (fetch WU \LASTKEYSTATE)
\MOUSE.ALLBITS)
\MOUSE.ALLBITS))
(SETQ LASTKEYBOARD (\EVENTKEYS))
NIL])
(\EVENTKEYS
[LAMBDA NIL (* rmk: " 4-JUN-81 22:58")
(* Returns the state of the various keys that are
represented in mouse events)
(LOGOR (COND
((KEYDOWNP (QUOTE LOCK))
128)
(T 0))
(COND
((KEYDOWNP (QUOTE LSHIFT))
64)
(T 0))
(COND
((KEYDOWNP (QUOTE CTRL))
32)
(T 0))
(COND
((KEYDOWNP (QUOTE RSHIFT))
8)
(T 0))
(COND
((KEYDOWNP (QUOTE BLANK-TOP))
4)
(T 0))
(COND
((KEYDOWNP (QUOTE BLANK-MIDDLE))
2)
(T 0))
(COND
((KEYDOWNP (QUOTE BLANK-BOTTOM))
1)
(T 0])
)
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
(RPAQQ CURSORHEIGHT 16)
(RPAQQ CURSORWIDTH 16)
(CONSTANTS (CURSORHEIGHT 16)
(CURSORWIDTH 16))
)
(DECLARE: EVAL@COMPILE
(ADDTOVAR GLOBALVARS LASTMOUSEX LASTMOUSEY LASTMOUSEBUTTONS LASTMOUSETIME LASTKEYBOARD)
)
(* END EXPORTED DEFINITIONS)
(RPAQ? \MOUSEHOTSPOTX 0)
(RPAQ? \MOUSEHOTSPOTY 15)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \MOUSEHOTSPOTX \MOUSEHOTSPOTY \MOUSETIMEBOX \COLORCURSOR)
)
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
[PUTPROPS \SETMOUSEXY MACRO ((XPOS YPOS)
(PROGN (SELECTC \MACHINETYPE (\DANDELION (do (PROGN (replace NEWMOUSEX of \IOPAGE with
XPOS)
(replace NEWMOUSEY of \IOPAGE with
YPOS))
repeatuntil
(ILESSP (fetch NEWMOUSESTATE of \IOPAGE)
32768))
(* smash position until mouse says it is not busy)
(replace NEWMOUSEX of \IOPAGE with XPOS)
(replace NEWMOUSEY of \IOPAGE with YPOS)
(replace NEWMOUSESTATE of \IOPAGE with 32768))
(\DAYBREAK (\DoveMisc.SetMousePosition XPOS YPOS))
NIL)
(PROGN (\PUTBASE \EM.MOUSEX 0 XPOS)
(\PUTBASE \EM.MOUSEY 0 YPOS]
)
(* END EXPORTED DEFINITIONS)
(DECLARE: EVAL@COMPILE
[PUTPROPS \XMOUSECOORD MACRO (NIL (COND (\COLORCURSORBM (\GETBASE \EM.CURSORX 0))
(T (IPLUS \MOUSEHOTSPOTX (SIGNED (\GETBASE \EM.CURSORX 0)
BITSPERWORD]
[PUTPROPS \YMOUSECOORD MACRO (NIL (IDIFFERENCE [COND (\COLORCURSORBM (* color cursor is on.)
(CONSTANT (SUB1
COLORSCREENHEIGHT)))
(T (IPLUS \MOUSEHOTSPOTY (IDIFFERENCE
SCREENHEIGHT
CURSORHEIGHT]
(SIGNED (\GETBASE \EM.CURSORY 0)
BITSPERWORD]
)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(RPAQ \SFPosition (CREATEPOSITION))
)
(DECLARE: DOEVAL@COMPILE
(RPAQQ SCREENHEIGHT 808)
)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(BLOCKRECORD KEYBOARDEVENT ((W0 WORD)
(W1 WORD)
(W2 WORD)
(W3 WORD)
(WU WORD)
(W4 WORD)
(W5 WORD)
(TIME FIXP)
(MOUSESTATE BITS 3)
(1SHIFT FLAG)
(2SHIFT FLAG)
(LOCK FLAG)
(CTRL FLAG)
(META FLAG)
(FONT FLAG)
(USERMODE1 FLAG)
(USERMODE2 FLAG)
(USERMODE3 FLAG)
(NIL BITS 4)
(MOUSEX WORD)
(MOUSEY WORD))
(CREATE (\ALLOCBLOCK (FOLDHI \KEYBOARDEVENT.SIZE WORDSPERCELL)))
W0 ← ALLUP W1 ← ALLUP W2 ← ALLUP W3 ← ALLUP W4 ← ALLUP W5 ← ALLUP WU ←
ALLUP MOUSESTATE ← \DLMOUSE.UP
[ACCESSFNS KEYBOARDEVENT ((SIZE (INDEXF (fetch MOUSEY of DATUM)))
(SHIFT (OR (fetch (KEYBOARDEVENT 1SHIFT)
DATUM)
(fetch (KEYBOARDEVENT 2SHIFT)
DATUM)))
(SHIFTORLOCK (OR (fetch (KEYBOARDEVENT SHIFT)
DATUM)
(fetch (KEYBOARDEVENT LOCK)
DATUM]
LOCK ←(XKEYDOWNP (QUOTE LOCK))
TIME ← 0)
]
(DECLARE: EVAL@COMPILE
(RPAQ \KEYBOARDEVENT.FIRST NRINGINDEXWORDS)
(RPAQQ \KEYBOARDEVENT.SIZE 12)
(RPAQ \KEYBOARDEVENT.LAST (PLUS \KEYBOARDEVENT.FIRST (TIMES \KEYBOARDEVENT.SIZE 383)))
[CONSTANTS (\KEYBOARDEVENT.FIRST NRINGINDEXWORDS)
\KEYBOARDEVENT.SIZE
(\KEYBOARDEVENT.LAST (PLUS \KEYBOARDEVENT.FIRST (TIMES \KEYBOARDEVENT.SIZE 383]
)
)
(DEFINEQ
(MACHINETYPE
(LAMBDA NIL (* mpl "27-Jun-85 20:57")
(SELECTQ (fetch MachineType of \InterfacePage)
(4 (QUOTE DOLPHIN))
(5 (QUOTE DORADO))
(6 (QUOTE DANDELION))
(8 (* This is \DAYBREAK internally)
(QUOTE DOVE))
NIL)))
(SETMAINTPANEL
[LAMBDA (N) (* mpl "21-Jul-85 18:15")
(SELECTC \MACHINETYPE
(\DANDELION (replace DLMAINTPANEL of \IOPAGE with N))
[\DOLPHIN ((OPCODES MISC1 3)
(\DTEST N (QUOTE SMALLP]
[\DAYBREAK ((OPCODES DOVEMISC 2)
(\DTEST N (QUOTE SMALLP]
NIL])
)
(* DLion beeper)
(DEFINEQ
(BEEPON
[LAMBDA (FREQ) (* MPL "27-Jul-85 21:48")
(SELECTC \MACHINETYPE
(\DANDELION (while (IGEQ (fetch DLBEEPCMD of \IOPAGE)
32768)
do (BLOCK))
(replace DLBEEPFREQ of \IOPAGE with (IQUOTIENT 1843200 (IMAX FREQ 29)))
(replace DLBEEPCMD of \IOPAGE with 32768))
(\DAYBREAK (\DoveMisc.BeepOn FREQ))
(PROGN NIL))
NIL])
(BEEPOFF
[LAMBDA NIL (* MPL "27-Jul-85 21:49")
(SELECTC \MACHINETYPE
(\DANDELION (while (IGEQ (fetch DLBEEPCMD of \IOPAGE)
32768)
do (BLOCK))
(replace DLBEEPCMD of \IOPAGE with 32769))
(\DAYBREAK (\DoveMisc.BeepOff))
(PROGN NIL))
NIL])
)
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \EM.MOUSEX \EM.MOUSEY \EM.CURSORX \EM.CURSORY \EM.UTILIN \EM.REALUTILIN \EM.KBDAD0
\EM.KBDAD1 \EM.KBDAD2 \EM.KBDAD3 \EM.KBDAD4 \EM.KBDAD5 \EM.DISPINTERRUPT \EM.DISPLAYHEAD
\EM.CURSORBITMAP \MACHINETYPE \COLORCURSORBM \COLORCURSOR \COLORCURSORDOWN
\ColorCursorBBT \COLORCURSORWIDTH \COLORSCREENCURSORLINEBASE \COLORSCREENCURSORLINE
\COLORCURSORBASE \COLORSCREENWIDTHINBITS \COLORSCREENRASTERWIDTH \COLORCURSORRASTERWIDTH
\DEFAULTKEYACTION \CURRENTKEYACTION \PERIODIC.INTERRUPT \PERIODIC.INTERRUPT.FREQUENCY)
)
(* END EXPORTED DEFINITIONS)
(DEFINEQ
(WITHOUT-INTERRUPTS
[NLAMBDA (FORM) (* lmm "18-Apr-85 02:53")
(PROG (VAL)
(\KEYBOARDOFF)
(SETQ VAL (DISPLAYDOWN FORM))
(\KEYBOARDON)
(RETURN VAL])
)
(* Compile locked fns together for locality)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: NIL FLIPCURSORBAR \KEYHANDLER \KEYHANDLER1 \TRACKCURSOR \PERIODIC.INTERRUPTFRAME
\TIMER.INTERRUPTFRAME \DOBUFFEREDTRANSITIONS \DOTRANSITIONS \DOMOUSETRANSITIONS
\DECODETRANSITION \EVENTKEYS)
]
(DECLARE: DONTCOPY
(ADDTOVAR INEWCOMS (ALLOCAL (ADDVARS (LOCKEDFNS \KEYHANDLER \KEYHANDLER1 \CONTEXTAPPLY \LOCKPAGES
\SMASHLINK \INCUSECOUNT LLSH \MAKEFREEBLOCK
\DECUSECOUNT \MAKENUMBER \ADDBASE
\PERIODIC.INTERRUPTFRAME \DOBUFFEREDTRANSITIONS
\TIMER.INTERRUPTFRAME \TRACKCURSOR FLIPCURSORBAR)
(LOCKEDVARS \InterfacePage \MOUSEHOTSPOTX \MOUSEHOTSPOTY
\PENDINGINTERRUPT \COLORCURSORBM \COLORCURSORDOWN
\COLORDISPLAYBITSPERPIXEL \ColorCursorBBT
\COLORCURSORWIDTH \COLORSCREENCURSORLINE
\COLORSCREENCURSORLINEBASE \COLORCURSORBASE
\COLORSCREENWIDTHINBITS \COLORSCREENRASTERWIDTH
\COLORCURSORRASTERWIDTH \PERIODIC.INTERRUPT
\PERIODIC.INTERRUPT.FREQUENCY \LASTUSERACTION
\MOUSECHORDTICKS \KEYBOARDEVENTQUEUE \KEYBUFFERING
SCREENWIDTH SCREENHEIGHT \TIMER.INTERRUPT.PENDING
\EM.MOUSEX \EM.MOUSEY \EM.CURSORX \EM.CURSORY
\EM.UTILIN \EM.REALUTILIN \EM.KBDAD0 \EM.KBDAD1
\EM.KBDAD2 \EM.KBDAD3 \EM.DISPINTERRUPT
\EM.CURSORBITMAP \EM.KBDAD4 \EM.KBDAD5 \MISCSTATS
\RCLKSECOND))))
(ADDTOVAR RDCOMS (FNS \SETIOPOINTERS))
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML WITHOUT-INTERRUPTS)
(ADDTOVAR LAMA METASHIFT MOUSECHORDWAIT)
)
(PUTPROPS LLKEY COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (7225 13404 (BKSYSCHARCODE 7235 . 7548) (\CLEARSYSBUF 7550 . 8059) (\GETKEY 8061 . 8886)
(\INTCHAR 8888 . 9429) (\NSYSBUFCHARS 9431 . 10029) (\SAVESYSBUF 10031 . 11270) (\SYSBUFP 11272 .
11591) (\GETSYSBUF 11593 . 11774) (\PUTSYSBUF 11776 . 12566) (\PEEKSYSBUF 12568 . 13402)) (14357 44639
(\KEYBOARDINIT 14367 . 15785) (\KEYBOARDEVENTFN 15787 . 16619) (\ALLOCLOCKED 16621 . 17113) (
\SETIOPOINTERS 17115 . 22129) (\KEYBOARDOFF 22131 . 22364) (\KEYBOARDON 22366 . 22596) (\KEYHANDLER
22598 . 22729) (\KEYHANDLER1 22731 . 27762) (\RESETKEYBOARD 27764 . 28923) (\DOMOUSETRANSITIONS 28925
. 33911) (\DOTRANSITIONS 33913 . 34592) (\DECODETRANSITION 34594 . 39300) (MOUSECHORDWAIT 39302 .
39812) (\TRACKCURSOR 39814 . 44637)) (57936 66681 (KEYACTION 57946 . 58456) (KEYACTIONTABLE 58458 .
58734) (\KEYACTION1 58736 . 63319) (KEYDOWNP 63321 . 63592) (\KEYNAMETONUMBER 63594 . 64179) (
MODIFY.KEYACTIONS 64181 . 64585) (METASHIFT 64587 . 65419) (SHIFTDOWNP 65421 . 66679)) (68186 72137 (
\SHOWCOLORCURSOR 68196 . 72135)) (73019 73945 (\INIT.KEYBOARD.STREAM 73029 . 73943)) (74199 80987 (
\DOBUFFEREDTRANSITIONS 74209 . 80210) (\TIMER.INTERRUPTFRAME 80212 . 80765) (\PERIODIC.INTERRUPTFRAME
80767 . 80985)) (81236 91804 (ADJUSTCURSORPOSITION 81246 . 81718) (CREATEPOSITION 81720 . 81919) (
CURSOR 81921 . 82890) (CURSORCREATE 82892 . 83756) (CURSORHOTSPOT 83758 . 84329) (CURSORPOSITION 84331
. 85126) (\SETCURSORPOSITION 85128 . 88183) (FLIPCURSOR 88185 . 88624) (FLIPCURSORBAR 88626 . 89073)
(LASTMOUSEX 89075 . 89399) (LASTMOUSEY 89401 . 89725) (POSITIONP 89727 . 90081) (SETCURSOR 90083 .
91802)) (91805 93163 (GETMOUSESTATE 91815 . 92312) (\EVENTKEYS 92314 . 93161)) (96565 97334 (
MACHINETYPE 96575 . 96960) (SETMAINTPANEL 96962 . 97332)) (97360 98247 (BEEPON 97370 . 97856) (BEEPOFF
97858 . 98245)) (98903 99182 (WITHOUT-INTERRUPTS 98913 . 99180)))))
STOP