(FILECREATED "11-Nov-85 00:37:02" {ERIS}<LISPCORE>SOURCES>LLKEY.;76 104314
changes to: (FNS \KEYBOARDEVENTFN)
previous date: "31-Oct-85 16:13:11" {ERIS}<LISPCORE>SOURCES>LLKEY.;75)
(* Copyright (c) 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT LLKEYCOMS)
(RPAQQ LLKEYCOMS [(COMS (* Access to keyboard)
(FNS BKSYSCHARCODE \CLEARSYSBUF \GETKEY \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 \DOMOUSECHORDING
\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 \DLIONOSDKEYACTIONS \DORADOKEYACTIONS
\DOVEKEYACTIONS \DOVEOSDKEYACTIONS)
(INITVARS (\KEYBOARD.META 256)
(\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
\DLIONOSDKEYACTIONS \DOVEKEYACTIONS \DOVEOSDKEYACTIONS))
(COMS (* Key interpretation)
(FNS KEYACTION KEYACTIONTABLE \KEYACTION1 KEYDOWNP \KEYNAMETONUMBER MODIFY.KEYACTIONS
METASHIFT SHIFTDOWNP)
(FNS SETUP.OFFICE.KEYBOARD)
(* To support office style 1108 & 1186 keyboards)
(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 \DOMOUSECHORDING
\PERIODIC.INTERRUPTFRAME \TIMER.INTERRUPTFRAME \DOBUFFEREDTRANSITIONS
\DOTRANSITIONS \DECODETRANSITION \EVENTKEYS)))
[DECLARE: DONTCOPY
(ADDVARS [INEWCOMS (ALLOCAL (ADDVARS (LOCKEDFNS \KEYHANDLER \KEYHANDLER1
\DOMOUSECHORDING \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])
(\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) (* jds "11-Nov-85 00:30")
(DECLARE (GLOBALVARS \KEYBOARD.BEFORETYPE \DORADOKEYACTIONS \DLIONKEYACTIONS))
(SELECTQ EVENT
((BEFORELOGOUT BEFOREMAKESYS BEFORESYSOUT BEFORESAVEVM)
(SETQ \KEYBOARD.BEFORETYPE \MACHINETYPE))
[(AFTERLOGOUT AFTERMAKESYS AFTERSYSOUT AFTERSAVEVM)
(* Restarting a world. If we changed machines, fix up
the key actions to match the new machine.)
(COND
((NEQ \MACHINETYPE \KEYBOARD.BEFORETYPE)
(* Changed machines. Change Keyactions.)
(for X in (SELECTC \MACHINETYPE
(\DORADO \DORADOKEYACTIONS)
(\DANDELION \DLIONKEYACTIONS)
(\DAYBREAK (* Moving to a daybreak. Need to distinguish among the
various kinds of keyboard.)
(* For now, we only distinguish between the office keyboards (1 = US, 2 = Euro, 3 = Japanese, 4 = ADM-3), and some
yet-to-be-determined Lisp-keyboard number)
(COND
((ILEQ (\DoveMisc.ReadKeyboardType)
4)
(* It's an office keyboard.
Set it up right!)
(APPEND \DOVEKEYACTIONS
\DOVEOSDKEYACTIONS))
(T
(* Lisp keyboard. Leave the Dove keyactions as they
were.)
\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 (* bvm: " 9-Oct-85 11:49")
(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))
(SETTOPVAL (QUOTE \EM.REALUTILIN)
(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.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 SCREENWIDTH)
(\DoveDisplay.ScreenWidth]
(RAID))
(SETTOPVAL (QUOTE \EM.UTILIN)
(LOCF (fetch (IFPAGE FAKEMOUSEBITS) of \InterfacePage])
(\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: " 9-Oct-85 12:46")
(PROG ((OLD0 ALLUP)
(OLD1 ALLUP)
(OLD2 ALLUP)
(OLD3 ALLUP)
(OLD4 ALLUP)
(OLD5 ALLUP)
(OLDU ALLUP)
(OLDFAKEU ALLUP)
(LOOPCNT 10)
(PERIODCNT 60)
(MOUSESTATE \DLMOUSE.UP)
(MOUSETIMER (LOCF (fetch DLMOUSETIMER of \MISCSTATS)))
(MOUSETEMP (LOCF (fetch DLMOUSETEMP of \MISCSTATS)))
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]
[COND
((OR (NEQ (\GETBASE \EM.MOUSEX 0)
CURSORX)
(NEQ (\GETBASE \EM.MOUSEY 0)
CURSORY))
(\TRACKCURSOR (SETQ CURSORX (\GETBASE \EM.MOUSEX 0))
(SETQ CURSORY (\GETBASE \EM.MOUSEY 0]
[COND
((OR [COND
((OR (NEQ OLDU (\GETBASE \EM.REALUTILIN 0))
(COND
((AND (EQ MOUSESTATE \DLMOUSE.WAITING)
(IGREATERP (\BOXIDIFFERENCE (\RCLK MOUSETEMP)
MOUSETIMER)
0)) (* Timer expired on seeing both left and right down,
so set state to normal)
(SETQ MOUSESTATE \DLMOUSE.NORMAL)
T)))
(SETQ MOUSESTATE (\DOMOUSECHORDING (SETQ OLDU (\GETBASE
\EM.REALUTILIN 0))
MOUSESTATE))
(NEQ OLDFAKEU (\GETBASE \EM.UTILIN 0]
(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)))
(COND
((EQ 0 (LOGAND (\GETBASE \EM.KBDAD2 0)
2114)) (* Ctrl-shift-DEL panic interrupt -- switch to
TeleRaid immediately)
(swap (fetch (IFPAGE TELERAIDFXP) of \InterfacePage)
(fetch (IFPAGE KbdFXP) of \InterfacePage))
(\KEYBOARDOFF)
(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 OLDFAKEU
(\GETBASE \EM.UTILIN 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]
[COND
[\KEYBUFFERING (COND
((EQ \KEYBUFFERING T)
(COND
((\CAUSEINTERRUPT \KbdFXP (FUNCTION \DOBUFFEREDTRANSITIONS))
(SETQ \KEYBUFFERING (QUOTE STARTED))
(* don't call until \DOBUFFEREDTRANSITIONS is done)
]
(T (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]
(COND
([AND NIL \TIMER.INTERRUPT.PENDING (IGREATERP (\BOXIDIFFERENCE
(\RCLK (LOCF (fetch DLMOUSETEMP
of \MISCSTATS)))
(LOCF (fetch DLMOUSETIMER
of \MISCSTATS)))
0)
(COND
((EQ \TIMER.INTERRUPT.PENDING (QUOTE \MOUSECHANGE))
(SETQ OLDU NIL)
T)
(T (\CAUSEINTERRUPT \KbdFXP (FUNCTION \TIMER.INTERRUPTFRAME]
(SETQ \TIMER.INTERRUPT.PENDING)))
(GO LP])
(\RESETKEYBOARD
[LAMBDA NIL (* bvm: "30-Oct-85 17:06")
(\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)
(SETQ \LONGSYSBUF)
(\DAYTIME0 \LASTUSERACTION)
(\KEYBOARDON])
(\DOMOUSECHORDING
[LAMBDA (REALUTILIN STATE) (* bvm: " 9-Oct-85 11:24")
(* Handles mouse transitions on a DLion. REALUTILIN is the actual util word from the processor.
STATE is our internal state. Sets contents of \EM.UTILIN to reflect the virtual mouse state, which may contain a
middle mouse button even where there is only a two-button mouse. Returns new state)
(PROG (LRSTATE)
[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)
(SETQ STATE \DLMOUSE.UP))
(T (* Either L or R or both are down, so have to decide
about Middle)
(SELECTC STATE
[(LIST \DLMOUSE.UP \DLMOUSE.WAITING)
(SETQ REALUTILIN (LOGOR REALUTILIN \MOUSE.LRBIT))
(* Turn off the L and/or R bits)
(COND
((EQ LRSTATE \MOUSE.LRBIT)
(* Both L and R down at once, interpret as MIDDLE
without waiting)
(SETQ REALUTILIN (LOGAND (LOGXOR ALLUP \MOUSE.MIDDLEBIT)
REALUTILIN))
(SETQ STATE \DLMOUSE.MIDDLE))
((NEQ STATE \DLMOUSE.WAITING)
(* Only one of L and R down.
Set timer, and ignore the down bit for now)
(\BOXIPLUS (\RCLK (LOCF (fetch DLMOUSETIMER of \MISCSTATS)))
\MOUSECHORDTICKS)
(SETQ STATE \DLMOUSE.WAITING]
(\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)
(SETQ STATE
\DLMOUSE.MIDDLE&RIGHT))
(\MOUSE.RIGHTBIT
(* Left came up. Henceforth treat left transparently)
(SETQ STATE
\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)]
(\PUTBASE \EM.UTILIN 0 REALUTILIN)
(RETURN STATE])
(\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) (* rrb " 3-Oct-85 12:00")
(DECLARE (GLOBALVARS SCREENHEIGHT SCREENWIDTH))
(.NOTELASTUSERACTION)
(COND
(\COLORCURSORBM (* cursor is on the color screen.)
[COND
((IGREATERP CURSORX COLORSCREENWIDTH)
(* 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)
(SETQ CURSORX 0))
(T (SETQ CURSORX COLORSCREENWIDTH]
[COND
((IGREATERP CURSORY (SUB1 COLORSCREENHEIGHT))
(* Large cursor values are either out of bounds to the
bottom or are negative values
(16-bit bcpl signed numbers))
(COND
((IGREATERP CURSORY 32767) (* Cursor value is negative)
(SETQ CURSORY 0))
(T (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))
(T (* move cursor if the mouse position has changed.)
(COND
((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]
(IGEQ CURSORY (IDIFFERENCE SCREENHEIGHT CURSORHEIGHT)))
(* repeat test so that both X and Y will get clipped
each cycle. This keeps the cursor from moving off the
screen.)
[COND
((IGEQ CURSORY (IDIFFERENCE SCREENHEIGHT CURSORHEIGHT))
(* Large cursor values are either out of bounds to the
bottom or are negative values
(16-bit bcpl signed numbers))
(LET [(YHOT (IDIFFERENCE \MOUSEHOTSPOTY (SUB1 CURSORHEIGHT]
(* Negative distance of CURSORY hotspot from top of
cursor)
(COND
[(IGREATERP CURSORY 32767) (* 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]
((IGEQ CURSORY (SETQ YHOT (IPLUS SCREENHEIGHT YHOT)))
(SETQ CURSORY (SUB1 YHOT]
(* If need to clip mouse, do so here. (* rrb 3/oct/85, I removed the simple optimization only checks for one
dimension per click, click. This keeps the cursor on the screen even when moving out in the corners.
This might allow simplification of \SETMOUSEXY MACRO that 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 %% FIVE)
(4 $ FOUR)
(6 ~ SIX)
(e E)
(7 & SEVEN)
(d D)
(u U)
(v V)
(0 %) ZERO)
(k K)
(- %)
(p P)
(/ ?)
(\ %| FONT LOOKS)
(LF SAME)
(BS <-)
(3 # THREE)
(2 @ TWO)
(w W)
(q Q)
(s S)
(a A)
(9 %( NINE)
(i I)
(x X)
(o O)
(l L)
(, <)
(' %")
(%] })
(BLANK-MIDDLE OPEN DBK-HELP)
(BLANK-TOP KEYBOARD DBK-META)
(1 ! ONE)
(ESC ESCAPE ->)
(TAB =>)
(f F)
(CTRL PROP'S EDIT)
(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 * EIGHT)
(n N)
(m M)
(LOCK)
(SPACE)
(%[ {)
(= +)
(RSHIFT)
(BLANK-BOTTOM STOP)
(MOVE)
(UNDO)
(UTIL0)
(UTIL1)
(UTIL2 SUPER/SUB)
(UTIL3 CASE)
(UTIL4 STRIKEOUT)
(UTIL5 KEYPAD2)
(UTIL6 KEYPAD3 PGDN)
(UTIL7)
(PAD1 LEFTKEY CAPSLOCK KEYPAD+)
(PAD2 LEFTMIDDLEKEY NUMLOCK KEYPAD-)
(PAD3 MIDDLEKEY SCROLLLOCK KEYPAD*)
(PAD4 RIGHTMIDDLEKEY BREAK KEYPAD/)
(PAD5 RIGHTKEY DOIT PRTSC)
(LEFT RED MOUSERED)
(RIGHT BLUE MOUSEBLUE)
(MIDDLE YELLOW MOUSEYELLOW)
(MARGINS)
(K41 KEYPAD7 HOME)
(K42 KEYPAD8)
(K43 KEYPAD9 PGUP)
(K44 KEYPAD4)
(K45 KEYPAD5)
(K46)
(K47 KEYPAD6)
(K48)
(COPY)
(FIND)
(AGAIN)
(HELP)
(DEF'N EXPAND)
(K4E KEYPAD1 END)
(ALWAYS-ON-1)
(ALWAYS-ON-2)
(CENTER)
(K52 KEYPAD0 INS)
(BOLD)
(ITALICS)
(UNDERLINE)
(SUPERSCRIPT)
(SUBSCRIPT)
(LARGER SMALLER)
(K59 KEYPAD%| KEYPAD.)
(K5A KEYPAD\ KEYPAD,)
(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 (8 8 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 535 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))
(33 (\ %| NOLOCKSHIFT))
(45 (96 ~ NOLOCKSHIFT))
(OPEN METADOWN . METAUP)
(PROP'S CTRLDOWN . CTRLUP)
(SAME METADOWN . METAUP)
(FIND (2,3 2,43 NOLOCKSHIFT))
(UNDO (2,4 2,44 NOLOCKSHIFT))
(STOP (5 7 NOLOCKSHIFT))
(MOVE)
(COPY)
(AGAIN (2,10 2,50 NOLOCKSHIFT))
(CENTER (2,101 2,141 NOLOCKSHIFT))
(BOLD (2,102 2,142 NOLOCKSHIFT))
(ITALICS (2,103 2,143 NOLOCKSHIFT))
(UNDERLINE (2,106 2,146 NOLOCKSHIFT))
(SUPERSCRIPT (2,113 2,153 NOLOCKSHIFT))
(SUBSCRIPT (2,114 2,154 NOLOCKSHIFT))
(LARGER (2,110 2,150 NOLOCKSHIFT))
(DEFAULTS (2,115 2,155 NOLOCKSHIFT))
(93 (27 2,64 NOLOCKSHIFT))
(47 (2,22 2,62 NOLOCKSHIFT))
(31 (2,5 2,45 NOLOCKSHIFT))
(92 (2,1 2,41 NOLOCKSHIFT))
(80 (2,13 2,53 NOLOCKSHIFT))
(FONT (2,112 2,152 NOLOCKSHIFT))))
(RPAQQ \DLIONOSDKEYACTIONS ((56 LOCKTOGGLE)))
(RPAQQ \DORADOKEYACTIONS ((2 (54 ~ NOLOCKSHIFT))
(10 (- - NOLOCKSHIFT))
(13 (\ %| NOLOCKSHIFT))
(14 (10 96 NOLOCKSHIFT))
(33 (27 27 NOLOCKSHIFT))
(45 (← ↑ NOLOCKSHIFT))))
(RPAQQ \DOVEKEYACTIONS ((2 (54 ↑ NOLOCKSHIFT))
(10 (- ← NOLOCKSHIFT))
(33 (27 27 NOLOCKSHIFT))
(56 CTRLDOWN . CTRLUP)
(65 (27 27 NOLOCKSHIFT))
(71 (39 34 NOLOCKSHIFT))
(93 (2,24 2,64 NOLOCKSHIFT))
(108 (96 126 NOLOCKSHIFT))
(DBK-META METADOWN . METAUP)
(DBK-HELP (2,1 2,41 NOLOCKSHIFT))
(SAME METADOWN . METAUP)
(FIND (2,3 2,43 NOLOCKSHIFT))
(UNDO (2,4 2,44 NOLOCKSHIFT))
(STOP (5 7 NOLOCKSHIFT))
(EDIT (2,5 2,45 NOLOCKSHIFT))
(MOVE)
(COPY)
(AGAIN (2,10 2,50 NOLOCKSHIFT))
(CENTER (2,101 2,141 NOLOCKSHIFT))
(BOLD (2,102 2,142 NOLOCKSHIFT))
(ITALICS (2,103 2,143 NOLOCKSHIFT))
(CASE (2,104 2,144 NOLOCKSHIFT))
(STRIKEOUT (2,105 2,145 NOLOCKSHIFT))
(UNDERLINE (2,106 2,146 NOLOCKSHIFT))
(SUPER/SUB (2,107 2,147 NOLOCKSHIFT))
(LARGER (2,110 2,150 NOLOCKSHIFT))
(MARGINS (2,111 2,151 NOLOCKSHIFT))
(LOOKS (2,112 2,152 NOLOCKSHIFT))
(CAPSLOCK LOCKTOGGLE)
(NUMLOCK (2,11 - NOLOCKSHIFT))
(SCROLLLOCK (2,12 180 NOLOCKSHIFT))
(BREAK (2 184 NOLOCKSHIFT))
(DOIT (2,13 2,53 NOLOCKSHIFT))
(KEYPAD7 (2,14 55 NOLOCKSHIFT))
(KEYPAD8 (173 56 NOLOCKSHIFT))
(KEYPAD9 (2,15 57 NOLOCKSHIFT))
(KEYPAD4 (172 52 NOLOCKSHIFT))
(KEYPAD5 (2,16 53 NOLOCKSHIFT))
(KEYPAD6 (174 54 NOLOCKSHIFT))
(KEYPAD1 (2,17 49 NOLOCKSHIFT))
(KEYPAD2 (175 50 NOLOCKSHIFT))
(KEYPAD3 (2,20 51 NOLOCKSHIFT))
(KEYPAD0 (2,21 48 NOLOCKSHIFT))
(KEYPAD%| (%| 46 NOLOCKSHIFT))
(KEYPAD\ (\ 44 NOLOCKSHIFT))
(47 (2,22 2,62 NOLOCKSHIFT))))
(RPAQQ \DOVEOSDKEYACTIONS ((56 LOCKDOWN . LOCKUP)
(36 CTRLDOWN . CTRLUP)
(CAPSLOCK (2,5 2,45 NOLOCKSHIFT))))
(RPAQ? \KEYBOARD.META 256)
(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
\DLIONOSDKEYACTIONS \DOVEKEYACTIONS \DOVEOSDKEYACTIONS)
)
(* 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])
)
(DEFINEQ
(SETUP.OFFICE.KEYBOARD
[LAMBDA NIL (* jds " 8-Oct-85 16:27")
(SELECTQ (MACHINETYPE)
(DANDELION (MODIFY.KEYACTIONS \DLIONOSDKEYACTIONS))
(DOVE (MODIFY.KEYACTIONS \DOVEOSDKEYACTIONS))
NIL])
)
(* To support office style 1108 & 1186 keyboards)
(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: " 8-Oct-85 17:47")
(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]
[COND
((NEQ (fetch (KEYBOARDEVENT WU) of RPTR)
(fetch (KEYBOARDEVENT WU) of \LASTKEYSTATE))
(\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 " 3-Oct-85 11:44")
(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) (* rrb " 3-Oct-85 11:44")
(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 \DOMOUSECHORDING
\PERIODIC.INTERRUPTFRAME \TIMER.INTERRUPTFRAME \DOBUFFEREDTRANSITIONS \DOTRANSITIONS
\DECODETRANSITION \EVENTKEYS)
]
(DECLARE: DONTCOPY
(ADDTOVAR INEWCOMS (ALLOCAL (ADDVARS (LOCKEDFNS \KEYHANDLER \KEYHANDLER1 \DOMOUSECHORDING
\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 (7435 13071 (BKSYSCHARCODE 7445 . 7758) (\CLEARSYSBUF 7760 . 8269) (\GETKEY 8271 . 9096)
(\NSYSBUFCHARS 9098 . 9696) (\SAVESYSBUF 9698 . 10937) (\SYSBUFP 10939 . 11258) (\GETSYSBUF 11260 .
11441) (\PUTSYSBUF 11443 . 12233) (\PEEKSYSBUF 12235 . 13069)) (14024 44881 (\KEYBOARDINIT 14034 .
15452) (\KEYBOARDEVENTFN 15454 . 17331) (\ALLOCLOCKED 17333 . 17825) (\SETIOPOINTERS 17827 . 22828) (
\KEYBOARDOFF 22830 . 23063) (\KEYBOARDON 23065 . 23295) (\KEYHANDLER 23297 . 23428) (\KEYHANDLER1
23430 . 29157) (\RESETKEYBOARD 29159 . 30392) (\DOMOUSECHORDING 30394 . 33797) (\DOTRANSITIONS 33799
. 34478) (\DECODETRANSITION 34480 . 39186) (MOUSECHORDWAIT 39188 . 39698) (\TRACKCURSOR 39700 . 44879
)) (60806 69551 (KEYACTION 60816 . 61326) (KEYACTIONTABLE 61328 . 61604) (\KEYACTION1 61606 . 66189) (
KEYDOWNP 66191 . 66462) (\KEYNAMETONUMBER 66464 . 67049) (MODIFY.KEYACTIONS 67051 . 67455) (METASHIFT
67457 . 68289) (SHIFTDOWNP 68291 . 69549)) (69552 69852 (SETUP.OFFICE.KEYBOARD 69562 . 69850)) (71415
75366 (\SHOWCOLORCURSOR 71425 . 75364)) (76248 77174 (\INIT.KEYBOARD.STREAM 76258 . 77172)) (77428
84271 (\DOBUFFEREDTRANSITIONS 77438 . 83494) (\TIMER.INTERRUPTFRAME 83496 . 84049) (
\PERIODIC.INTERRUPTFRAME 84051 . 84269)) (84520 95082 (ADJUSTCURSORPOSITION 84530 . 85008) (
CREATEPOSITION 85010 . 85209) (CURSOR 85211 . 86180) (CURSORCREATE 86182 . 87046) (CURSORHOTSPOT 87048
. 87619) (CURSORPOSITION 87621 . 88404) (\SETCURSORPOSITION 88406 . 91461) (FLIPCURSOR 91463 . 91902)
(FLIPCURSORBAR 91904 . 92351) (LASTMOUSEX 92353 . 92677) (LASTMOUSEY 92679 . 93003) (POSITIONP 93005
. 93359) (SETCURSOR 93361 . 95080)) (95083 96441 (GETMOUSESTATE 95093 . 95590) (\EVENTKEYS 95592 .
96439)) (99898 100667 (MACHINETYPE 99908 . 100293) (SETMAINTPANEL 100295 . 100665)) (100693 101580 (
BEEPON 100703 . 101189) (BEEPOFF 101191 . 101578)) (102236 102515 (WITHOUT-INTERRUPTS 102246 . 102513)
))))
STOP