(FILECREATED "12-Nov-85 20:32:34" {ERIS}<LISPCORE>LIBRARY>VTCHAT.;5 20803 changes to: (VARS VTCHATRECORDS VTCHATCOMS) previous date: "12-Nov-85 20:15:23" {ERIS}<LISPCORE>LIBRARY>VTCHAT.;4) (* Copyright (c) 1983, 1984, 1985 by sSCHLUMBERGER TECHNOLOGY CORPORATION. All rights reserved.) (PRETTYCOMPRINT VTCHATCOMS) (RPAQQ VTCHATCOMS ((RECORDS * VTCHATRECORDS) (COMS (* VT100 emulator) (FNS VTCHAT.ADDRESS VTCHAT.ATTRIBUTES VTCHAT.DECLFONT VTCHAT.DOCOMMAND VTCHAT.HANDLECHARACTER VTCHAT.CLEARMODES VTCHAT.REPORT VTCHAT.RESETMODE VTCHAT.RESTORE VTCHAT.REVERSE.INDEX VTCHAT.SAVE VTCHAT.SEQUENCE VTCHAT.SETMARGINS VTCHAT.SETMODE VTCHAT.STATE VTCHAT.STATUS)) (VARS (CHATFONT (FONTCREATE (QUOTE (GACHA 12 MRR)))) (GRAPHICSFONT CHATFONT) (VTCHAT.TERM.IDENTITY.STRING "[?1;2c")) (ADDVARS (CHAT.DRIVERTYPES (VT100 VTCHAT.HANDLECHARACTER VTCHAT.STATE))) (FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES) VT100KP))) (RPAQQ VTCHATRECORDS (VT100SAVE VT100.STATE)) [DECLARE: EVAL@COMPILE (RECORD VT100SAVE (CURSORPOS CHARATTR CHARSET)) (DATATYPE VT100.STATE ((DINGED FLAG) (EATLF FLAG) (EATCRLF FLAG) (EATTOCRLF FLAG) (AUTOLF FLAG) (BLINKMODE FLAG) (BRIGHTMODE FLAG) (SMOOTHSCROLL FLAG) (SIFONT POINTER) (KEYPADMODE FLAG) (CURSORMODE FLAG) (SOFONT POINTER) (PARAMCOUNT WORD) (ADDRESSING WORD) ESCAPESEQUENCE VT100MEM PARAMARRAY RELORIGIN INVERTFLG CSTERM) VT100MEM ←(create VT100SAVE CURSORPOS ←(create POSITION XCOORD ← 1 YCOORD ← 1)) PARAMARRAY ←(ARRAY 12 (QUOTE SMALLP) 0 1)) ] (/DECLAREDATATYPE (QUOTE VT100.STATE) (QUOTE (FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER FLAG FLAG POINTER WORD WORD POINTER POINTER POINTER POINTER POINTER POINTER)) (QUOTE ((VT100.STATE 0 (FLAGBITS . 0)) (VT100.STATE 0 (FLAGBITS . 16)) (VT100.STATE 0 (FLAGBITS . 32)) (VT100.STATE 0 (FLAGBITS . 48)) (VT100.STATE 0 (FLAGBITS . 64)) (VT100.STATE 0 (FLAGBITS . 80)) (VT100.STATE 0 (FLAGBITS . 96)) (VT100.STATE 0 (FLAGBITS . 112)) (VT100.STATE 0 POINTER) (VT100.STATE 2 (FLAGBITS . 0)) (VT100.STATE 2 (FLAGBITS . 16)) (VT100.STATE 2 POINTER) (VT100.STATE 4 (BITS . 15)) (VT100.STATE 5 (BITS . 15)) (VT100.STATE 6 POINTER) (VT100.STATE 8 POINTER) (VT100.STATE 10 POINTER) (VT100.STATE 12 POINTER) (VT100.STATE 14 POINTER) (VT100.STATE 16 POINTER))) (QUOTE 18)) (* VT100 emulator) (DEFINEQ (VTCHAT.ADDRESS (LAMBDA (CHAT.STATE VT100.STATE ROW COLUMN) (* ejs: "12-May-85 18:23") (* Do absolute positioning) (with CHAT.STATE CHAT.STATE (with VT100.STATE VT100.STATE (COND (RELORIGIN (SETQ ROW (IPLUS ROW TOPMARGIN)) (COND ((ILESSP ROW TOPMARGIN) (SETQ ROW TOPMARGIN)) ((IGREATERP ROW BOTTOMMARGIN) (SETQ ROW BOTTOMMARGIN))))) (MOVETO (SETQ XPOS (IMIN (ITIMES (SUB1 COLUMN) FONTWIDTH) (IDIFFERENCE TTYWIDTH FONTWIDTH))) (SETQ YPOS (IMAX FONTDESCENT (IDIFFERENCE HOMEPOS (ITIMES (SUB1 ROW) FONTHEIGHT)))) DSP))) T)) (VTCHAT.ATTRIBUTES [LAMBDA (CHAT.STATE VT100.STATE ATTRARRAY ATTRCOUNT) (* ejs: "12-May-85 18:24") (* * Function to do character attribute setting) (with CHAT.STATE CHAT.STATE (with VT100.STATE VT100.STATE (bind ATTRS for A from ATTRCOUNT to 1 by -1 do (SELECTQ (ELT ATTRARRAY A) (0 (push ATTRS (QUOTE NORMAL))) (1 (push ATTRS (QUOTE BRIGHT))) (4 (push ATTRS (QUOTE BLINK))) (5 (push ATTRS (QUOTE UNDERLINE))) (7 (push ATTRS (QUOTE INVERSE))) NIL) finally (TERM.MODIFY.ATTRIBUTES CHAT.STATE ATTRS]) (VTCHAT.DECLFONT [LAMBDA (CHAT.STATE VT100.STATE CHAR) (* ejs: "12-May-85 18:22") (with CHAT.STATE CHAT.STATE (with VT100.STATE VT100.STATE (* SET (SELECTC FONTDECL ((CHARCODE %() (QUOTE SIFONT)) ((CHARCODE %)) (QUOTE SOFONT)) (QUOTE SOFONT)) (SELECTC CHAR ((CHARCODE A) CHATFONT) ((CHARCODE B) CHATFONT) (48 GRAPHICSFONT) CHATFONT)) (DSPFONT (EVAL CURRENTFONT) WINDOW) (SETQ FONTDECL NIL) (SETQ ESCAPESEQUENCE NIL]) (VTCHAT.DOCOMMAND (LAMBDA (CHAT.STATE VT100.STATE CHAR) (* ejs: "26-Aug-85 11:50") (* * Function called when an escape or control sequence has been terminated by CHAR) (with CHAT.STATE CHAT.STATE (with VT100.STATE VT100.STATE (PROG (STAYESCAPE (PARAM1 (COND ((ZEROP ESCAPESEQUENCE) 0) (T (ELT PARAMARRAY 1)))) (PARAM2 (COND ((ILESSP ESCAPESEQUENCE 2) 0) (T (ELT PARAMARRAY 2))))) (SELCHARQ CHAR (%[ (* ESC-LeftBracket is the control sequence introducer) (SETQ CSTERM 100Q) (SETQ ESCAPESEQUENCE 1) (SETQ STAYESCAPE T) (SETA PARAMARRAY 1 0)) (7 (* ESC 7 -> Save parameters) (VTCHAT.SAVE CHAT.STATE VT100.STATE)) (10Q (* ESC 10Q -> Restore parameters) (VTCHAT.RESTORE CHAT.STATE VT100.STATE)) (A (* ESC %[ Pn A -> Move up; param1 indicates how far) (TERM.UP CHAT.STATE (COND ((ZEROP PARAM1) 1) (T PARAM1)))) (B (* ESC %[ Pn B -> Move down; param1 indicates how far) (TERM.GODOWN CHAT.STATE (COND ((ZEROP PARAM1) 1) (T PARAM1)))) (C (* ESC %[ Pn C -> Move right; param1 indicates how far) (TERM.RIGHT CHAT.STATE (COND ((ZEROP PARAM1) 1) (T PARAM1)))) (D (COND ((EQ 0 ESCAPESEQUENCE) (* ESC D -> index) (TERM.DOWN CHAT.STATE)) (T (* ESC %[ Pn D -> cursor backwards) (TERM.LEFT CHAT.STATE (COND ((ZEROP PARAM1) 1) (T PARAM1)))))) (E (* ESC E -> Do CRLF) (MOVETO (SETQ XPOS 0) YPOS DSP) (TERM.DOWN CHAT.STATE)) ((H f) (COND ((AND (EQ CHAR (CHARCODE H)) (EQ 0 ESCAPESEQUENCE)) (* ESC H -> Set tab at position) (TERM.SET.TAB CHAT.STATE (IQUOTIENT XPOS FONTWIDTH))) ((NOT (EQ 0 ESCAPESEQUENCE)) (* ESC %[ Pn H -> Cursor addressing) (VTCHAT.ADDRESS CHAT.STATE VT100.STATE (COND ((OR (ZEROP PARAM1) (NULL PARAM1)) 1) (T PARAM1)) (COND ((OR (ZEROP PARAM2) (NULL PARAM2)) 1) (T PARAM2)))))) (J (* Erase in display; param1 indicates mode) (TERM.ERASE.IN.DISPLAY CHAT.STATE (COND ((OR (ZEROP PARAM1) (NULL PARAM1)) 0) (T PARAM1)))) (K (* Erase in line; param1 indicates mode) (TERM.ERASE.IN.LINE CHAT.STATE (COND ((OR (ZEROP PARAM1) (NULL PARAM1)) 0) (T PARAM1)))) (M (* Reverse Index) (VTCHAT.REVERSE.INDEX CHAT.STATE VT100.STATE) ) (Z (* What are you?) (TERM.IDENTIFY.SELF CHAT.STATE)) (< NIL) (= (* Enter keypad application mode) (VTCHAT.KPAPPLMODE CHAT.STATE VT100.STATE T)) (> (* Leave keypad application mode) (VTCHAT.KPAPPLMODE CHAT.STATE VT100.STATE NIL)) (c (* What are you?) (TERM.IDENTIFY.SELF CHAT.STATE)) (h (* Set modes) (VTCHAT.SETMODE CHAT.STATE VT100.STATE PARAMARRAY ESCAPESEQUENCE)) (l (* Reset mode) (VTCHAT.RESETMODE CHAT.STATE VT100.STATE PARAMARRAY ESCAPESEQUENCE)) (m (* Set char attributes) (VTCHAT.ATTRIBUTES CHAT.STATE VT100.STATE PARAMARRAY ESCAPESEQUENCE) ) (n (* Status report) (VTCHAT.STATUS CHAT.STATE VT100.STATE PARAM1) ) (r (* Set scrolling margins) (VTCHAT.SETMARGINS CHAT.STATE VT100.STATE (COND ((ZEROP PARAM1) 1) (T PARAM1)) (COND ((ZEROP PARAM2) 30Q) (T PARAM2)))) (x (VTCHAT.REPORT CHAT.STATE VT100.STATE)) (COND ((ZEROP ESCAPESEQUENCE) (printout PROMPTWINDOW "ESC " (CHARACTER CHAR) T)) (T (printout PROMPTWINDOW "ESC[" PARAM1 ";" PARAM2 " " (CHARACTER CHAR) T)))) (OR STAYESCAPE (SETQ ESCAPESEQUENCE NIL))))))) (VTCHAT.HANDLECHARACTER (LAMBDA (CHAR CHAT.STATE VT100.STATE) (* ejs: "26-Aug-85 09:45") (* Here and/or below) (with CHAT.STATE CHAT.STATE (with VT100.STATE VT100.STATE (PROG NIL (COND ((EQ CHAR (CHARCODE BELL)) (RETURN (COND ((NOT DINGED) (APPLY* INVERTWINDOWFN WINDOW) (* Complement window) (SETQ DINGED T)))))) (COND (DINGED (APPLY* INVERTWINDOWFN WINDOW) (SETQ DINGED NIL))) (COND ((EQ CHAR (CHARCODE ↑%[)) (SETQ AUTOLF NIL))) (SELCHARQ CHAR ((LF FF ↑K) (* Line Feed) (COND ((NOT EATLF) (TERM.DOWN CHAT.STATE)) (T (SETQ EATLF NIL)))) (↑I (* Tab) (TERM.TAB CHAT.STATE)) (CR (* Carriage return) (SETQ EATTOCRLF NIL) (SETQ EATLF T) (TERM.NEWLINE CHAT.STATE)) (BS (* Back space) (TERM.LEFT CHAT.STATE 1)) ((↑X ↑Z) (* Cancel --resets modes) (VTCHAT.CLEARMODES CHAT.STATE VT100.STATE)) (↑N (DSPFONT SOFONT WINDOW) (SETQ CURRENTFONT (QUOTE SOFONT)) (* SO - character set switch) ) (↑O (DSPFONT SIFONT WINDOW) (SETQ CURRENTFONT (QUOTE SIFONT)) (* SI - character set switch) ) (↑%[ (* ESC Leadin) (SETQ ESCAPESEQUENCE 0) (SETQ CSTERM 60Q)) (COND ((IGEQ CHAR (CHARCODE SPACE)) (* Normal char) (COND (ESCAPESEQUENCE (VTCHAT.SEQUENCE CHAT.STATE VT100.STATE CHAR)) (T (SETQ EATLF (SETQ EATCRLF NIL)) (RETURN (COND ((AND (NEQ CHAR (CHARCODE DEL)) (NOT EATTOCRLF)) (* Print the char) (TERM.PRINTCHAR CHAT.STATE CHAR)))))))))))))) (VTCHAT.CLEARMODES (LAMBDA (CHAT.STATE VT100.STATE) (* ejs: "12-May-85 18:49") (with CHAT.STATE CHAT.STATE (with VT100.STATE VT100.STATE (COND ((OR BLINKMODE BRIGHTMODE) (* Restore normal font) (DSPFONT PLAINFONT DSP) (SETQ FONT PLAINFONT) (SETQ BRIGHTMODE (SETQ BLINKMODE)))))))) (VTCHAT.REPORT (LAMBDA (CHAT.STATE VTCHAT.STATE) (* ejs: "26-Aug-85 12:01") (* * Report terminal parameters -- DECREPTPARM) (with CHAT.STATE CHAT.STATE (PRIN4 "[2;1;1;" OUTSTREAM) (COND ((EQ (fetch (STREAM DEVICE) of OUTSTREAM) \RS232C.FDEV) (LET ((BAUD (CDR (FASSOC (CDR (FASSOC (QUOTE LINE.SPEED) (RS232C.GET.PARAMETERS (QUOTE (LINE.SPEED))))) (QUOTE ((62Q . 0) (113Q . 10Q) (156Q . 20Q) (226Q . 40Q) (310Q . 50Q) (454Q . 60Q) (1130Q . 70Q) (2260Q . 100Q) (3410Q . 110Q) (3720Q . 120Q) (4540Q . 130Q) (7020Q . 140Q) (11300Q . 150Q) (22600Q . 160Q) (45400Q . 170Q))))))) (COND (BAUD (printout OUTSTREAM BAUD ";" BAUD ";")) (T (printout OUTSTREAM "0;0;"))))) (T (printout OUTSTREAM "0;0;"))) (PRIN1 "1;0x" OUTSTREAM) (FORCEOUTPUT OUTSTREAM)))) (VTCHAT.RESETMODE [LAMBDA (CHAT.STATE VT100.STATE MODEARRAY SETCOUNT) (* ejs: "13-May-85 16:13") (* Does mode resetting) (with CHAT.STATE CHAT.STATE (with VT100.STATE VT100.STATE (for M from 1 to SETCOUNT do (SELECTQ (ELT MODEARRAY M) (1 (replace (VT100.STATE CURSORMODE) of VT100.STATE with NIL)) (4 (SETQ SMOOTHSCROLL NIL)) [5 (COND (INVERTFLG (INVERTW WINDOW) (SETQ INVERTFLG NIL) (DSPTEXTURE WHITESHADE DSP) (DSPOPERATION (QUOTE REPLACE) DSP] (6 (SETQ RELORIGIN NIL) (VTCHAT.ADDRESS CHAT.STATE VT100.STATE 1 1)) NIL]) (VTCHAT.RESTORE [LAMBDA (CHAT.STATE VT100.STATE) (* ejs: "12-May-85 18:29") (* * Function to restor cursor, etc from storage) (with CHAT.STATE CHAT.STATE (with VT100.STATE VT100.STATE (AND VT100MEM (PROGN (MOVETO (SETQ XPOS (CAR (fetch (VT100SAVE CURSORPOS) of VT100MEM))) (SETQ YPOS (CDR (fetch (VT100SAVE CURSORPOS) of VT100MEM))) DSP) (DSPFONT (CAR (fetch (VT100SAVE CHARATTR) of VT100MEM)) DSP) (SETQ UNDERLINEMODE (CADR (fetch (VT100SAVE CHARATTR) of VT100MEM))) (DSPSOURCETYPE (CADDR (fetch (VT100SAVE CHARATTR) of VT100MEM]) (VTCHAT.REVERSE.INDEX [LAMBDA (CHAT.STATE VT100.STATE) (* ejs: "12-May-85 18:52") (with CHAT.STATE CHAT.STATE (with VT100.STATE VT100.STATE (COND ((ILESSP YPOS (IDIFFERENCE TOPMARGIN FONTHEIGHT)) (MOVETO XPOS [SETQ YPOS (IMIN (IDIFFERENCE TOPMARGIN FONTHEIGHT) (IPLUS YPOS (ITIMES FONTHEIGHT RPT] DSP)) (T (TERM.SCROLLDOWN CHAT.STATE TOPMARGIN]) (VTCHAT.SAVE [LAMBDA (CHAT.STATE VT100.STATE) (* ejs: "12-May-85 18:30") (* * Function to save current curpos position, graphic rendition, and character set) (with CHAT.STATE CHAT.STATE (with VT100.STATE VT100.STATE (OR VT100MEM (SETQ VT100MEM (create VT100SAVE))) (replace (VT100SAVE CURSORPOS) of VT100MEM with (create POSITION XCOORD ← XPOS YCOORD ← YPOS)) (replace (VT100SAVE CHARATTR) of VT100MEM with (LIST FONT UNDERLINEMODE (DSPSOURCETYPE NIL DSP]) (VTCHAT.SEQUENCE [LAMBDA (CHAT.STATE VT100.STATE CHAR) (* ejs: "12-May-85 18:20") (* Here when an ESC has been seen) (with CHAT.STATE CHAT.STATE (with VT100.STATE VT100.STATE (PROG (TEMP FONTDECL) (COND ((IGREATERP CHAR CSTERM) (VTCHAT.DOCOMMAND CHAT.STATE VT100.STATE CHAR)) (T (COND ((ZEROP ESCAPESEQUENCE) (SELECTC CHAR ((CHARCODE %() (SETQ FONTDECL CHAR) (SETQ ESCAPESEQUENCE 1) (SETQ CSTERM (CHARCODE B))) ((CHARCODE %)) (SETQ FONTDECL CHAR) (SETQ ESCAPESEQUENCE 1) (SETQ CSTERM (CHARCODE B))) (printout PROMPTWINDOW "Bad ESCAPESEQUENCE--CHAR is " (CHARACTER CHAR) T))) (T (COND (FONTDECL (VTCHAT.DECLFONT CHAT.STATE VT100.STATE CHAR)) (T (SELCHARQ CHAR ((0 1 2 3 4 5 6 7 8 9) (SETQ TEMP (IPLUS (ITIMES 10 (ELT PARAMARRAY ESCAPESEQUENCE)) (IDIFFERENCE CHAR 48))) (SETA PARAMARRAY ESCAPESEQUENCE TEMP)) (; (SETQ ESCAPESEQUENCE (ADD1 ESCAPESEQUENCE)) (SETA PARAMARRAY ESCAPESEQUENCE 0)) NIL]) (VTCHAT.SETMARGINS [LAMBDA (CHAT.STATE VT100.STATE TOP BOTTOM) (* ejs: "12-May-85 18:31") (* * Function to set top and bottom margins) (with CHAT.STATE CHAT.STATE (with VT100.STATE VT100.STATE (SETQ TOPMARGIN (IDIFFERENCE HOMEPOS (ITIMES (IDIFFERENCE TOP 2) FONTHEIGHT))) (SETQ BOTTOMMARGIN (IDIFFERENCE (IDIFFERENCE HOMEPOS (ITIMES (SUB1 BOTTOM) FONTHEIGHT)) FONTDESCENT]) (VTCHAT.SETMODE [LAMBDA (CHAT.STATE VT100.STATE MODEARRAY SETCOUNT) (* ejs: "13-May-85 16:13") (* Does mode setting) (with CHAT.STATE CHAT.STATE (with VT100.STATE VT100.STATE (for M from 1 to SETCOUNT do (SELECTQ (ELT MODEARRAY M) (1 (replace (VT100.STATE CURSORMODE) of VT100.STATE with T)) (4 (SETQ SMOOTHSCROLL T)) [5 (COND ((NULL INVERTFLG) (SETQ INVERTFLG T) (INVERTW WINDOW) (DSPOPERATION (QUOTE ERASE) DSP) (DSPTEXTURE BLACKSHADE DSP] (6 (SETQ RELORIGIN T) (CHAT.ADDRESS 1 1)) NIL]) (VTCHAT.STATE (LAMBDA (CHAT.STATE) (* ejs: "26-Aug-85 11:13") (replace (CHAT.STATE TERM.IDENTITY.STRING) of CHAT.STATE with VTCHAT.TERM.IDENTITY.STRING) (replace (CHAT.STATE TERM.TAB.STOPS) of CHAT.STATE with (QUOTE (1 11Q 21Q 31Q 41Q 51Q 61Q 71Q 101Q 111Q 121Q))) (TERM.RESET.DISPLAY.PARMS CHAT.STATE) (TERM.HOME CHAT.STATE) (create VT100.STATE))) (VTCHAT.STATUS [LAMBDA (CHAT.STATE VT100.STATE TYPE) (* ejs: "12-May-85 18:33") (* Returns VT100 status info) (with CHAT.STATE CHAT.STATE (with VT100.STATE VT100.STATE (SELECTQ TYPE (5 (* Host wants device status) (PRIN1 "[0n" OUTSTREAM)) (6 (* Host wants cursor coords) (BOUT OUTSTREAM (CHARCODE ↑%[)) (BOUT OUTSTREAM (CHARCODE %[)) [BOUT OUTSTREAM (MKSTRING (ADD1 (IQUOTIENT YPOS FONTHEIGHT] (BOUT OUTSTREAM (CHARCODE ;)) [BOUT OUTSTREAM (MKSTRING (ADD1 (IQUOTIENT XPOS FONTWIDTH] (BOUT OUTSTREAM (CHARCODE R))) NIL) (FORCEOUTPUT OUTSTREAM]) ) (RPAQ CHATFONT (FONTCREATE (QUOTE (GACHA 12 MRR)))) (RPAQ GRAPHICSFONT CHATFONT) (RPAQ VTCHAT.TERM.IDENTITY.STRING "[?1;2c") (ADDTOVAR CHAT.DRIVERTYPES (VT100 VTCHAT.HANDLECHARACTER VTCHAT.STATE)) (FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES) VT100KP) (PUTPROPS VTCHAT COPYRIGHT ("sSCHLUMBERGER TECHNOLOGY CORPORATION" 1983 1984 1985)) (DECLARE: DONTCOPY (FILEMAP (NIL (2591 20411 (VTCHAT.ADDRESS 2601 . 3467) (VTCHAT.ATTRIBUTES 3469 . 4148) ( VTCHAT.DECLFONT 4150 . 4677) (VTCHAT.DOCOMMAND 4679 . 9969) (VTCHAT.HANDLECHARACTER 9971 . 12426) ( VTCHAT.CLEARMODES 12428 . 12871) (VTCHAT.REPORT 12873 . 13897) (VTCHAT.RESETMODE 13899 . 14695) ( VTCHAT.RESTORE 14697 . 15527) (VTCHAT.REVERSE.INDEX 15529 . 16000) (VTCHAT.SAVE 16002 . 16623) ( VTCHAT.SEQUENCE 16625 . 17854) (VTCHAT.SETMARGINS 17856 . 18353) (VTCHAT.SETMODE 18355 . 19118) ( VTCHAT.STATE 19120 . 19583) (VTCHAT.STATUS 19585 . 20409))))) STOP