(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP" BASE 10)
(FILECREATED "26-Sep-87 15:53:10" {DSK}<OST>ANSIKEYPAD.;17 18638
changes to%: (FNS ANSI-KeyPad-Keystroke)
(VARS ANSIKEYPADCOMS)
previous date%: "25-Sep-87 16:16:26" {DSK}<OST>ANSIKEYPAD.;12)
(PRETTYCOMPRINT ANSIKEYPADCOMS)
(RPAQQ ANSIKEYPADCOMS ((PROP MAKEFILE-ENVIRONMENT ANSIKEYPAD)
(PROP FILETYPE ANSIKEYPAD)
(FILES (SOURCE)
ANSIKEYPADDATA)
(FNS ANSI-KeyPad-ButtonDownFn ANSI-KeyPad-ButtonEventFn
ANSI-KeyPad-CursorMovedFn ANSI-KeyPad-CursorOutFn
ANSI-KeyPad-Invert-KeyRegion ANSI-KeyPad-KeyRegion-In-Tree
ANSI-KeyPad-KeyRegion-On-Window ANSI-KeyPad-Keystroke
ANSI-KeyPad-Make-KeyPad-Window ANSI-KeyPad-Timer
ANSI-KeyPad-Which-KeyRegion)
[INITVARS (ANSI-Chat-Menu-Items '(("ANSI Keypad" (
ANSI-KeyPad-Make-KeyPad-Window
)
"Brings up an ANSI keypad"]
(GLOBALVARS ANSI-Chat-Menu-Items)
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
CHATDECLS ANSICHATDECLS))))
(PUTPROPS ANSIKEYPAD MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP" :BASE 10))
(PUTPROPS ANSIKEYPAD FILETYPE TCOMPL)
(FILESLOAD (SOURCE)
ANSIKEYPADDATA)
(DEFINEQ
(ANSI-KeyPad-ButtonDownFn
[LAMBDA (Window) (* ; "Edited 5-Sep-87 16:50 by R.Beeman")
(WITH.MONITOR
(WINDOWPROP Window 'MouseMonitor)
(LET ((PromptProcess (WINDOWPROP Window 'PromptProcess))
SelectedKey)
(TOTOPW Window)
(if (NOT (WINDOWPROP Window 'SelectionInProgress T))
then (WINDOWPROP Window 'AlreadyPrompt NIL)
[WINDOWPROP Window 'SelectedKey (SETQ SelectedKey (ANSI-KeyPad-Which-KeyRegion
Window
(LASTMOUSEX Window)
(LASTMOUSEY Window]
(if SelectedKey
then (ANSI-KeyPad-Invert-KeyRegion Window SelectedKey)
(WINDOWPROP Window 'PromptTimer (SETUPTIMER 1500 (WINDOWPROP Window
'PromptTimer)
'MILLISECONDS))
(if (NULL PromptProcess)
then (WINDOWPROP Window 'PromptProcess (ADD.PROCESS '(
ANSI-KeyPad-Timer
) 'WINDOW
Window 'NAME
'KeyPad-Timer))
else (if (AND (PROCESSP PromptProcess)
(WINDOWPROP Window 'WakeEvent))
then (NOTIFY.EVENT (WINDOWPROP Window 'WakeEvent)
T)
else (RESTART.PROCESS PromptProcess])
(ANSI-KeyPad-ButtonEventFn
[LAMBDA (Window) (* ; "Edited 5-Sep-87 16:05 by R.Beeman")
(if (NOT (MOUSESTATE UP))
then (ADD.PROCESS (LIST (FUNCTION ANSI-KeyPad-ButtonDownFn)
(KWOTE Window)))
else (WITH.MONITOR
(WINDOWPROP Window 'MouseMonitor)
(WINDOWPROP Window 'SelectionInProgress NIL)
(LET [(SelectedKey (WINDOWPROP Window 'SelectedKey]
(if SelectedKey
then (WINDOWPROP Window 'SelectedKey NIL)
(ANSI-KeyPad-Invert-KeyRegion Window SelectedKey)
(ANSI-KeyPad-Keystroke Window SelectedKey)
(if (WINDOWPROP Window 'AlreadyPrompt)
then (PROMPTPRINT)
else (if (AND (PROCESSP (WINDOWPROP Window 'PromptProcess))
(WINDOWPROP Window 'WakeEvent))
then (NOTIFY.EVENT (WINDOWPROP Window 'WakeEvent)
T])
(ANSI-KeyPad-CursorMovedFn
[LAMBDA (Window) (* ; "Edited 5-Sep-87 16:34 by R.Beeman")
(WITH.MONITOR
(WINDOWPROP Window 'MouseMonitor)
(if (WINDOWPROP Window 'SelectionInProgress)
then [LET* [(SelectedKey (WINDOWPROP Window 'SelectedKey))
(PromptProcess (WINDOWPROP Window 'PromptProcess))
(NewKey (ANSI-KeyPad-Which-KeyRegion Window (LASTMOUSEX Window)
(LASTMOUSEY Window]
(if (NOT (EQ SelectedKey NewKey))
then (if (WINDOWPROP Window 'AlreadyPrompt NIL)
then (PROMPTPRINT))
(ANSI-KeyPad-Invert-KeyRegion Window SelectedKey)
(WINDOWPROP Window 'SelectedKey NewKey)
(ANSI-KeyPad-Invert-KeyRegion Window NewKey)
(WINDOWPROP Window 'PromptTimer (SETUPTIMER 1500 (WINDOWPROP
Window
'PromptTimer)
'MILLISECONDS))
(if (NULL PromptProcess)
then (WINDOWPROP Window 'PromptProcess (ADD.PROCESS '(
ANSI-KeyPad-Timer
) 'WINDOW
Window 'NAME
'KeyPad-Timer))
else (if (AND (PROCESSP PromptProcess)
(WINDOWPROP Window 'WakeEvent))
then (NOTIFY.EVENT (WINDOWPROP Window 'WakeEvent)
T)
else (RESTART.PROCESS PromptProcess]
(if (MOUSESTATE UP)
then (ADD.PROCESS (LIST (FUNCTION ANSI-KeyPad-ButtonEventFn)
(KWOTE Window])
(ANSI-KeyPad-CursorOutFn
[LAMBDA (Window) (* ; "Edited 5-Sep-87 16:23 by R.Beeman")
(WITH.MONITOR (WINDOWPROP Window 'MouseMonitor)
(if (WINDOWPROP Window 'SelectionInProgress NIL)
then (if (WINDOWPROP Window 'AlreadyPrompt)
then (PROMPTPRINT))
(ANSI-KeyPad-Invert-KeyRegion Window (WINDOWPROP Window 'SelectedKey NIL))
(if (AND (PROCESSP (WINDOWPROP Window 'PromptProcess))
(WINDOWPROP Window 'WakeEvent))
then (NOTIFY.EVENT (WINDOWPROP Window 'WakeEvent)
T])
(ANSI-KeyPad-Invert-KeyRegion
[LAMBDA (Window KeyRegion) (* ; "Edited 5-Sep-87 17:11 by R.Beeman")
(if (ANSI-KeyPad-KeyRegion-On-Window Window KeyRegion)
then (LET ((Region (fetch (KeyRegion Region) of KeyRegion)))
(TOTOPW Window)
(BITBLT (fetch (KeyRegion Mask) of KeyRegion)
0 0 Window (fetch (REGION LEFT) of Region)
(fetch (REGION BOTTOM) of Region)
NIL NIL 'MASK 'INVERT BLACKSHADE])
(ANSI-KeyPad-KeyRegion-In-Tree
[LAMBDA (Tree Left Bottom Width Height X Y) (* ; "Edited 5-Sep-87 16:04 by R.Beeman")
(if (CDR Tree)
then [if (> Height Width)
then (LET* ((HalfHeight (IQUOTIENT Height 2))
(Split (+ Bottom HalfHeight)))
(if (> Split Y)
then (ANSI-KeyPad-KeyRegion-In-Tree (CAR Tree)
Left Bottom Width HalfHeight X Y)
else (ANSI-KeyPad-KeyRegion-In-Tree (CDR Tree)
Left Split Width HalfHeight X Y)))
else (LET* ((HalfWidth (IQUOTIENT Width 2))
(Split (+ Left HalfWidth)))
(if (> Split X)
then (ANSI-KeyPad-KeyRegion-In-Tree (CAR Tree)
Left Bottom HalfWidth Height X Y)
else (ANSI-KeyPad-KeyRegion-In-Tree (CDR Tree)
Split Bottom HalfWidth Height X Y]
else (CAR Tree])
(ANSI-KeyPad-KeyRegion-On-Window
[LAMBDA (Window KeyRegion) (* ; "Edited 5-Sep-87 17:16 by R.Beeman")
(AND (WINDOWP Window)
(type? KeyRegion KeyRegion)
(FMEMB KeyRegion (WINDOWPROP Window 'KeyRegionsList))
KeyRegion])
(ANSI-KeyPad-Keystroke
[LAMBDA (Window SelectedKey) (* ; "Edited 26-Sep-87 15:52 by R.Beeman")
(LET [(Chat.State (WINDOWPROP (PROCESS.WINDOW (TTY.PROCESS))
'CHATSTATE]
(COND
((type? CHAT.STATE Chat.State)
(LET ((Terminal.State (fetch (CHAT.STATE TERM.STATE) of Chat.State)))
(COND
((type? ANSI-STATE Terminal.State)
(BKSYSBUF (LET ((KeyPadMode (fetch (ANSI-STATE KeyPad) of Terminal.State))
(CursorMode (fetch (ANSI-STATE Cursor) of Terminal.State))
(KeyName (fetch (KeyRegion Name) of SelectedKey)))
(COND
((FMEMB KeyName '(F11 F12 F13))
(SELECTQ KeyName
(F11 "")
(F12 "")
(F13 "%
")
""))
[(FMEMB KeyName '(Up Down Right Left))
(COND
(CursorMode (SELECTQ KeyName
(Up "OA")
(Down "OB")
(Right "OC")
(Left "OD")
""))
(T (SELECTQ KeyName
(Up "[A")
(Down "[B")
(Right "[C")
(Left "[D")
""]
(T (COND
(KeyPadMode (SELECTQ KeyName
(0 "Op")
(1 "Oq")
(2 "Or")
(3 "Os")
(4 "Ot")
(5 "Ou")
(6 "Ov")
(7 "Ow")
(8 "Ox")
(9 "Oy")
(- "Om")
(%, "Ol")
(%. "On")
(Enter "OM")
(PF1 "OP")
(PF2 "OQ")
(PF3 "OR")
(PF4 "OS")
""))
(T (SELECTQ KeyName
(0 "0")
(1 "1")
(2 "2")
(3 "3")
(4 "4")
(5 "5")
(6 "6")
(7 "7")
(8 "8")
(9 "9")
(- "-")
(%. ".")
(%, ",")
(Enter "
")
(PF1 "OP")
(PF2 "OQ")
(PF3 "OR")
(PF4 "OS")
""])
(ANSI-KeyPad-Make-KeyPad-Window
[LAMBDA NIL
(DECLARE (GLOBALVARS ANSI-KeyPad-BitMap ANSI-KeyPad-Region-Data))
(* ; "Edited 9-Sep-87 19:23 by R.Beeman")
(LET ((Window (CREATEW (GETBOXREGION (WIDTHIFWINDOW (BITMAPWIDTH ANSI-KeyPad-BitMap))
(HEIGHTIFWINDOW (BITMAPHEIGHT ANSI-KeyPad-BitMap)
T))
"ANSI KeyPad")))
(BITBLT ANSI-KeyPad-BitMap 0 0 Window)
(WINDOWPROP Window 'KeyRegionsList (CAR ANSI-KeyPad-Region-Data))
(WINDOWPROP Window 'KeyRegionsTree (CDR ANSI-KeyPad-Region-Data))
(WINDOWPROP Window 'MouseMonitor (CREATE.MONITORLOCK 'ANSI-KeyPad-MouseMonitor))
(WINDOWPROP Window 'BUTTONEVENTFN (FUNCTION ANSI-KeyPad-ButtonEventFn))
(WINDOWPROP Window 'CURSOROUTFN (FUNCTION ANSI-KeyPad-CursorOutFn))
(WINDOWPROP Window 'CURSORMOVEDFN (FUNCTION ANSI-KeyPad-CursorMovedFn])
(ANSI-KeyPad-Timer
[LAMBDA NIL (* ; "Edited 5-Sep-87 17:24 by R.Beeman")
(LET* [(Window (PROCESSPROP (THIS.PROCESS)
'WINDOW))
(Lock (WINDOWPROP Window 'MouseMonitor))
(Event (OR (WINDOWPROP Window 'WakeEvent)
(LET [(NewLock (CREATE.EVENT 'MMWakeEvent]
(WINDOWPROP Window 'WakeEvent NewLock)
NewLock]
(WITH.MONITOR Lock (until (OR (NOT (WINDOWPROP Window 'SelectionInProgress))
(TIMEREXPIRED? (WINDOWPROP Window 'PromptTimer)
'MILLISECONDS))
do (MONITOR.AWAIT.EVENT Lock Event (WINDOWPROP Window 'PromptTimer)
T))
(if (AND (WINDOWPROP Window 'SelectionInProgress)
(NOT (WINDOWPROP Window 'AlreadyPrompt T)))
then (PROMPTPRINT)
(printout PROMPTWINDOW "Release mouse button to effect keystroke." T))
(WINDOWPROP Window 'PromptProcess NIL])
(ANSI-KeyPad-Which-KeyRegion
[LAMBDA (Window X Y) (* ; "Edited 5-Sep-87 17:58 by R.Beeman")
(LET [(KeyRegion (LET* ((KeyRegionsTree (WINDOWPROP Window 'KeyRegionsTree))
(Tree (CAR KeyRegionsTree))
(Size (CADR KeyRegionsTree)))
(ANSI-KeyPad-KeyRegion-In-Tree Tree 0 0 Size Size X Y]
(AND KeyRegion [NOT (ZEROP (LET ((Region (fetch (KeyRegion Region) of KeyRegion)))
(BITMAPBIT (fetch (KeyRegion Mask) of KeyRegion)
(IDIFFERENCE X (fetch (REGION LEFT) of Region))
(IDIFFERENCE Y (fetch (REGION BOTTOM) of Region]
KeyRegion])
)
(RPAQ? ANSI-Chat-Menu-Items '(("ANSI Keypad" (ANSI-KeyPad-Make-KeyPad-Window)
"Brings up an ANSI keypad")))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS ANSI-Chat-Menu-Items)
)
(DECLARE%: EVAL@COMPILE DONTCOPY
(FILESLOAD (SOURCE)
CHATDECLS ANSICHATDECLS)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1759 18305 (ANSI-KeyPad-ButtonDownFn 1769 . 3886) (ANSI-KeyPad-ButtonEventFn 3888 .
5072) (ANSI-KeyPad-CursorMovedFn 5074 . 7499) (ANSI-KeyPad-CursorOutFn 7501 . 8227) (
ANSI-KeyPad-Invert-KeyRegion 8229 . 8829) (ANSI-KeyPad-KeyRegion-In-Tree 8831 . 10052) (
ANSI-KeyPad-KeyRegion-On-Window 10054 . 10351) (ANSI-KeyPad-Keystroke 10353 . 15202) (
ANSI-KeyPad-Make-KeyPad-Window 15204 . 16225) (ANSI-KeyPad-Timer 16227 . 17445) (
ANSI-KeyPad-Which-KeyRegion 17447 . 18303)))))
STOP