(FILECREATED "23-May-85 13:39:09" {DSK}<LISPFILES>VT100KP.;2 16160
previous date: "13-May-85 16:51:40" {DSK}<LISPFILES>VT100KP.;1)
(* 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 168 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 248 1 (QUOTE REPLACE)
WINDOW)
(SETQ TX (LEFTOFGRIDCOORD 2 GRIDSPEC))
(DRAWLINE TX 0 TX 248 1 (QUOTE REPLACE)
WINDOW)
(SETQ TX (LEFTOFGRIDCOORD 3 GRIDSPEC))
(DRAWLINE TX 0 TX 248 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 ← 40
HEIGHT ← 40))
(FONT (FONTCREATE (QUOTE (HELVETICA 8))))
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 18 BRR))))
(LFONT (FONTCREATE (QUOTE (HELVETICA 10 BRR))))
(KPWINDOW (OR WINDOW (LET ((POS (GETBOXPOSITION (WIDTHIFWINDOW 160)
(HEIGHTIFWINDOW 240 T))))
(CREATEW (create REGION
LEFT ←(fetch (POSITION XCOORD) of POS)
BOTTOM ←(fetch (POSITION YCOORD) of POS)
WIDTH ←(WIDTHIFWINDOW 160)
HEIGHT ←(HEIGHTIFWINDOW 240 T))
"VT100 Keypad")))))
(GRID (SETQ GRIDSPEC
(create REGION
LEFT ← 1
BOTTOM ← 1
WIDTH ← 40
HEIGHT ← 40))
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 ← 40
HEIGHT ← 40)))
(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")
(8 "Ox")
(9 "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")
(8 "8")
(9 "9")
(- "-")
(%. ".")
(, ",")
(ENTER "
")
(PF1 "OP")
(PF2 "OQ")
(PF3 "OR")
(PF4 "OS")
"")))))))))
(VT100KPFN
(LAMBDA (WINDOW) (* ejs: "13-May-85 16:50")
(PROG ((X (LASTMOUSEX WINDOW))
(Y (LASTMOUSEY WINDOW))
(GRIDSPEC (create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ← 40
HEIGHT ← 40))
(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))
(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 (589 13423 (BOTTOMHALFREGION 599 . 1024) (BOXKEYPAD 1026 . 1861) (GETEDTKEYPAD 1863 .
5794) (GETKEYPAD 5796 . 8156) (GRIDBOXREGION 8158 . 8572) (INVERTPRINT 8574 . 8787) (KPCHARFROMXY 8789
. 9208) (TOPHALFREGION 9210 . 9702) (VT100KPCODE 9704 . 11129) (VT100KPFN 11131 . 13168) (
VTCHAT.KPAPPLMODE 13170 . 13421)))))
STOP