(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED "13-Jun-90 01:19:15" {DSK}local>lde>lispcore>library>VT100KP.;2 21739 changes to%: (VARS VT100KPCOMS) previous date%: " 7-Dec-87 15:46:07" {DSK}local>lde>lispcore>library>VT100KP.;1) (* ; " Copyright (c) 1985, 1987, 1990 by Venue & 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"))) (* ;; "Nuke CHATMENU so CHATMENUITEMS will reflect this change") (VARS CHATMENU))) (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 'REPLACE WINDOW)) (SETQ TY (BOTTOMOFGRIDCOORD 1 GRIDSPEC)) (DRAWLINE 0 TY (LEFTOFGRIDCOORD 3 GRIDSPEC) TY 1 'REPLACE WINDOW) (SETQ TX (LEFTOFGRIDCOORD 1 GRIDSPEC)) (DRAWLINE TX (BOTTOMOFGRIDCOORD 1 GRIDSPEC) TX 248 1 'REPLACE WINDOW) (SETQ TX (LEFTOFGRIDCOORD 2 GRIDSPEC)) (DRAWLINE TX 0 TX 248 1 'REPLACE WINDOW) (SETQ TX (LEFTOFGRIDCOORD 3 GRIDSPEC)) (DRAWLINE TX 0 TX 248 1 '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 '(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 '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 'INVERT 'REPLACE NIL (create REGION LEFT _ (IPLUS (fetch (REGION LEFT) of BR) 1) BOTTOM _ (IPLUS (LRSH (IDIFFERENCE (fetch (REGION HEIGHT) of BR) (FONTPROP FONT 'HEIGHT)) 1) (fetch (REGION BOTTOM) of BR)) WIDTH _ (IDIFFERENCE (fetch (REGION WIDTH) of BR) 2) HEIGHT _ (FONTPROP FONT 'HEIGHT] (CENTERPRINTINREGION (CAR LABEL) BR WINDOW)) (SETQ BR (BOTTOMHALFREGION TMP)) [BITBLT WINDOW NIL NIL WINDOW NIL NIL NIL NIL 'INVERT '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 'HEIGHT)) 1)) WIDTH _ (IDIFFERENCE (fetch (REGION WIDTH) of BR) 2) HEIGHT _ (FONTPROP FONT 'HEIGHT] (CENTERPRINTINREGION "Open Line" BR WINDOW) (SETQ BR (BOTTOMHALFREGION TMP1)) [BITBLT WINDOW NIL NIL WINDOW NIL NIL NIL NIL 'INVERT '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 'HEIGHT)) 1)) WIDTH _ (IDIFFERENCE (fetch (REGION WIDTH) of BR) 2) HEIGHT _ (FONTPROP FONT 'HEIGHT] (CENTERPRINTINREGION "Subs" BR WINDOW) (SETQ BR (GRIDBOXREGION 0 4 GRIDSPEC)) (BITBLT WINDOW NIL NIL WINDOW NIL NIL NIL NIL 'INVERT '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 'DSP) NIL) (BITBLT KPARROWSBM 0 0 WINDOW (LEFTOFGRIDCOORD 0 GRIDSPEC) (BOTTOMOFGRIDCOORD 5 GRIDSPEC) NIL NIL 'INPUT '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 '(HELVETICA 18 BRR] [LFONT (FONTCREATE '(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 'INPUT 'REPLACE) (OR WINDOW (WINDOWPROP KPWINDOW 'BUTTONEVENTFN '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 'INVERT DSP)) (T (DSPSOURCETYPE '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 '(UP DOWN LEFT RIGHT)) (COND (CMODE (SELECTQ VALUE (UP "OA") (DOWN "OB") (RIGHT "OC") (LEFT "OD") "")) (T (SELECTQ VALUE (UP "") (DOWN "") (RIGHT "") (LEFT "") ""] (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%: "18-Nov-85 14:15") (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)) 'CHATSTATE)) VT100.STATE REGION VALUE GX GY) (COND ((MOUSESTATE UP) (RETURN)) ((NOT (INSIDEP (DSPCLIPPINGREGION NIL WINDOW) X Y)) (MENU (create MENU ITEMS _ '(("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 'INVERT 'REPLACE NIL REGION) (SETQ VALUE (KPCHARFROMXY X Y)) (UNTILMOUSESTATE UP) (BITBLT WINDOW NIL NIL WINDOW NIL NIL NIL NIL 'INVERT '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]) ) (RPAQQ KPARROWSBM #*(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-FROM-LIST 24 (QUOTE POINTER) 0 (QUOTE (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")) (* ;; "Nuke CHATMENU so CHATMENUITEMS will reflect this change") (RPAQQ CHATMENU NIL) (PUTPROPS VT100KP COPYRIGHT ("Venue & Xerox Corporation" 1985 1987 1990)) (DECLARE%: DONTCOPY (FILEMAP (NIL (940 18860 (BOTTOMHALFREGION 950 . 1443) (BOXKEYPAD 1445 . 2281) (GETEDTKEYPAD 2283 . 8102) (GETKEYPAD 8104 . 11361) (GRIDBOXREGION 11363 . 11824) (INVERTPRINT 11826 . 12028) (KPCHARFROMXY 12030 . 12579) (TOPHALFREGION 12581 . 13189) (VT100KPCODE 13191 . 16062) (VT100KPFN 16064 . 18592) ( VTCHAT.KPAPPLMODE 18594 . 18858))))) STOP