(FILECREATED "18-Nov-85 15:52:00" {ERIS}<LISPCORE>LIBRARY>VT100KP.;6 16820
changes to: (VARS VT100KPCOMS KPARROWSBM)
previous date: "18-Nov-85 14:43:30" {ERIS}<LISPCORE>LIBRARY>VT100KP.;5)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT VT100KPCOMS)
(RPAQQ VT100KPCOMS [(FNS BOTTOMHALFREGION BOXKEYPAD GETEDTKEYPAD GETKEYPAD GRIDBOXREGION
INVERTPRINT KPCHARFROMXY TOPHALFREGION VT100KPCODE VT100KPFN
VTCHAT.KPAPPLMODE)
(BITMAPS KPARROWSBM)
(ARRAY KPCHARARRAY)
(VARS EDTKPH EDTKPHI)
(ADDVARS (CHATMENUITEMS ("VT100 Keypad" (GETKEYPAD)
"Brings up a VT100 keypad"])
(DEFINEQ
(BOTTOMHALFREGION
(LAMBDA (REGION) (* ejs: "19-APR-83 12:13")
(* * Function to return upper half of a region)
(create REGION
LEFT ←(fetch (REGION LEFT) of REGION)
WIDTH ←(fetch (REGION WIDTH) of REGION)
HEIGHT ←(LRSH (fetch (REGION HEIGHT) of REGION)
1)
BOTTOM ←(fetch (REGION BOTTOM) of REGION))))
(BOXKEYPAD
(LAMBDA (WINDOW GRIDSPEC) (* ejs: "19-APR-83 13:41")
(* * Box the VT100 keypad)
(PROG (TY TX)
(for Y from 2 to 5
do (SETQ TY (BOTTOMOFGRIDCOORD Y GRIDSPEC))
(DRAWLINE 0 TY 250Q TY 1 (QUOTE REPLACE)
WINDOW))
(SETQ TY (BOTTOMOFGRIDCOORD 1 GRIDSPEC))
(DRAWLINE 0 TY (LEFTOFGRIDCOORD 3 GRIDSPEC)
TY 1 (QUOTE REPLACE)
WINDOW)
(SETQ TX (LEFTOFGRIDCOORD 1 GRIDSPEC))
(DRAWLINE TX (BOTTOMOFGRIDCOORD 1 GRIDSPEC)
TX 370Q 1 (QUOTE REPLACE)
WINDOW)
(SETQ TX (LEFTOFGRIDCOORD 2 GRIDSPEC))
(DRAWLINE TX 0 TX 370Q 1 (QUOTE REPLACE)
WINDOW)
(SETQ TX (LEFTOFGRIDCOORD 3 GRIDSPEC))
(DRAWLINE TX 0 TX 370Q 1 (QUOTE REPLACE)
WINDOW))))
(GETEDTKEYPAD
(LAMBDA (WINDOW) (* ejs: "19-APR-83 14:16")
(* * Function to make an EDT keypad)
(PROG ((GRIDSPEC (create REGION
LEFT ← 1
BOTTOM ← 1
WIDTH ← 50Q
HEIGHT ← 50Q))
(FONT (FONTCREATE (QUOTE (HELVETICA 10Q))))
TMP TMP1 BR)
(CLEARW WINDOW)
(DSPFONT FONT WINDOW)
(for LABEL in EDTKPH do (CENTERPRINTINREGION (CAR LABEL)
(TOPHALFREGION
(GRIDBOXREGION (CAADR LABEL)
(CDADR LABEL)
GRIDSPEC))
WINDOW))
(CENTERPRINTINREGION "Line" (TOPHALFREGION (SETQ TMP (UNIONREGIONS (
GRIDBOXREGION
0 0 GRIDSPEC)
(
GRIDBOXREGION
1 0 GRIDSPEC)
)))
WINDOW)
(CENTERPRINTINREGION "Enter" (TOPHALFREGION (SETQ TMP1
(UNIONREGIONS (GRIDBOXREGION 3 0
GRIDSPEC)
(GRIDBOXREGION 3 1
GRIDSPEC))))
WINDOW)
(CENTERPRINTINREGION "Help" (GRIDBOXREGION 1 4 GRIDSPEC)
WINDOW)
(INVERTPRINT (WINDOWPROP WINDOW (QUOTE DSP))
T)
(for LABEL in EDTKPHI
do (SETQ BR (BOTTOMHALFREGION (GRIDBOXREGION (CAADR LABEL)
(CDADR LABEL)
GRIDSPEC)))
(BITBLT WINDOW NIL NIL WINDOW NIL NIL NIL NIL (QUOTE INVERT)
(QUOTE REPLACE)
NIL
(create REGION
LEFT ←(IPLUS (fetch (REGION LEFT) of BR)
1)
BOTTOM ←(IPLUS (LRSH (IDIFFERENCE (fetch
(REGION HEIGHT)
of BR)
(FONTPROP
FONT
(QUOTE HEIGHT)))
1)
(fetch (REGION BOTTOM) of BR))
WIDTH ←(IDIFFERENCE (fetch (REGION WIDTH) of BR)
2)
HEIGHT ←(FONTPROP FONT (QUOTE HEIGHT))))
(CENTERPRINTINREGION (CAR LABEL)
BR WINDOW))
(SETQ BR (BOTTOMHALFREGION TMP))
(BITBLT WINDOW NIL NIL WINDOW NIL NIL NIL NIL (QUOTE INVERT)
(QUOTE REPLACE)
NIL
(create REGION
LEFT ←(ADD1 (fetch (REGION LEFT) of BR))
BOTTOM ←(IPLUS (fetch (REGION BOTTOM) of BR)
(LRSH (IDIFFERENCE (fetch (REGION HEIGHT)
of BR)
(FONTPROP FONT
(QUOTE HEIGHT)))
1))
WIDTH ←(IDIFFERENCE (fetch (REGION WIDTH) of BR)
2)
HEIGHT ←(FONTPROP FONT (QUOTE HEIGHT))))
(CENTERPRINTINREGION "Open Line" BR WINDOW)
(SETQ BR (BOTTOMHALFREGION TMP1))
(BITBLT WINDOW NIL NIL WINDOW NIL NIL NIL NIL (QUOTE INVERT)
(QUOTE REPLACE)
NIL
(create REGION
LEFT ←(ADD1 (fetch (REGION LEFT) of BR))
BOTTOM ←(IPLUS (fetch (REGION BOTTOM) of BR)
(LRSH (IDIFFERENCE (fetch (REGION HEIGHT)
of BR)
(FONTPROP FONT
(QUOTE HEIGHT)))
1))
WIDTH ←(IDIFFERENCE (fetch (REGION WIDTH) of BR)
2)
HEIGHT ←(FONTPROP FONT (QUOTE HEIGHT))))
(CENTERPRINTINREGION "Subs" BR WINDOW)
(SETQ BR (GRIDBOXREGION 0 4 GRIDSPEC))
(BITBLT WINDOW NIL NIL WINDOW NIL NIL NIL NIL (QUOTE INVERT)
(QUOTE REPLACE)
NIL
(create REGION
LEFT ←(IPLUS (fetch (REGION LEFT) of BR)
2)
BOTTOM ←(IPLUS (fetch (REGION BOTTOM) of BR)
2)
WIDTH ←(IDIFFERENCE (fetch (REGION WIDTH) of BR)
4)
HEIGHT ←(IDIFFERENCE (fetch (REGION HEIGHT) of BR)
4)))
(CENTERPRINTINREGION "Gold" BR WINDOW)
(INVERTPRINT (WINDOWPROP WINDOW (QUOTE DSP))
NIL)
(BITBLT KPARROWSBM 0 0 WINDOW (LEFTOFGRIDCOORD 0 GRIDSPEC)
(BOTTOMOFGRIDCOORD 5 GRIDSPEC)
NIL NIL (QUOTE INPUT)
(QUOTE REPLACE))
(BOXKEYPAD WINDOW GRIDSPEC))))
(GETKEYPAD
(LAMBDA (WINDOW) (* ejs: "13-May-85 16:27")
(* * Function to return a window containing a VT100 keypad)
(PROG (GRIDSPEC (BFONT (FONTCREATE (QUOTE (HELVETICA 22Q BRR))))
(LFONT (FONTCREATE (QUOTE (HELVETICA 12Q BRR))))
(KPWINDOW (OR WINDOW (LET ((POS (GETBOXPOSITION (WIDTHIFWINDOW 240Q)
(HEIGHTIFWINDOW 360Q T))))
(CREATEW (create REGION
LEFT ←(fetch (POSITION
XCOORD)
of POS)
BOTTOM ←(fetch (POSITION
YCOORD)
of POS)
WIDTH ←(WIDTHIFWINDOW 240Q)
HEIGHT ←(HEIGHTIFWINDOW
360Q T))
"VT100 Keypad")))))
(GRID (SETQ GRIDSPEC
(create REGION
LEFT ← 1
BOTTOM ← 1
WIDTH ← 50Q
HEIGHT ← 50Q))
4 6 0 KPWINDOW)
(CLEARW KPWINDOW)
(DSPFONT BFONT KPWINDOW)
(for J from 0 to 2 do (for I from 1 to 3
do (CENTERPRINTINREGION (MKSTRING
(IPLUS (ITIMES J 3)
I))
(GRIDBOXREGION
(SUB1 I)
(ADD1 J)
GRIDSPEC)
KPWINDOW)))
(CENTERPRINTINREGION "0" (UNIONREGIONS (GRIDBOXREGION 0 0 GRIDSPEC)
(GRIDBOXREGION 1 0 GRIDSPEC))
KPWINDOW)
(CENTERPRINTINREGION "--" (GRIDBOXREGION 3 3 GRIDSPEC)
KPWINDOW)
(CENTERPRINTINREGION "." (GRIDBOXREGION 2 0 GRIDSPEC)
KPWINDOW)
(CENTERPRINTINREGION "," (GRIDBOXREGION 3 2 GRIDSPEC)
KPWINDOW)
(DSPFONT LFONT KPWINDOW)
(for I from 0 to 3 do (CENTERPRINTINREGION (CONCAT "PF" (ADD1 I))
(GRIDBOXREGION I 4 GRIDSPEC)
KPWINDOW))
(CENTERPRINTINREGION "ENTER" (UNIONREGIONS (GRIDBOXREGION 3 0 GRIDSPEC)
(GRIDBOXREGION 3 1 GRIDSPEC))
KPWINDOW)
(BITBLT KPARROWSBM 0 0 KPWINDOW (LEFTOFGRIDCOORD 0 GRIDSPEC)
(BOTTOMOFGRIDCOORD 5 GRIDSPEC)
NIL NIL (QUOTE INPUT)
(QUOTE REPLACE))
(OR WINDOW (WINDOWPROP KPWINDOW (QUOTE BUTTONEVENTFN)
(QUOTE VT100KPFN)))
(BOXKEYPAD KPWINDOW GRIDSPEC))))
(GRIDBOXREGION
(LAMBDA (GRIDX GRIDY GRIDSPEC) (* ejs: "18-APR-83 09:53")
(* * Function to return the source system region of a grid box)
(create REGION
LEFT ←(LEFTOFGRIDCOORD GRIDX GRIDSPEC)
BOTTOM ←(BOTTOMOFGRIDCOORD GRIDY GRIDSPEC)
WIDTH ←(fetch (REGION WIDTH) of GRIDSPEC)
HEIGHT ←(fetch (REGION HEIGHT) of GRIDSPEC))))
(INVERTPRINT
(LAMBDA (DSP FLG) (* ejs: "19-APR-83 13:18")
(COND
(FLG (DSPSOURCETYPE (QUOTE INVERT)
DSP))
(T (DSPSOURCETYPE (QUOTE INPUT)
DSP)))))
(KPCHARFROMXY
(LAMBDA (X Y) (* ejs: "19-APR-83 14:17")
(* * Function to convert a mouse click to a VT100 keypad character)
(PROG ((GRIDSPEC (create REGION
LEFT ← 1
BOTTOM ← 1
WIDTH ← 50Q
HEIGHT ← 50Q)))
(RETURN (ELT KPCHARARRAY (IPLUS (GRIDXCOORD X GRIDSPEC)
(ITIMES 4 (GRIDYCOORD Y GRIDSPEC))))))))
(TOPHALFREGION
(LAMBDA (REGION) (* ejs: "19-APR-83 12:13")
(* * Function to return upper half of a region)
(create REGION
LEFT ←(fetch (REGION LEFT) of REGION)
WIDTH ←(fetch (REGION WIDTH) of REGION)
HEIGHT ←(LRSH (fetch (REGION HEIGHT) of REGION)
1)
BOTTOM ←(IPLUS (fetch (REGION BOTTOM) of REGION)
(LRSH (fetch (REGION HEIGHT) of REGION)
1)))))
(VT100KPCODE
(LAMBDA (CHAT.STATE VT100.STATE VALUE) (* ejs: "13-May-85 16:29")
(* * Function to return string for keypad hit)
(PROG ((KPMODE (fetch (VT100.STATE KEYPADMODE) of VT100.STATE))
(CMODE (fetch (VT100.STATE CURSORMODE) of VT100.STATE)))
(RETURN (COND
((FMEMB VALUE (QUOTE (UP DOWN LEFT RIGHT)))
(COND
(CMODE (SELECTQ VALUE
(UP "OA")
(DOWN "OB")
(RIGHT "OC")
(LEFT "OD")
""))
(T (SELECTQ VALUE
(UP "[A")
(DOWN "[B")
(RIGHT "[C")
(LEFT "[D")
""))))
(T (COND
(KPMODE (SELECTQ VALUE
(0 "Op")
(1 "Oq")
(2 "Or")
(3 "Os")
(4 "Ot")
(5 "Ou")
(6 "Ov")
(7 "Ow")
(10Q "Ox")
(11Q "Oy")
(- "Om")
(, "Ol")
(%. "On")
(ENTER "OM")
(PF1 "OP")
(PF2 "OQ")
(PF3 "OR")
(PF4 "OS")
""))
(T (SELECTQ VALUE
(0 "0")
(1 "1")
(2 "2")
(3 "3")
(4 "4")
(5 "5")
(6 "6")
(7 "7")
(10Q "8")
(11Q "9")
(- "-")
(%. ".")
(, ",")
(ENTER "
")
(PF1 "OP")
(PF2 "OQ")
(PF3 "OR")
(PF4 "OS")
"")))))))))
(VT100KPFN
(LAMBDA (WINDOW) (* ejs: "18-Nov-85 14:15")
(PROG ((X (LASTMOUSEX WINDOW))
(Y (LASTMOUSEY WINDOW))
(GRIDSPEC (create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ← 50Q
HEIGHT ← 50Q))
(CHAT.STATE (WINDOWPROP (PROCESS.WINDOW (TTY.PROCESS))
(QUOTE CHATSTATE)))
VT100.STATE REGION VALUE GX GY)
(COND
((MOUSESTATE UP)
(RETURN))
((NOT (INSIDEP (DSPCLIPPINGREGION NIL WINDOW)
X Y))
(MENU (create MENU
ITEMS ←(QUOTE (("EDT Keypad" (GETEDTKEYPAD WINDOW)
"Put up an EDT Keypad")
("Plain Keypad" (GETKEYPAD WINDOW)
"Put up a Plain keypad")))
CENTERFLG ← T))
(RETURN)))
(COND
((type? CHAT.STATE CHAT.STATE)
(SETQ VT100.STATE (fetch (CHAT.STATE TERM.STATE) of CHAT.STATE))
(COND
((NOT (type? VT100.STATE VT100.STATE))
(RETURN))))
(T (RETURN)))
(SETQ GX (GRIDXCOORD X GRIDSPEC))
(SETQ GY (GRIDYCOORD Y GRIDSPEC))
(SETQ REGION (COND
((OR (AND (EQ GX 0)
(EQ GY 0))
(AND (EQ GX 1)
(EQ GY 0)))
(UNIONREGIONS (GRIDBOXREGION 0 0 GRIDSPEC)
(GRIDBOXREGION 1 0 GRIDSPEC)))
((OR (AND (EQ GX 3)
(EQ GY 0))
(AND (EQ GX 3)
(EQ GY 1)))
(UNIONREGIONS (GRIDBOXREGION 3 0 GRIDSPEC)
(GRIDBOXREGION 3 1 GRIDSPEC)))
(T (GRIDBOXREGION GX GY GRIDSPEC))))
(BITBLT WINDOW NIL NIL WINDOW NIL NIL NIL NIL (QUOTE INVERT)
(QUOTE REPLACE)
NIL REGION)
(SETQ VALUE (KPCHARFROMXY X Y))
(UNTILMOUSESTATE UP)
(BITBLT WINDOW NIL NIL WINDOW NIL NIL NIL NIL (QUOTE INVERT)
(QUOTE REPLACE)
NIL REGION)
(BKSYSBUF (VT100KPCODE CHAT.STATE VT100.STATE VALUE)))))
(VTCHAT.KPAPPLMODE
(LAMBDA (CHAT.STATE VT100.STATE FLG) (* ejs: "13-May-85 16:08")
(* * Set or reset keypad application mode)
(replace (VT100.STATE KEYPADMODE) of VT100.STATE with FLG)))
)
(RPAQ KPARROWSBM (READBITMAP))
(160 40
"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@A@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@CH@@@@@@@@CH@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@GL@@@@@@@@CH@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@ON@@@@@@@@CH@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@AOO@@@@@@@@CH@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@CH@@@@@@@@CH@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@CH@@@@@@@@CH@@@@@@@B@@@@@@@@@@@@H@@@"
"@@@@CH@@@@@@@@CH@@@@@@@F@@@@@@@@@@@@L@@@"
"@@@@CH@@@@@@@@CH@@@@@@@N@@@@@@@@@@@@N@@@"
"@@@@CH@@@@@@@@CH@@@@@@AOOOOH@@@@COOOO@@@"
"@@@@CH@@@@@@@@CH@@@@@@COOOOH@@@@COOOOH@@"
"@@@@CH@@@@@@@@CH@@@@@@AOOOOH@@@@COOOO@@@"
"@@@@CH@@@@@@@@CH@@@@@@@N@@@@@@@@@@@@N@@@"
"@@@@CH@@@@@@@@CH@@@@@@@F@@@@@@@@@@@@L@@@"
"@@@@CH@@@@@@@AOO@@@@@@@B@@@@@@@@@@@@H@@@"
"@@@@CH@@@@@@@@ON@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@CH@@@@@@@@GL@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@CH@@@@@@@@CH@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@A@@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@")
(RPAQ KPCHARARRAY (READARRAY 24 (QUOTE POINTER) 0))
(0
0
%.
ENTER
1
2
3
ENTER
4
5
6
,
7
8
9
-
PF1
PF2
PF3
PF4
UP
DOWN
LEFT
RIGHT
NIL
)
(RPAQQ EDTKPH (("Select" (2 . 0))
("Word" (0 . 1))
("Eol" (1 . 1))
("Char" (2 . 1))
("Advance" (0 . 2))
("Backup" (1 . 2))
("Cut" (2 . 2))
("Del C" (3 . 2))
("Page" (0 . 3))
("Sect" (1 . 3))
("Append" (2 . 3))
("Del W" (3 . 3))
("Fndnxt" (2 . 4))
("Del L" (3 . 4))))
(RPAQQ EDTKPHI (("Reset" (2 . 0))
("Case" (0 . 1))
("Del Eol" (1 . 1))
("Specins" (2 . 1))
("Bottom" (0 . 2))
("Top" (1 . 2))
("Paste" (2 . 2))
("Und C" (3 . 2))
("Cmnd" (0 . 3))
("Fill" (1 . 3))
("Replace" (2 . 3))
("Und W" (3 . 3))
("Find" (2 . 4))
("Und L" (3 . 4))))
(ADDTOVAR CHATMENUITEMS ("VT100 Keypad" (GETKEYPAD)
"Brings up a VT100 keypad"))
(PUTPROPS VT100KP COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (687 14113 (BOTTOMHALFREGION 697 . 1145) (BOXKEYPAD 1147 . 2031) (GETEDTKEYPAD 2033 .
6307) (GETKEYPAD 6309 . 8730) (GRIDBOXREGION 8732 . 9169) (INVERTPRINT 9171 . 9415) (KPCHARFROMXY 9417
. 9857) (TOPHALFREGION 9859 . 10392) (VT100KPCODE 10394 . 11818) (VT100KPFN 11820 . 13858) (
VTCHAT.KPAPPLMODE 13860 . 14111)))))
STOP