(FILECREATED "26-Jul-85 21:13:22" {ERIS}<LISPCORE>LIBRARY>VTCHAT.;2 19078
changes to: (VARS VTCHATCOMS)
previous date: "24-May-85 16:51:39" {ERIS}<LISPCORE>LIBRARY>VTCHAT.;1)
(* Copyright (c) 1983, 1984, 1985 by sSCHLUMBERGER TECHNOLOGY CORPORATION. All rights reserved.)
(PRETTYCOMPRINT VTCHATCOMS)
(RPAQQ VTCHATCOMS ((COMS (* VT100 emulator)
(FNS VTCHAT.ADDRESS VTCHAT.ATTRIBUTES VTCHAT.DECLFONT VTCHAT.DOCOMMAND
VTCHAT.HANDLECHARACTER VTCHAT.CLEARMODES 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)
(RECORDS * VTCHATRECORDS)))
(* 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: "12-May-85 18:28")
(* * 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 64)
(SETQ ESCAPESEQUENCE 1)
(SETQ STAYESCAPE T)
(SETA PARAMARRAY 1 0))
(7 (* Save parameters)
(VTCHAT.SAVE CHAT.STATE VT100.STATE))
(8 (* Restore parameters)
(VTCHAT.RESTORE CHAT.STATE VT100.STATE))
[A (* Move up; param1 indicates how far)
(TERM.UP CHAT.STATE (COND
((ZEROP PARAM1)
1)
(T PARAM1]
[B (* Move down; param1 indicates how far)
(TERM.GODOWN CHAT.STATE (COND
((ZEROP PARAM1)
1)
(T PARAM1]
[C (* Move right; param1 indicates how far)
(TERM.RIGHT CHAT.STATE (COND
((ZEROP PARAM1)
1)
(T PARAM1]
[D (* Move left; param1 indicates how far)
(COND
((ZEROP ESCAPESEQUENCE)
(TERM.DOWN CHAT.STATE))
(T (TERM.LEFT CHAT.STATE (COND
((ZEROP PARAM1)
1)
(T PARAM1]
(E (* Do CRLF)
(MOVETO (SETQ XPOS 0)
YPOS DSP)
(TERM.DOWN CHAT.STATE))
[H (* Cursor addressing)
(COND
((ZEROP ESCAPESEQUENCE)
(TERM.SET.TAB CHAT.STATE
(IQUOTIENT XPOS FONTWIDTH))
)
(T (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))
[f (* 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]
(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)
24)
(T PARAM2]
(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: "12-May-85 18:46")
(* 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 ↑L ↑K) (* Line Feed)
(COND
((NOT EATLF)
(TERM.DOWN CHAT.STATE))
(T (SETQ EATLF NIL))))
(↑I (* Tab)
(TERM.DOWN 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 48))
(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.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) (* AJB "24-May-85 16:49")
(replace (CHAT.STATE TERM.IDENTITY.STRING) of CHAT.STATE with VTCHAT.TERM.IDENTITY.STRING)
(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)
(RPAQQ VTCHATRECORDS (VT100.STATE VT100SAVE))
[DECLARE: EVAL@COMPILE
(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))
(RECORD VT100SAVE (CURSORPOS CHARATTR CHARSET))
]
(/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))
(PUTPROPS VTCHAT COPYRIGHT ("sSCHLUMBERGER TECHNOLOGY CORPORATION" 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (996 17036 (VTCHAT.ADDRESS 1006 . 1872) (VTCHAT.ATTRIBUTES 1874 . 2553) (VTCHAT.DECLFONT
2555 . 3082) (VTCHAT.DOCOMMAND 3084 . 7765) (VTCHAT.HANDLECHARACTER 7767 . 10226) (VTCHAT.CLEARMODES
10228 . 10671) (VTCHAT.RESETMODE 10673 . 11469) (VTCHAT.RESTORE 11471 . 12301) (VTCHAT.REVERSE.INDEX
12303 . 12774) (VTCHAT.SAVE 12776 . 13397) (VTCHAT.SEQUENCE 13399 . 14628) (VTCHAT.SETMARGINS 14630 .
15127) (VTCHAT.SETMODE 15129 . 15892) (VTCHAT.STATE 15894 . 16208) (VTCHAT.STATUS 16210 . 17034)))))
STOP