(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP" BASE 10)
(FILECREATED "27-Sep-87 16:04:41" {DSK}<OST>ANSICHAT.;59 135840
changes to%: (VARS ANSICHATCOMS)
(FNS ANSI-Chat-EMACS-Move ANSI-Chat-Initialize)
previous date%: "26-Sep-87 15:18:17" {DSK}<OST>ANSICHAT.;56)
(PRETTYCOMPRINT ANSICHATCOMS)
(RPAQQ ANSICHATCOMS
((PROP MAKEFILE-ENVIRONMENT ANSICHAT)
(PROP FILETYPE ANSICHAT)
(FILES CHAT)
(FNS ANSI-Chat-Address ANSI-Chat-Address-Absolute ANSI-Chat-ButtonEventFn
ANSI-Chat-Character-Attributes ANSI-Chat-Clear-From-Menu ANSI-Chat-Close
ANSI-Chat-CloseFn ANSI-Chat-Control-Character ANSI-Chat-Control-Sequence
ANSI-Chat-Line-Attribute ANSI-Chat-CSI-Intermediate ANSI-Chat-Cursor-Backward
ANSI-Chat-Cursor-Down ANSI-Chat-Cursor-Forward ANSI-Chat-Cursor-Up
ANSI-Chat-Deactivate-Window ANSI-Chat-Debug ANSI-Chat-Device-Status-Report
ANSI-Chat-Did-Reshape ANSI-Chat-Display-Erase-Region
ANSI-Chat-Display-Erase-to-End-of-Line ANSI-Chat-Display-Scroll-Down
ANSI-Chat-Display-Scroll-Up ANSI-Chat-EMACS-Move ANSI-Chat-Erase-In-Display
ANSI-Chat-Erase-In-Line ANSI-Chat-Escape-Intermediate ANSI-Chat-Escape-Sequence
ANSI-Chat-Handle-Character ANSI-Chat-Horizontal-Tab ANSI-Chat-Horizontal-Tabulation-Set
ANSI-Chat-IconFn ANSI-Chat-Identify-Terminal ANSI-Chat-Index ANSI-Chat-Initialize
ANSI-Chat-Menu ANSI-Chat-Move-To ANSI-Chat-New-Line ANSI-Chat-NewRegionFn
ANSI-Chat-Print-Character ANSI-Chat-Print-From-Character-Set ANSI-Chat-Reconnect
ANSI-Chat-Redisplay-Line ANSI-Chat-RepaintFn ANSI-Chat-Reset-Mode ANSI-Chat-ReshapeFn
ANSI-Chat-Restore-Cursor ANSI-Chat-Reverse-Index ANSI-Chat-Save-Cursor
ANSI-Chat-Screen-Alignment-Display ANSI-Chat-Screen-Parameters
ANSI-Chat-Set-Character-Attributes ANSI-Chat-Set-Character-Set
ANSI-Chat-Set-Line-Attribute ANSI-Chat-Set-Mode ANSI-Chat-Set-Top-and-Bottom-Margins
ANSI-Chat-Switch-EMACS ANSI-Chat-Tabulation-Clear ANSI-Chat-Underline
ANSI-Chat-Unimplemented-Intermediate-Character
ANSI-Chat-Unimplemented-Non-Numeric-Parameter ANSI-Chat-Unimplemented-Terminator)
(BITMAPS ANSI-Chat-Icon-Bitmap ANSI-Chat-Mask-Bitmap)
(VARS ANSI-Chat-Icon-Title-Region)
(INITVARS (ANSI-Chat-ReOpen-Menu NIL)
(ANSI-Chat-Icon-Template NIL))
(GLOBALVARS ANSI-Chat-ReOpen-Menu ANSI-Chat-Icon-Template ANSI-Chat-Icon-Bitmap
ANSI-Chat-Mask-Bitmap ANSI-Chat-Icon-Title-Region)
(ADDVARS (CHAT.DRIVERTYPES (ANSI ANSI-Chat-Handle-Character ANSI-Chat-Initialize)))
(INITRECORDS ANSI-STATE)
(FILES ANSICHATCOPY ANSICHATFONT ANSIKEYPAD)
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
ANSICHATDECLS CHATDECLS STREAMDECLS))))
(PUTPROPS ANSICHAT MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP" :BASE 10))
(PUTPROPS ANSICHAT FILETYPE TCOMPL)
(FILESLOAD CHAT)
(DEFINEQ
(ANSI-Chat-Address
[LAMBDA (Chat.State ANSI-State Line Column) (* ; "Edited 18-Sep-87 17:11 by R.Beeman")
(* ;; "Moves the active position to the position specified by the parameters")
(* ;; "The numbering of lines depend on the state of the Origin Mode")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(ANSI-Chat-Address-Absolute Chat.State ANSI-State (COND
(Origin (IMIN BottomMargin
(+ TopMargin Line)
))
(T Line))
Column)
(SETQ AtRightMargin NIL])
(ANSI-Chat-Address-Absolute
[LAMBDA (Chat.State ANSI-State Line Column) (* ; "Edited 23-Sep-87 18:04 by R.Beeman")
(* ;; "Moves the active position to the position specified by the parameters")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(LET ((New-Line (IMIN Line BottomLine)))
(ANSI-Chat-Set-Line-Attribute Chat.State ANSI-State (SETQ CursorLine New-Line))
(ANSI-Chat-Move-To Chat.State
(+ (ITIMES (SUB1 (SETQ CursorColumn
(IMAX (IMIN (COND
(DoubleWide (RSH RightMargin 1))
(T RightMargin))
Column)
1)))
(COND
(DoubleWide (RSH FONTWIDTH -1))
(T FONTWIDTH)))
FONTWIDTH)
(+ (ITIMES (- BottomLine New-Line)
FONTHEIGHT)
FONTDESCENT])
(ANSI-Chat-ButtonEventFn
[LAMBDA (Window) (* ; "Edited 25-Sep-87 15:08 by R.Beeman")
(COND
[(LASTMOUSESTATE LEFT)
(LET ((Chat.State (WINDOWPROP Window 'CHATSTATE))
Chat.Process)
(COND
((AND (type? CHAT.STATE Chat.State)
(fetch (CHAT.STATE CHATINEMACS) of Chat.State)
(SETQ Chat.Process (fetch (CHAT.STATE TYPEOUTPROC) of Chat.State)))
(PROCESS.APPLY Chat.Process (FUNCTION ANSI-Chat-EMACS-Move)
(LIST Chat.State)))
(T (CHAT.HOLD Window]
((LASTMOUSESTATE MIDDLE)
(ANSI-Chat-Menu Window])
(ANSI-Chat-Character-Attributes
[LAMBDA (Chat.State ANSI-State) (* ; "Edited 22-Sep-87 18:49 by R.Beeman")
(* ;; "Function to do character attribute setting")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(for Index from 1 to ParameterCount bind (NewCharacterAttributes ← Attributes)
do (SELECTQ (ELT Parameters Index)
(0 (SETQ NewCharacterAttributes 0))
(1 (SETQ NewCharacterAttributes (BITSET NewCharacterAttributes 1)))
(4 (SETQ NewCharacterAttributes (BITSET NewCharacterAttributes 2)))
(5 (SETQ NewCharacterAttributes (BITSET NewCharacterAttributes 4)))
(7 (SETQ NewCharacterAttributes (BITSET NewCharacterAttributes 8)))
(22 (SETQ NewCharacterAttributes (BITCLEAR NewCharacterAttributes 1)))
(24 (SETQ NewCharacterAttributes (BITCLEAR NewCharacterAttributes 2)))
(25 (SETQ NewCharacterAttributes (BITCLEAR NewCharacterAttributes 4)))
(27 (SETQ NewCharacterAttributes (BITCLEAR NewCharacterAttributes 8)))
NIL) finally (ANSI-Chat-Set-Character-Attributes Chat.State ANSI-State
NewCharacterAttributes CursorLine])
(ANSI-Chat-Clear-From-Menu
[LAMBDA (Chat.State Window) (* ; "Edited 18-Sep-87 17:12 by R.Beeman")
(with CHAT.STATE Chat.State (* ; "Chat State")
(LET ((ANSI-State TERM.STATE))
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(DSPRESET Window)
(SETQ TopMargin 0)
(SETQ BottomMargin BottomLine)
(SETQ TOPMARGIN (+ (ITIMES BottomLine FONTHEIGHT)
FONTDESCENT))
(SETQ BOTTOMMARGIN 0)
(SETQ Origin NIL)
(ANSI-Chat-Address Chat.State ANSI-State 1 1])
(ANSI-Chat-Close
[LAMBDA (Window Aborted Closing)
(DECLARE (GLOBALVARS \CARET.UP)) (* ; "Edited 9-Sep-87 12:01 by R.Beeman")
(* ;; "Close chat connection that is using WINDOW. Also serves as the CLOSEFN of this window, when CLOSING is NIL")
(DECLARE (GLOBALVARS HIGHLIGHTSHADE))
(PROG ((Chat.State (WINDOWPROP Window 'CHATSTATE))
(Active? (OPENWP Window))
Icon Process File Keep)
(DETACHALLWINDOWS Window)
(DSPOPERATION 'REPLACE Window) (* ; "Restore REPLACE mode for BITBLT")
(DSPSCROLL 'ON Window) (* ; "Turn scrolling back on")
(COND
[Chat.State (DEL.PROCESS (fetch (CHAT.STATE TYPEOUTPROC) of Chat.State))
[COND
((SETQ File (fetch (CHAT.STATE TYPESCRIPTSTREAM) of Chat.State))
(COND
(Active? (TERPRI Window)
(PRIN1 "Closing " Window)
(PRINT (CLOSEF File)
Window))
(T (CLOSEF File]
(AND Active? (\CHECKCARET Window))
(replace (CHAT.STATE RUNNING?) of (WINDOWPROP Window 'CHATSTATE NIL) with NIL)
(OR Aborted (PROGN (ALLOW.BUTTON.EVENTS)
(CHAT.CLOSE.CONNECTION (fetch (CHAT.STATE INSTREAM)
of Chat.State)
(fetch (CHAT.STATE OUTSTREAM) of Chat.State]
(T (RETURN)))
(SETQ CHATWINDOWLST (DREMOVE Window CHATWINDOWLST))
(SETQ Process (WINDOWPROP Window 'PROCESS NIL))
(* ;; "Save the process running, if any; don't do anything with it until after we close the window, if we're going to, so that windows don't flip around excessively")
(WINDOWPROP Window 'CLOSEFN NIL) (* ;
"Clear all CLOSE functions so that next time this chatwindow is reused it will be clean")
(COND
[Active? (* ; "Change title to indicate closure")
(ANSI-Chat-Deactivate-Window Window)
(COND
((AND (NOT (SETQ Keep (WINDOWPROP Window 'KEEPCHAT NIL)))
(NOT Closing)
(OR CLOSECHATWINDOWFLG (NEQ Window CHATWINDOW)))
(CLOSEW Window)))
[COND
((EQ Keep 'NEW) (* ;
"Invoked via the New command -- start up a new connection in this window")
(ADD.PROCESS (LIST (FUNCTION CHAT)
NIL NIL NIL Window T]
(COND
(Process (* ;
"Do this last, because if we are Process, DEL.PROCESS won't return")
(DEL.PROCESS Process]
([OPENWP (SETQ Icon (WINDOWPROP Window 'ICONWINDOW]
(* ;
"Shade the icon if the chat window is currently closed")
(ICONW.SHADE Icon HIGHLIGHTSHADE) (* ;
"And arrange for middle-button to offer Reconnect option")
(WINDOWPROP Icon 'OLDBUTTONEVENTFN (WINDOWPROP Icon 'BUTTONEVENTFN
(FUNCTION ANSI-Chat-Reconnect])
(ANSI-Chat-CloseFn
[LAMBDA (Window) (* ; "Edited 9-Sep-87 09:53 by R.Beeman")
(* ;; "Close this chat connection making sure that the window gets closed. Used as CLOSEFN of the chat window.")
(ANSI-Chat-Close Window NIL T])
(ANSI-Chat-Control-Character
[LAMBDA (Chat.State ANSI-State CharacterCode)
(DECLARE (GLOBALVARS INVERTWINDOWFN \MACHINETYPE \DANDELION \DAYBREAK))
(* ; "Edited 18-Sep-87 17:13 by R.Beeman")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(SELCHARQ CharacterCode
(NULL (* ; "Null - Ignore")
(NILL))
(↑E (* ;
"Enquire - Transmits answerback message")
(NILL))
(BELL (* ; "Bell - Sounds the bell")
[COND
((OR (EQ \MACHINETYPE \DANDELION)
(EQ \MACHINETYPE \DAYBREAK))
(BEEPON 880)
(DISMISS 20)
(BEEPOFF))
(T (APPLY* INVERTWINDOWFN WINDOW)
(* ; "Complement window")
(SETQ Dinged (NOT Dinged])
(BS (* ; "Backspace")
(ANSI-Chat-Cursor-Backward Chat.State ANSI-State 1))
(TAB (* ; "Tab")
(ANSI-Chat-Horizontal-Tab Chat.State ANSI-State))
((LF ↑K FF) (* ;
"Line Feed, VT and FF understood as LF")
(ANSI-Chat-Index Chat.State ANSI-State))
(CR (* ; "Carriage return")
(ANSI-Chat-Address-Absolute Chat.State ANSI-State CursorLine 1)
(SETQ AtRightMargin NIL))
(↑N (* ; "SO --- use G1 character set")
(SETQ CharacterSet 1))
(↑O (* ; "SI --- use G0 character set")
(SETQ CharacterSet 0))
((↑X ↑Z) (* ; "Cancel, SUB understood as CAN")
[COND
((OR EscapeSequence ControlSequence)
(SETQ EscapeSequence NIL)
(SETQ ControlSequence NIL)
(ANSI-Chat-Print-Character Chat.State ANSI-State (CHARCODE 360,313])
(ESC (* ;
"Escape - Understood as introducer of an escape sequence")
(SETQ EscapeSequence T)
(SETQ IntermediateCharacter NIL)
(SETQ ControlSequence NIL))
NIL])
(ANSI-Chat-Control-Sequence
[LAMBDA (Chat.State ANSI-State CharacterCode) (* ; "Edited 23-Sep-87 18:31 by R.Beeman")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(COND
[(>= CharacterCode (CHARCODE @))
(SETQ ControlSequence NIL) (* ; "Terminator received")
(LET [[PARAM1 (COND
((ZEROP ParameterCount)
0)
(T (ELT Parameters 1]
(PARAM2 (COND
((ILESSP ParameterCount 2)
0)
(T (ELT Parameters 2]
(COND
(NonNumericParameter (SELCHARQ NonNumericParameter
(? (* ; "Non-numeric parameter is ?")
(SELCHARQ CharacterCode
(J
(* ; "&")
(NILL))
(K
(* ; "&")
(NILL))
(h
(* ; "Set modes")
(ANSI-Chat-Set-Mode Chat.State
ANSI-State))
(i
(* ; "&")
(NILL))
(l
(* ; "Reset mode")
(ANSI-Chat-Reset-Mode Chat.State
ANSI-State))
(n
(* ; "&")
(NILL))
(ANSI-Chat-Unimplemented-Terminator
Chat.State ANSI-State CharacterCode)))
(> (* ; "Non-numeric parameter is >")
(SELCHARQ CharacterCode
(c
(* ; "Secondary DA - What type of terminal are you, what is your firmware version, and what hardware options do you have installed")
(NILL))
(ANSI-Chat-Unimplemented-Terminator
Chat.State ANSI-State CharacterCode)))
(ANSI-Chat-Unimplemented-Non-Numeric-Parameter
Chat.State ANSI-State CharacterCode)))
(T (SELCHARQ CharacterCode
(@ (* ; "CSI @ -> ICH")
(NILL))
(A (* ; "CSI Pn A -> CUU")
(ANSI-Chat-Cursor-Up Chat.State ANSI-State (COND
((ZEROP PARAM1)
1)
(T PARAM1))))
(B (* ; "CSI Pn B -> CUD")
(ANSI-Chat-Cursor-Down Chat.State ANSI-State (COND
((ZEROP PARAM1
)
1)
(T PARAM1))))
(C (* ; "CSI Pn C -> CUF")
(ANSI-Chat-Cursor-Forward Chat.State ANSI-State
(COND
((ZEROP PARAM1)
1)
(T PARAM1))))
(D (* ; "CSI Pn D -> CUB")
(ANSI-Chat-Cursor-Backward Chat.State ANSI-State
(COND
((ZEROP PARAM1)
1)
(T PARAM1))))
(H (* ;
"ESC Pc ; Pr H -> Set tab at position")
(ANSI-Chat-Address Chat.State ANSI-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")
(ANSI-Chat-Erase-In-Display Chat.State ANSI-State PARAM1))
(K (* ;
"Erase in line; param1 indicates mode")
(ANSI-Chat-Erase-In-Line Chat.State ANSI-State PARAM1))
(L (* ; "")
(NILL))
(M (* ; "")
(NILL))
(P (* ; "CSI P -> DCH")
(NILL))
(X (* ; "CSI X -> ECH")
(NILL))
(c (* ; "What are you?")
(ANSI-Chat-Identify-Terminal Chat.State))
(f (* ; "")
(ANSI-Chat-Address Chat.State ANSI-State
(COND
((OR (ZEROP PARAM1)
(NULL PARAM1))
1)
(T PARAM1))
(COND
((OR (ZEROP PARAM2)
(NULL PARAM2))
1)
(T PARAM2))))
(g (* ; "Clear Tabs")
(COND
((OR (ZEROP PARAM1)
(NULL PARAM1))
(ANSI-Chat-Tabulation-Clear Chat.State CursorColumn))
((EQ 3 PARAM1)
(SETQ TERM.TAB.STOPS NIL))))
(h (* ; "&")
(NILL))
(l (* ; "&")
(NILL))
(m (* ; "Set char attributes")
(ANSI-Chat-Character-Attributes Chat.State ANSI-State))
(n (* ; "Status report")
(ANSI-Chat-Device-Status-Report Chat.State ANSI-State PARAM1))
(r (* ; "Set scrolling margins")
(ANSI-Chat-Set-Top-and-Bottom-Margins Chat.State ANSI-State
PARAM1 PARAM2))
(ANSI-Chat-Unimplemented-Terminator Chat.State ANSI-State
CharacterCode]
(T (COND
[(>= CharacterCode (CHARCODE 0)) (* ; "Parameter")
(SELCHARQ CharacterCode
((0 1 2 3 4 5 6 7 8 9)
(SETQ NumericParameter T)
[LET [(ParameterValue (IPLUS (ITIMES 10 (ELT Parameters
ParameterCount))
(IDIFFERENCE CharacterCode
(CHARCODE 0]
(COND
((ILESSP ParameterValue MAX.SMALLP)
(SETA Parameters ParameterCount ParameterValue])
(; (SETQ NumericParameter T)
(SETA Parameters (SETQ ParameterCount (ADD1 ParameterCount))
0))
(COND
((AND (NOT NumericParameter)
(NULL NonNumericParameter))
(SETQ NonNumericParameter CharacterCode))
(T (SETQ NonNumericParameter (CHARCODE <]
(T (* ; "Intermediate Character")
(SETQ IntermediateCharacter CharacterCode])
(ANSI-Chat-Line-Attribute
[LAMBDA (Chat.State ANSI-State Attribute) (* ; "Edited 23-Sep-87 18:04 by R.Beeman")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(COND
((NOT (= LineAttribute Attribute))
(SETA LineAttributes CursorLine Attribute)
(ANSI-Chat-Set-Line-Attribute Chat.State ANSI-State CursorLine)
(COND
(DoubleWideFonts (ANSI-Chat-Redisplay-Line Chat.State ANSI-State CursorLine)
(ANSI-Chat-Address-Absolute Chat.State ANSI-State CursorLine
CursorColumn)
(SETQ AtRightMargin NIL])
(ANSI-Chat-CSI-Intermediate
[LAMBDA (Chat.State ANSI-State CharacterCode) (* ; "Edited 23-Sep-87 18:34 by R.Beeman")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(COND
((>= CharacterCode (CHARCODE @))
(SETQ ControlSequence NIL) (* ; "Terminator received")
(SELCHARQ IntermediateCharacter
(! (SELCHARQ CharacterCode
(p (* ; "CSI ! p -> DECSTR")
(NILL))
(ANSI-Chat-Unimplemented-Terminator Chat.State ANSI-State
CharacterCode)))
(%" (SELCHARQ CharacterCode
(p (* ; "CSI %" p -> DECSCL")
(NILL))
(q (* ; "CSI %" q -> DECSCA")
(NILL))
(ANSI-Chat-Unimplemented-Terminator Chat.State ANSI-State
CharacterCode)))
(ANSI-Chat-Unimplemented-Intermediate-Character Chat.State ANSI-State
CharacterCode)))
(T (* ; "Another Intermediate Character?")
(COND
((< CharacterCode (CHARCODE 0))
(SETQ IntermediateCharacter (CHARCODE /)))
(T (* ; "No, parameter out of sequence")
(SETQ ControlSequence NIL])
(ANSI-Chat-Cursor-Backward
[LAMBDA (Chat.State ANSI-State Pn) (* ; "Edited 18-Sep-87 17:14 by R.Beeman")
(* ;;; "Move the cursor Pn (default = 1) characters backwards, pegging at the left margin")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
[COND
((> CursorColumn 1)
(ANSI-Chat-Address-Absolute Chat.State ANSI-State CursorLine
(- CursorColumn (OR Pn 1]
(SETQ AtRightMargin NIL])
(ANSI-Chat-Cursor-Down
[LAMBDA (Chat.State ANSI-State Pn) (* ; "Edited 18-Sep-87 17:15 by R.Beeman")
(* ;;; "Move down Pn lines (default = 1), don't scroll")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(COND
((NOT (= CursorLine BottomMargin))
(ANSI-Chat-Address-Absolute Chat.State ANSI-State (IMIN (COND
((> CursorLine
BottomMargin)
(* ; "In or above scrolling region")
BottomMargin)
(T
(* ; "Below scrolling region")
BottomLine))
(+ CursorLine
(OR Pn 1)))
CursorColumn)))
(SETQ AtRightMargin NIL])
(ANSI-Chat-Cursor-Forward
[LAMBDA (Chat.State ANSI-State Pn) (* ; "Edited 18-Sep-87 17:15 by R.Beeman")
(* ;;; "Move the cursor Pn characters to the right, pegging at the right margin")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
[COND
((< CursorColumn (COND
(DoubleWide (RSH RightMargin 1))
(T RightMargin)))
(ANSI-Chat-Address-Absolute Chat.State ANSI-State CursorLine
(+ CursorColumn (OR Pn 1]
(SETQ AtRightMargin NIL])
(ANSI-Chat-Cursor-Up
[LAMBDA (Chat.State ANSI-State Pn) (* ; "Edited 18-Sep-87 17:15 by R.Beeman")
(* ;;; "Go up Pn lines (default = 1), pegging at top of the scrolling region or window")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(LET ((ScrollRegionTop (PLUS 1 TopMargin)))
(COND
((NOT (= CursorLine ScrollRegionTop))
(ANSI-Chat-Address-Absolute Chat.State ANSI-State
(IMAX (COND
((> CursorLine ScrollRegionTop)
(* ; "In or below scrolling region")
ScrollRegionTop)
(T (* ; "Above scrolling region")
1))
(- CursorLine (OR Pn 1)))
CursorColumn)))
(SETQ AtRightMargin NIL])
(ANSI-Chat-Deactivate-Window
[LAMBDA (Window) (* ; "Edited 9-Sep-87 10:23 by R.Beeman")
(LET [(OldTitle (WINDOWPROP Window 'TITLE]
(WINDOWPROP Window 'TITLE (CONCAT (SUBSTRING OldTitle 1 (+ (OR (STRPOS ", height" OldTitle)
0)
-1))
", closed"))
(WINDOWPROP Window 'BUTTONEVENTFN (FUNCTION ANSI-Chat-Reconnect))
(WINDOWPROP Window 'EXPANDFN NIL])
(ANSI-Chat-Debug
[LAMBDA (CharacterCode)
(DECLARE (GLOBALVARS PROMPTWINDOW)) (* ; "Edited 27-Aug-87 19:05 by R.Beeman")
(* ;; "CharacterCode is printed in Prompt Window")
(* ;; "Control Charcters are printed in hexidecimal")
(COND
((< CharacterCode (CHARCODE SPACE))
(PRINTOUT PROMPTWINDOW "|" |.I2.16.2| CharacterCode "|"))
(T (\OUTCHAR (GETSTREAM PROMPTWINDOW)
CharacterCode])
(ANSI-Chat-Device-Status-Report
[LAMBDA (Chat.State ANSI-State Ps) (* ; "Edited 23-Sep-87 17:48 by R.Beeman")
(* ;; "Reports the General Status")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(SELECTQ Ps
(5 (* ; "Host wants device status")
(PRIN3 (CONSTANT (CONCAT (CHARACTER (CHARCODE ESC))
"[0n"))
OUTSTREAM))
(6 (* ; "Host wants cursor coords")
(PRIN3 (CONCAT (CONSTANT (CONCAT (CHARACTER (CHARCODE ESC))
"["))
(MKSTRING (COND
(Origin (- CursorLine TopMargin))
(T CursorLine)))
";"
(MKSTRING CursorColumn)
"R")
OUTSTREAM))
NIL)
(FORCEOUTPUT OUTSTREAM])
(ANSI-Chat-Did-Reshape
[LAMBDA (Chat.State ANSI-State) (* ; "Edited 18-Sep-87 16:10 by R.Beeman")
(* ;; "Invoked in the type-out process when window is reshaped")
(with
CHAT.STATE Chat.State (* ; "Chat State")
(with
ANSI-STATE ANSI-State (* ; "ANSI State")
(LET ((WindowWidth (WINDOWPROP WINDOW 'WIDTH))
(WindowHeight (WINDOWPROP WINDOW 'HEIGHT))
(OldBottomLine BottomLine))
(* ;;
"Constrain Width to be an EVEN number of Characters, also allow for FONTWIDTH on either side")
(SETQ RightMargin (- (RSH (IQUOTIENT WindowWidth (RSH FONTWIDTH -1))
-1)
2))
(SETQ BottomLine (IQUOTIENT (WINDOWPROP WINDOW 'HEIGHT)
FONTHEIGHT))
(* ;; "Obsolete (hopefully)")
(SETQ TTYWIDTH (ITIMES FONTWIDTH RightMargin))
(SETQ TTYHEIGHT (+ (ITIMES BottomLine FONTHEIGHT)
FONTDESCENT))
(SETQ HOMEPOS (+ (ITIMES (- BottomLine 1)
FONTHEIGHT)
FONTDESCENT)) (* ;
"Avoid using (IDIFFERENCE TTYHEIGHT FONTHEIGHT)")
(* ;; "Adjust Line Attributes Array and Characters Arrays")
[COND
[LineAttributes
(LET ((OldSize (ARRAYSIZE LineAttributes)))
[COND
((< (SUB1 OldSize)
BottomLine)
(LET [(NewSize (IMAX (+ OldBottomLine 9)
(ADD1 BottomLine]
(for Index from 1 to (SUB1 OldSize)
bind (NewLines ← (ARRAY NewSize 'WORD 5 0))
(NewCharacters ← (ARRAY (SUB1 NewSize)
'POINTER NIL 1))
(NewAttributes ← (ARRAY (SUB1 NewSize)
'POINTER NIL 1))
do (SETA NewLines Index (ELT LineAttributes Index))
(SETA NewCharacters Index (ELT Characters Index))
(SETA NewAttributes Index (ELT CharacterAttributes Index))
finally (SETQ LineAttributes NewLines)
(SETQ Characters NewCharacters)
(SETQ CharacterAttributes NewAttributes))
(LET [(OldWidth (ARRAYSIZE (ELT Characters 1]
(COND
((< RightMargin OldWidth)
(for Index from OldSize to (SUB1 NewSize)
do (SETA Characters Index (ARRAY OldWidth 'WORD (CHARCODE
SPACE)
0))
(SETA (ELT Characters Index)
0 0)
(SETA CharacterAttributes Index (ARRAY (SUB1 OldWidth)
'WORD 0 1]
(COND
((>= RightMargin (ARRAYSIZE (ELT Characters 1)))
(LET [(NewWidth (IMAX (+ (ARRAYSIZE (ELT Characters 1))
8)
(ADD1 RightMargin]
[for Index from 1 to (SUB1 OldSize)
do (LET ((CharacterLine (ELT Characters Index))
(AttributeLine (ELT CharacterAttributes Index)))
(for Character from 1 to (ELT CharacterLine 0)
bind (NewCharacterLine ← (ARRAY NewWidth 'WORD
(CHARCODE SPACE)
0))
(NewAttributeLine ← (ARRAY (SUB1 NewWidth)
'WORD 0 1))
do (SETA NewCharacterLine Character (ELT CharacterLine
Character))
(SETA NewAttributeLine Character (ELT AttributeLine
Character))
finally (SETA NewCharacterLine 0 (ELT CharacterLine 0))
(SETA Characters Index NewCharacterLine)
(SETA CharacterAttributes Index NewAttributeLine]
(for Index from OldSize to (SUB1 (ARRAYSIZE LineAttributes))
do (SETA Characters Index (ARRAY NewWidth 'WORD (CHARCODE SPACE)
0))
(SETA CharacterAttributes Index (ARRAY (SUB1 NewWidth)
'WORD 0 1))
(SETA (ELT Characters Index)
0 0]
(T (SETQ LineAttributes (ARRAY (ADD1 BottomLine)
'WORD 5 0))
(SETQ Characters (ARRAY BottomLine 'POINTER NIL 1))
(SETQ CharacterAttributes (ARRAY BottomLine 'POINTER NIL 1))
(for Index from 1 to BottomLine do (SETA Characters Index (ARRAY (ADD1 RightMargin)
'WORD
(CHARCODE SPACE)
0))
(SETA CharacterAttributes Index
(ARRAY RightMargin 'WORD 0 1))
(SETA (ELT Characters Index)
0 0]
(SETA LineAttributes 0 BottomLine)
(* ;; "Adjust Scrolling Region ")
[SETQ BottomMargin (COND
((= BottomMargin OldBottomLine)
BottomLine)
(T (IMIN BottomMargin BottomLine]
(COND
((< (- BottomMargin TopMargin)
2)
(SETQ TopMargin 0)
(SETQ BottomMargin BottomLine)))
(SETQ TOPMARGIN (+ (ITIMES (- BottomLine TopMargin)
FONTHEIGHT)
FONTDESCENT))
(SETQ BOTTOMMARGIN (ITIMES (- BottomLine BottomMargin)
FONTHEIGHT))
(ANSI-Chat-Screen-Parameters Chat.State ANSI-State INSTREAM DSP)
(* ;; "Adjust Cursor Position")
(ANSI-Chat-Address-Absolute Chat.State ANSI-State CursorLine CursorColumn])
(ANSI-Chat-Display-Erase-Region
[LAMBDA (Chat.State Left Bottom Width Height) (* ; "Edited 28-Aug-87 13:19 by R.Beeman")
(* ;; "Erases Region to background")
(with CHAT.STATE Chat.State (* ; "Chat State")
(BLTSHADE (DSPTEXTURE NIL DSP)
DSP Left Bottom Width Height 'REPLACE])
(ANSI-Chat-Display-Erase-to-End-of-Line
[LAMBDA (Chat.State ANSI-State) (* ; "Edited 18-Sep-87 16:14 by R.Beeman")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(LET ((Left (+ (ITIMES (COND
(DoubleWide (RSH FONTWIDTH -1))
(T FONTWIDTH))
(SUB1 CursorColumn))
FONTWIDTH))
(CharacterLine (ELT Characters CursorLine)))
(ANSI-Chat-Display-Erase-Region Chat.State Left (ITIMES (- BottomLine CursorLine
)
FONTHEIGHT)
(- (ITIMES (ADD1 RightMargin)
FONTWIDTH)
Left)
FONTHEIGHT)
(SETA CharacterLine 0 (IMIN (SUB1 CursorColumn)
(ELT CharacterLine 0])
(ANSI-Chat-Display-Scroll-Down
[LAMBDA (Chat.State ANSI-State) (* ; "Edited 23-Sep-87 18:05 by R.Beeman")
(* ;;; "Scroll down a line")
(with
CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(LET ((Width (ITIMES RightMargin FONTWIDTH))
(Bottom (ITIMES (- BottomLine BottomMargin)
FONTHEIGHT))
(ScrollRegionTop (ADD1 TopMargin))
(CharacterBottomLine (ELT Characters BottomMargin))
(AttributeBottomLine (ELT CharacterAttributes BottomMargin)))
(COND
[Scroll (LET ((ChatStream OUTSTREAM))
(COND
(Flag0 (BOUT ChatStream (CHARCODE ↑S))
(FORCEOUTPUT ChatStream)))
[for ScanLine from 1 to FONTHEIGHT bind (First ← T)
do (\CHECKCARET DSP)
(BITBLT DSP FONTWIDTH (ADD1 Bottom)
DSP FONTWIDTH Bottom Width
(SUB1 (ITIMES (ADD1 (- BottomMargin ScrollRegionTop))
FONTHEIGHT))
'INPUT
'REPLACE)
(COND
(First (ANSI-Chat-Display-Erase-Region
Chat.State FONTWIDTH
(SUB1 (ITIMES (ADD1 (- BottomLine ScrollRegionTop))
FONTHEIGHT))
Width 1)
(SETQ First NIL]
(COND
(Flag0 (BOUT ChatStream (CHARCODE ↑Q))
(FORCEOUTPUT ChatStream]
(T (BITBLT DSP FONTWIDTH (+ Bottom FONTHEIGHT)
DSP FONTWIDTH Bottom Width (ITIMES (- BottomMargin ScrollRegionTop)
FONTHEIGHT)
'INPUT
'REPLACE)
(ANSI-Chat-Display-Erase-Region Chat.State FONTWIDTH (ITIMES (- BottomLine
ScrollRegionTop
)
FONTHEIGHT)
Width FONTHEIGHT)))
(SETA CharacterBottomLine 0 0)
[for Index from BottomMargin to (ADD1 ScrollRegionTop) by -1
do (SETA LineAttributes Index (ELT LineAttributes (SUB1 Index)))
(SETA Characters Index (ELT Characters (SUB1 Index)))
(SETA CharacterAttributes Index (ELT CharacterAttributes (SUB1 Index]
(SETA Characters ScrollRegionTop CharacterBottomLine)
(SETA CharacterAttributes ScrollRegionTop AttributeBottomLine)
(SETA LineAttributes ScrollRegionTop 5)
(ANSI-Chat-Set-Line-Attribute Chat.State ANSI-State CursorLine])
(ANSI-Chat-Display-Scroll-Up
[LAMBDA (Chat.State ANSI-State)
(DECLARE (GLOBALVARS \CARET.UP)) (* ; "Edited 23-Sep-87 18:06 by R.Beeman")
(* ;; "To scroll up, we blt everything up one, then clear the bottom line")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(LET* ((Width (ITIMES RightMargin FONTWIDTH))
(Bottom (ITIMES (- BottomLine BottomMargin)
FONTHEIGHT))
(ScrollRegionTop (ADD1 TopMargin))
(CharacterTopLine (ELT Characters ScrollRegionTop))
(AttributeTopLine (ELT CharacterAttributes ScrollRegionTop)))
(COND
[Scroll (LET ((ChatStream OUTSTREAM))
(COND
(Flag0 (BOUT ChatStream (CHARCODE ↑S))
(FORCEOUTPUT ChatStream)))
[for ScanLine from 1 to FONTHEIGHT
bind (First ← T)
do (\CHECKCARET DSP)
(BITBLT DSP FONTWIDTH Bottom DSP FONTWIDTH (ADD1 Bottom)
Width
(- (ITIMES (ADD1 (- BottomLine ScrollRegionTop))
FONTHEIGHT)
Bottom 1)
'INPUT
'REPLACE)
(COND
(First (ANSI-Chat-Display-Erase-Region Chat.State
FONTWIDTH Bottom Width 1)
(SETQ First NIL]
(COND
(Flag0 (BOUT ChatStream (CHARCODE ↑Q))
(FORCEOUTPUT ChatStream]
(T (BITBLT DSP FONTWIDTH Bottom DSP FONTWIDTH (+ Bottom FONTHEIGHT)
Width
(- (ITIMES (- BottomLine ScrollRegionTop)
FONTHEIGHT)
Bottom)
'INPUT
'REPLACE)
(ANSI-Chat-Display-Erase-Region Chat.State FONTWIDTH Bottom Width
FONTHEIGHT)))
(SETA CharacterTopLine 0 0)
[for Index from ScrollRegionTop to (SUB1 BottomMargin)
do (SETA LineAttributes Index (ELT LineAttributes (ADD1 Index)))
(SETA Characters Index (ELT Characters (ADD1 Index)))
(SETA CharacterAttributes Index (ELT CharacterAttributes (ADD1 Index]
(SETA Characters BottomMargin CharacterTopLine)
(SETA CharacterAttributes BottomMargin AttributeTopLine)
(SETA LineAttributes BottomMargin 5)
(ANSI-Chat-Set-Line-Attribute Chat.State ANSI-State CursorLine])
(ANSI-Chat-EMACS-Move
[LAMBDA (Chat.State) (* ; "Edited 27-Sep-87 15:59 by R.Beeman")
(* ;;; "This function is invoked in the context of the typeout process, so that we can easily see where we are on the display, and so that we don't hang up the mouse if connection gets in trouble")
(with CHAT.STATE Chat.State (* ; "Chat State")
(LET ((CursorLocation (CURSORPOSITION NIL WINDOW))
(ANSI-State TERM.STATE)
RowsDown NewColumn NewLine)
(with ANSI-STATE ANSI-State (* ; "ANSI State")
[COND
((IGEQ CursorColumn 1) (* ;
"Go back to column 0 (Terminal's column 1)")
(BOUT OUTSTREAM (fetch EMCOL0 of CHAT.EMACSCOMMANDS]
(SETQ RowsDown (- [SETQ NewLine
(IMAX 1 (- BottomLine (IMAX 0 (IQUOTIENT (fetch YCOORD
of CursorLocation
)
FONTHEIGHT]
CursorLine))
(* ;;; "Positive RowsDown means go DOWN")
[COND
((ILESSP RowsDown 0) (* ; "Go up - RowsDown rows")
(COND
((NEQ RowsDown -1)
(BOUT OUTSTREAM (fetch EMARG of CHAT.EMACSCOMMANDS))
(PRIN3 (MKSTRING (IMINUS RowsDown))
OUTSTREAM)))
(BOUT OUTSTREAM (fetch EMUP of CHAT.EMACSCOMMANDS)))
((IGREATERP RowsDown 0) (* ; "Go down RowsDown rows")
(COND
((NEQ RowsDown 1)
(BOUT OUTSTREAM (fetch EMARG of CHAT.EMACSCOMMANDS))
(PRIN3 (MKSTRING RowsDown)
OUTSTREAM)))
(BOUT OUTSTREAM (fetch EMDOWN of CHAT.EMACSCOMMANDS]
[SETQ NewColumn (IMAX 1 (IMIN (ELT (ELT Characters NewLine)
0)
(IQUOTIENT (fetch XCOORD of CursorLocation)
FONTWIDTH]
[COND
((IGREATERP NewColumn 1) (* ; "Now go to the correct column")
(COND
((NEQ NewColumn 2)
(BOUT OUTSTREAM (fetch EMARG of CHAT.EMACSCOMMANDS))
(PRIN3 (MKSTRING (SUB1 NewColumn))
OUTSTREAM)))
(BOUT OUTSTREAM (fetch EMFORWARD of CHAT.EMACSCOMMANDS]
(FORCEOUTPUT OUTSTREAM])
(ANSI-Chat-Erase-In-Display
[LAMBDA (Chat.State ANSI-State Pn) (* ; "Edited 23-Sep-87 18:06 by R.Beeman")
(* ;; "Erases some or all of the characters in the display according to the parameter")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(LET ((Width (ITIMES RightMargin FONTWIDTH))
(Bottom (ITIMES (- BottomLine CursorLine)
FONTHEIGHT)))
(SELECTQ Pn
(0 (* ;
"Erase from the active position to the end of the screen, inclusive")
(ANSI-Chat-Display-Erase-to-End-of-Line Chat.State ANSI-State)
(COND
((= CursorColumn 1)
(SETA LineAttributes CursorLine 5)
(ANSI-Chat-Set-Line-Attribute Chat.State ANSI-State CursorLine)))
[COND
((< CursorLine BottomLine)
(ANSI-Chat-Display-Erase-Region Chat.State FONTWIDTH 0 Width Bottom)
(for Index from (ADD1 CursorLine) to BottomLine
do (SETA LineAttributes Index 5)
(SETA (ELT Characters Index)
0 0])
(1 (* ;
"Erase from the start of the screen to the active position, inclusive")
[COND
((> CursorLine 1)
(ANSI-Chat-Display-Erase-Region Chat.State FONTWIDTH (+ Bottom
FONTHEIGHT)
Width
(ITIMES (SUB1 CursorLine)
FONTHEIGHT))
(for Index from 1 to (SUB1 CursorLine)
do (SETA LineAttributes Index 5)
(SETA (ELT Characters Index)
0 0]
(ANSI-Chat-Display-Erase-Region Chat.State FONTWIDTH Bottom
(ITIMES CursorColumn (COND
(DoubleWide (RSH FONTWIDTH -1))
(T FONTWIDTH)))
FONTHEIGHT)
[LET ((CharacterLine (ELT Characters CursorLine))
(AttributeLine (ELT CharacterAttributes CursorLine)))
(COND
((> (ELT CharacterLine 0)
CursorColumn)
(for Index from 1 to CursorLine
do (SETA CharacterLine Index (CHARCODE SPACE))
(SETA AttributeLine Index 0)))
(T (SETA CharacterLine 0 0]
(COND
((= CursorColumn (COND
(DoubleWide (RSH RightMargin 1))
(T RightMargin)))
(SETA LineAttributes CursorLine 5)
(ANSI-Chat-Set-Line-Attribute Chat.State ANSI-State CursorLine))))
(2 (* ; "Erase all of the display")
(CLEARW WINDOW)
(for Index from 1 to BottomLine do (SETA LineAttributes Index 5)
(SETA (ELT Characters Index)
0 0))
(ANSI-Chat-Address-Absolute Chat.State ANSI-State CursorLine CursorColumn
))
NIL])
(ANSI-Chat-Erase-In-Line
[LAMBDA (Chat.State ANSI-State Ps) (* ; "Edited 18-Sep-87 16:19 by R.Beeman")
(* ;; "Erases some or all characters in the active line according to the parameter")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(LET ((Bottom (ITIMES (- BottomLine CursorLine)
FONTHEIGHT)))
(SELECTQ Ps
(0 (* ;
"Erase from the active position to the end of the line, inclusive")
(ANSI-Chat-Display-Erase-to-End-of-Line Chat.State ANSI-State))
(1 (* ;
"Erase from the start of the line to the active position, inclusive")
(ANSI-Chat-Display-Erase-Region Chat.State FONTWIDTH Bottom
(ITIMES CursorColumn (COND
(DoubleWide (RSH FONTWIDTH -1))
(T FONTWIDTH)))
FONTHEIGHT)
[LET ((CharacterLine (ELT Characters CursorLine))
(AttributeLine (ELT CharacterAttributes CursorLine)))
(COND
((> (ELT CharacterLine 0)
CursorColumn)
(for Index from 1 to CursorColumn
do (SETA CharacterLine Index (CHARCODE SPACE))
(SETA AttributeLine Index 0)))
(T (SETA CharacterLine 0 0])
(2 (* ; "Erases all of the line, inclusive")
(ANSI-Chat-Display-Erase-Region Chat.State FONTWIDTH Bottom
(ITIMES RightMargin FONTWIDTH)
FONTHEIGHT)
(SETA (ELT Characters CursorLine)
0 0))
NIL])
(ANSI-Chat-Escape-Intermediate
[LAMBDA (Chat.State ANSI-State CharacterCode) (* ; "Edited 23-Sep-87 18:32 by R.Beeman")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(COND
((>= CharacterCode (CHARCODE 0)) (* ; "Terminator received")
(SETQ EscapeSequence NIL)
(SELCHARQ IntermediateCharacter
(SPACE (SELCHARQ CharacterCode
(F (* ; "Esc Space F -> S7C1T")
(NILL))
(G (* ; "Esc Space G -> S8C1T")
(NILL))
(ANSI-Chat-Unimplemented-Terminator Chat.State ANSI-State
CharacterCode)))
(%# (SELCHARQ CharacterCode
((3 4 5 6) (* ; "ESC #3 -> DECDHL (Top Half)")
(* ; "ESC #4 -> DECDHL (Bottom Half)")
(* ; "ESC #5 -> DECSWL")
(* ; "ESC #6 -> DECDWL")
(ANSI-Chat-Line-Attribute Chat.State ANSI-State
(- CharacterCode (CHARCODE 0))))
(8 (* ; "ESC #8 -> DECALN")
(ANSI-Chat-Screen-Alignment-Display Chat.State ANSI-State))
(ANSI-Chat-Unimplemented-Terminator Chat.State ANSI-State
CharacterCode)))
((%( %) * +)
(SELCHARQ CharacterCode
((0 4 5 6 7 < = A B C E H K Q R Y Z)
(ANSI-Chat-Set-Character-Set Chat.State ANSI-State
(- IntermediateCharacter (CHARCODE %())
CharacterCode))
(ANSI-Chat-Unimplemented-Terminator Chat.State ANSI-State
CharacterCode)))
(ANSI-Chat-Unimplemented-Intermediate-Character Chat.State ANSI-State
CharacterCode)))
(T (* ; "Another Intermediate Character")
(SETQ IntermediateCharacter (CHARCODE /])
(ANSI-Chat-Escape-Sequence
[LAMBDA (Chat.State ANSI-State CharacterCode) (* ; "Edited 23-Sep-87 18:33 by R.Beeman")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(COND
((>= CharacterCode (CHARCODE 0)) (* ; "Terminator received")
(SETQ EscapeSequence NIL)
(SELCHARQ CharacterCode
(7 (* ; "ESC 7 -> Save parameters")
(ANSI-Chat-Save-Cursor Chat.State ANSI-State))
(8 (* ; "ESC 8 -> Restore parameters")
(ANSI-Chat-Restore-Cursor Chat.State ANSI-State))
(= (* ; "Enter keypad application mode")
(SETQ KeyPad T))
(> (* ; "Leave keypad application mode")
(SETQ KeyPad NIL))
(D (* ; "ESC D -> index")
(ANSI-Chat-Index Chat.State ANSI-State))
(E (* ; "ESC E -> Do CRLF")
(ANSI-Chat-New-Line Chat.State ANSI-State))
(H (* ; "ESC H -> Set tab at position")
(ANSI-Chat-Horizontal-Tabulation-Set Chat.State CursorColumn))
(M (* ; "Reverse Index")
(ANSI-Chat-Reverse-Index Chat.State ANSI-State))
(N (* ; "Esc N -> SS2")
(NILL))
(O (* ; "Esc O -> SS3")
(NILL))
(P (* ; "Esc P -> DCS")
(NILL))
(Z (* ; "Esc Z -> What are you?")
(ANSI-Chat-Identify-Terminal Chat.State))
(%[ (* ; "Esc [ -> CSI")
(SETQ ControlSequence T)
(SETQ ParameterCount 1)
(SETA Parameters 1 0)
(SETQ NumericParameter NIL)
(SETQ NonNumericParameter NIL))
(\ (* ; "Esc -> ST")
(NILL))
(c (* ; "Esc c -> RIS")
(NILL))
(n (* ; "Esc n -> LS2")
(NILL))
(o (* ; "Esc o -> LS3")
(NILL))
(%| (* ; "Esc | -> LS3R")
(NILL))
(} (* ; "Esc } -> LS2R")
(NILL))
(~ (* ; "Esc ~ -> LS1R")
(NILL))
(ANSI-Chat-Unimplemented-Terminator Chat.State ANSI-State CharacterCode)))
(T (* ; "Intermediate Character")
(SETQ IntermediateCharacter CharacterCode])
(ANSI-Chat-Handle-Character
[LAMBDA (CharacterCode Chat.State ANSI-State)
(DECLARE (GLOBALVARS INVERTWINDOWFN)) (* ; "Edited 11-Sep-87 11:08 by R.Beeman")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(COND
(Debug (ANSI-Chat-Debug CharacterCode)))
(COND
(Dinged (APPLY* INVERTWINDOWFN WINDOW)
(SETQ Dinged NIL)))
(COND
((< CharacterCode (CHARCODE SPACE))
(ANSI-Chat-Control-Character Chat.State ANSI-State CharacterCode))
(T (COND
((< CharacterCode (CHARCODE DEL))
(COND
[EscapeSequence (COND
(IntermediateCharacter (ANSI-Chat-Escape-Intermediate
Chat.State ANSI-State
CharacterCode))
(T (ANSI-Chat-Escape-Sequence Chat.State ANSI-State
CharacterCode]
[ControlSequence (COND
(IntermediateCharacter (ANSI-Chat-CSI-Intermediate
Chat.State ANSI-State
CharacterCode))
(T (ANSI-Chat-Control-Sequence Chat.State ANSI-State
CharacterCode]
(T (ANSI-Chat-Print-From-Character-Set Chat.State ANSI-State
CharacterCode])
(ANSI-Chat-Horizontal-Tab
[LAMBDA (Chat.State ANSI-State) (* ; "Edited 18-Sep-87 17:17 by R.Beeman")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(ANSI-Chat-Address-Absolute Chat.State ANSI-State CursorLine
(OR (for TabStop in TERM.TAB.STOPS thereis (> TabStop CursorColumn))
RightMargin))
(SETQ AtRightMargin NIL])
(ANSI-Chat-Horizontal-Tabulation-Set
[LAMBDA (Chat.State Column) (* ; "Edited 11-Sep-87 16:58 by R.Beeman")
(* ;;; "Set a new tab stop for the terminal")
(with CHAT.STATE Chat.State (* ; "Chat State")
(SETQ TERM.TAB.STOPS (MERGEINSERT Column TERM.TAB.STOPS T])
(ANSI-Chat-IconFn
[LAMBDA (Window OldIcon)
(DECLARE (GLOBALVARS ANSI-Chat-Icon-Template ANSI-Chat-Icon-Bitmap ANSI-Chat-Mask-Bitmap
ANSI-Chat-Icon-Title-Region)) (* ; "Edited 9-Sep-87 18:29 by R.Beeman")
(COND
((TTY.PROCESSP (WINDOWPROP Window 'PROCESS))
(TTY.PROCESS T)))
(OR OldIcon (TITLEDICONW (OR ANSI-Chat-Icon-Template
(SETQ ANSI-Chat-Icon-Template
(create TITLEDICON
ICON ← ANSI-Chat-Icon-Bitmap
MASK ← ANSI-Chat-Mask-Bitmap
TITLEREG ← ANSI-Chat-Icon-Title-Region)))
(CAR (WINDOWPROP Window 'CHATHOST))
(FONTCREATE 'HELVETICA 8])
(ANSI-Chat-Identify-Terminal
[LAMBDA (Chat.State) (* ; "Edited 31-Aug-87 11:24 by R.Beeman")
(* ;;; "Send a device attributes (DA) control sequence")
(with CHAT.STATE Chat.State (* ; "Chat State")
(PRIN1 TERM.IDENTITY.STRING OUTSTREAM)
(FORCEOUTPUT OUTSTREAM])
(ANSI-Chat-Index
[LAMBDA (Chat.State ANSI-State) (* ; "Edited 18-Sep-87 17:17 by R.Beeman")
(* ;;; "Scroll if at bottom of scrolling region, else move down one line")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(COND
((EQP CursorLine BottomMargin) (* ;
"On bottom line of scrolling region, scroll ")
(ANSI-Chat-Display-Scroll-Up Chat.State ANSI-State))
(T (ANSI-Chat-Address-Absolute Chat.State ANSI-State (IMIN (COND
((< CursorLine
BottomMargin)
(* ; "In or above scrolling region")
BottomMargin)
(T
(* ; "Below scrolling region")
BottomLine))
(ADD1 CursorLine))
CursorColumn)))
(SETQ AtRightMargin NIL])
(ANSI-Chat-Initialize
[LAMBDA (Chat.State)
(DECLARE (GLOBALVARS ANSI-Chat-Dashing)) (* ; "Edited 23-Sep-87 18:00 by R.Beeman")
(with CHAT.STATE Chat.State (* ; "Chat State")
(LET ((ANSI-State (create ANSI-STATE)))
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(SETQ TERM.IDENTITY.STRING (CONSTANT (CONCAT (CHARACTER (CHARCODE ESC))
"[?1;2c")))
(SETQ TERM.TAB.STOPS
(LIST 9 17 25 33 41 49 57 65 73 81 89 97 105 113 121 129 137))
(SETQ Wraparound T)
(SETQ Flag0 T) (* ; "AutoXonXoff")
(SETQ Parameters (ARRAY 16 'SMALLP 0 1))
(SETQ CharacterSet 0)
(SETQ CursorLine 1)
(SETQ CursorColumn 1)
(SETQ LineAttribute 5)
[COND
((NOT (AND (BOUNDP 'ANSI-Chat-Dashing)
(BITMAPP ANSI-Chat-Dashing)
(= (BITMAPWIDTH ANSI-Chat-Dashing)
SCREENWIDTH)))
(SETQ ANSI-Chat-Dashing (BITMAPCREATE SCREENWIDTH 1 1))
(for Left from 1 to SCREENWIDTH by 3
do (BLTSHADE BLACKSHADE ANSI-Chat-Dashing Left 0 2 1 'REPLACE]
(* ;; "")
(SETQ FontDescriptors (ANSI-Chat-Build-Font-Descriptors))
(SETQ DoubleWideFonts (EQP (LENGTH (CAR FontDescriptors))
8))
(LET ((Font (LISTGET (CAR FontDescriptors)
5)))
(DSPFONT Font DSP)
(SETQ FONTWIDTH (CHARWIDTH (CHARCODE A)
Font))
(SETQ FONTDESCENT (FONTPROP Font 'DESCENT))
(SETQ FONTHEIGHT (+ (FONTPROP Font 'ASCENT)
FONTDESCENT)))
(* ;; "")
(SETQ BottomMargin (SETQ BottomLine (IQUOTIENT (WINDOWPROP WINDOW 'HEIGHT)
FONTHEIGHT)))
(SETQ TopMargin 0)
(* ;; "")
(WINDOWPROP WINDOW 'RESHAPEFN (FUNCTION ANSI-Chat-ReshapeFn))
(WINDOWPROP WINDOW 'REPAINTFN (FUNCTION ANSI-Chat-RepaintFn))
(WINDOWPROP WINDOW 'NEWREGIONFN (FUNCTION ANSI-Chat-NewRegionFn))
(WINDOWPROP WINDOW 'BUTTONEVENTFN (FUNCTION ANSI-Chat-ButtonEventFn))
(WINDOWPROP WINDOW 'CLOSEFN (FUNCTION ANSI-Chat-CloseFn))
(WINDOWPROP WINDOW 'ICONFN (FUNCTION ANSI-Chat-IconFn))
(WINDOWPROP WINDOW 'COPYBUTTONEVENTFN (FUNCTION ANSI-Chat-CopyButtonEventFn))
(BLOCK) (* ; "Try to lose race and win display")
(ANSI-Chat-Did-Reshape Chat.State ANSI-State))
ANSI-State])
(ANSI-Chat-Menu
[LAMBDA (Window)
(DECLARE (GLOBALVARS ANSI-Chat-Menu-Items \CARET.UP)) (* ; "Edited 25-Sep-87 16:11 by R.Beeman")
(PROG ((Chat.State (WINDOWPROP Window 'CHATSTATE))
Command)
[COND
((NOT Chat.State) (* ;
"No Connection here; try to reestablish")
(RETURN (COND
((LASTMOUSESTATE MIDDLE)
(ANSI-Chat-Reconnect Window))
(T (TOTOPW Window]
(replace (CHAT.STATE HELD) of Chat.State with T)
(\CHECKCARET Window)
(SELECTQ [SETQ Command (MENU (create MENU
ITEMS ←
(APPEND ANSI-Chat-Menu-Items (STREAMPROP
(fetch (CHAT.STATE
INSTREAM)
of Chat.State)
'OPTIONS)
[if (fetch (CHAT.STATE LOCALECHO) of Chat.State)
then '(("Local Echo OFF" 'Echo
"Turn off local echoing"))
else '(("Local Echo ON" 'Echo
"Turn on local echoing"]
'((Close 'Close
"Closes the connection and returns")
(Suspend 'Suspend
"Closes the connection but leaves window up"
)
(New 'New
"Closes this connection and prompts for a new host"
)
(Freeze 'Freeze
"Holds typeout in this window until you bug it again"
)
(Clear (FUNCTION ANSI-Chat-Clear-From-Menu)
"Clears window, sets roll mode")
("Dribble" (FUNCTION CHAT.TYPESCRIPT)
"Starts a typescript of window typeout"
)
("Input" (FUNCTION CHAT.TAKE.INPUT)
"Allows input from a file")
("Emacs" (FUNCTION ANSI-Chat-Switch-EMACS)
"Toggle EMACS positioning"]
(Echo (replace (CHAT.STATE LOCALECHO) of Chat.State with (NOT (fetch (CHAT.STATE
LOCALECHO)
of Chat.State))))
(Close (* ;
"Ask CHAT.TYPEIN to shut things down.")
(replace (CHAT.STATE RUNNING?) of Chat.State with 'CLOSE))
(New (replace (CHAT.STATE RUNNING?) of Chat.State with 'CLOSE)
(WINDOWPROP Window 'KEEPCHAT 'NEW))
(Suspend (replace (CHAT.STATE RUNNING?) of Chat.State with 'CLOSE)
(WINDOWPROP Window 'KEEPCHAT T))
(Freeze (* ; "Leave in HELD state")
(RETURN))
(NIL)
(APPLY* Command Chat.State Window))
(replace (CHAT.STATE HELD) of Chat.State with NIL])
(ANSI-Chat-Move-To
[LAMBDA (Chat.State X Y) (* ; "Edited 10-Sep-87 13:01 by R.Beeman")
(with CHAT.STATE Chat.State (* ; "Chat State")
(MOVETO (SETQ XPOS X)
(SETQ YPOS Y)
DSP])
(ANSI-Chat-New-Line
[LAMBDA (Chat.State ANSI-State) (* ; "Edited 11-Sep-87 14:51 by R.Beeman")
(* ;; "Do LF then CR")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(ANSI-Chat-Index Chat.State ANSI-State)
(ANSI-Chat-Address-Absolute Chat.State ANSI-State CursorLine 1])
(ANSI-Chat-NewRegionFn
[LAMBDA (FixedPoint MovingPoint Window)
(DECLARE (GLOBALVARS SCREENWIDTH SCREENHEIGHT)) (* ; "Edited 18-Sep-87 08:16 by R.Beeman")
(COND
((NULL MovingPoint)
FixedPoint)
(T (LET* [(Chat.State (WINDOWPROP Window 'CHATSTATE))
(Chat.Process (AND Chat.State (type? CHAT.STATE Chat.State)
(fetch (CHAT.STATE TYPEOUTPROC) of Chat.State]
(COND
[(AND (PROCESSP Chat.Process)
(NOT (RELPROCESSP Chat.Process)))
(LET* ((Fx (fetch (POSITION XCOORD) of FixedPoint))
(Fy (fetch (POSITION YCOORD) of FixedPoint))
(Mx (fetch (POSITION XCOORD) of MovingPoint))
(My (fetch (POSITION YCOORD) of MovingPoint))
(WindowBorder (WINDOWPROP Window 'BORDER))
(XDelta (- (WIDTHIFWINDOW 255 WindowBorder)
255))
(YDelta (- (HEIGHTIFWINDOW 255 T WindowBorder)
255))
(CharacterWidth (fetch (CHAT.STATE FONTWIDTH) of Chat.State))
(CharacterHeight (fetch (CHAT.STATE FONTHEIGHT) of Chat.State))
(DoubleCharacterWidth (RSH CharacterWidth -1))
(HalfCharacterHeight (RSH CharacterHeight 1)))
(create POSITION
XCOORD ←
[COND
[(< Mx Fx) (* ; "MovingPoint is Left of FixedPoint")
(LET [(NewMx (+ (- Mx CharacterWidth 1)
(IMOD (+ (- Fx Mx XDelta)
CharacterWidth)
DoubleCharacterWidth]
(COND
((>= NewMx 0)
NewMx)
(T (+ NewMx DoubleCharacterWidth]
(T (* ;
"MovingPoint is Right of FixedPoint")
(LET [(NewMx (- (+ Mx CharacterWidth 1)
(IMOD (+ (- Mx Fx XDelta)
CharacterWidth)
DoubleCharacterWidth]
(COND
((<= NewMx SCREENWIDTH)
NewMx)
(T (- NewMx DoubleCharacterWidth]
YCOORD ←
(COND
[(< My Fy) (* ; "MovingPoint is Below FixedPoint")
(LET [(NewMy (+ (- My HalfCharacterHeight)
(IMOD (+ (- (- Fy My)
YDelta)
HalfCharacterHeight)
CharacterHeight]
(COND
((>= NewMy 0)
NewMy)
(T (+ NewMy CharacterHeight]
(T (* ; "MovingPoint is Above FixedPoint")
(LET [(NewMy (- (+ My HalfCharacterHeight)
(IMOD (+ (- (- My Fy)
YDelta)
HalfCharacterHeight)
CharacterHeight]
(COND
((<= NewMy SCREENHEIGHT)
NewMy)
(T (- NewMy CharacterHeight]
(T MovingPoint])
(ANSI-Chat-Print-Character
[LAMBDA (Chat.State ANSI-State CharacterCode) (* ; "Edited 18-Sep-87 14:09 by R.Beeman")
(* ;;; "Print a character. If WRAPMODE is T and we reach the right margin, we perform an explict newline, else we peg at the right margin")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(COND
((AND AtRightMargin Wraparound)
(ANSI-Chat-New-Line Chat.State ANSI-State)))
(LET* ((CharacterLine (ELT Characters CursorLine))
(AttributeLine (ELT CharacterAttributes CursorLine))
(LineWidth (ELT CharacterLine 0))
(NextCharacter (ADD1 LineWidth)))
[COND
((> CursorColumn NextCharacter)
(for Index from NextCharacter to (SUB1 CursorColumn)
do (SETA CharacterLine Index (CHARCODE SPACE))
(SETA AttributeLine Index 0))
(SETA CharacterLine 0 CursorColumn))
(T (SETA CharacterLine 0 (IMAX CursorColumn LineWidth]
(SETA CharacterLine CursorColumn CharacterCode)
(SETA AttributeLine CursorColumn Attributes))
(\OUTCHAR DSP CharacterCode) (* ; "Print the char")
(COND
((AND (OR Underscore Blink)
(NOT (= LineAttribute 3)))
(ANSI-Chat-Underline Chat.State ANSI-State CursorLine CursorColumn)))
(COND
((> (SETQ CursorColumn (PROGN [SETQ XPOS (+ XPOS (COND
(DoubleWide (RSH FONTWIDTH -1)
)
(T FONTWIDTH]
(ADD1 CursorColumn)))
(COND
(DoubleWide (RSH RightMargin 1))
(T RightMargin)))
(SETQ AtRightMargin Wraparound)
(ANSI-Chat-Address-Absolute Chat.State ANSI-State CursorLine RightMargin])
(ANSI-Chat-Print-From-Character-Set
[LAMBDA (Chat.State ANSI-State CharacterCode)
(DECLARE (GLOBALVARS ANSI-ASCII-Graphics-Character-Set))
(* ; "Edited 31-Aug-87 12:05 by R.Beeman")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(ANSI-Chat-Print-Character Chat.State ANSI-State
(LET [(TranslationIndex (- CharacterCode (CHARCODE SPACE]
(ELT (OR (LISTGET CharacterSets CharacterSet)
ANSI-ASCII-Graphics-Character-Set)
TranslationIndex])
(ANSI-Chat-Reconnect
[LAMBDA (Window)
(DECLARE (GLOBALVARS ANSI-Chat-ReOpen-Menu)) (* ; "Edited 8-Sep-87 11:46 by R.Beeman")
(LET* ((MainWindow (OR (WINDOWPROP Window 'ICONFOR)
Window))
(OldHostInfo (WINDOWPROP MainWindow 'CHATHOST))
Command)
(COND
((NULL OldHostInfo)
(APPLY* (CHAT.RECONNECT.OFF Window)
Window))
((NOT (LASTMOUSESTATE MIDDLE))
(APPLY* (OR (WINDOWPROP Window 'OLDBUTTONEVENTFN)
(FUNCTION TOTOPW))
Window))
(T (SELECTQ [SETQ Command (MENU (OR ANSI-Chat-ReOpen-Menu
(SETQ ANSI-Chat-ReOpen-Menu
(create MENU
ITEMS ← '((ReConnect 'ReConnect
"Will reestablish this Chat connection"
)
(New 'New "Prompts for a new host"
]
(ReConnect (CHAT.RECONNECT.OFF Window) (* ;
"Don't let this command get issued twice")
(TTY.PROCESS (ADD.PROCESS (LIST 'CHAT (KWOTE (CAR OldHostInfo))
(KWOTE (CDR OldHostInfo))
NIL MainWindow T))))
(New (CHAT.RECONNECT.OFF Window) (* ;
"Don't let this command get issued twice")
(TTY.PROCESS (ADD.PROCESS (LIST 'CHAT NIL NIL NIL MainWindow T))))
NIL])
(ANSI-Chat-Redisplay-Line
[LAMBDA (Chat.State ANSI-State Line) (* ; "Edited 23-Sep-87 18:05 by R.Beeman")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(LET* ((Width (ITIMES RightMargin FONTWIDTH))
(Bottom (ITIMES (- BottomLine Line)
FONTHEIGHT))
(CurrentCharacterAttributes Attributes)
(PrintingCharacterAttributes CurrentCharacterAttributes)
(CharacterLine (ELT Characters Line))
(AttributeLine (ELT CharacterAttributes Line))
(PrintingLineAttribute (ELT LineAttributes Line)))
(ANSI-Chat-Display-Erase-Region Chat.State FONTWIDTH Bottom Width FONTHEIGHT)
(MOVETO FONTWIDTH (+ (ITIMES (- BottomLine Line)
FONTHEIGHT)
FONTDESCENT)
DSP)
(ANSI-Chat-Set-Line-Attribute Chat.State ANSI-State Line)
[for Index from 1 to [IMIN (ELT CharacterLine 0)
(COND
((OR (NOT DoubleWideFonts)
(= PrintingLineAttribute 5))
RightMargin)
(T (RSH RightMargin 1]
do (LET ((NextCharacterAttributes (ELT AttributeLine Index)))
(COND
((NOT (= PrintingCharacterAttributes NextCharacterAttributes))
(ANSI-Chat-Set-Character-Attributes Chat.State ANSI-State
(SETQ PrintingCharacterAttributes NextCharacterAttributes
)
Line)))
(\OUTCHAR DSP (ELT CharacterLine Index))
(COND
((AND (OR Underscore Blink)
(NOT (= PrintingLineAttribute 3)))
(ANSI-Chat-Underline Chat.State ANSI-State Line Index]
(COND
((NOT (= PrintingCharacterAttributes CurrentCharacterAttributes))
(ANSI-Chat-Set-Character-Attributes Chat.State ANSI-State
CurrentCharacterAttributes Line])
(ANSI-Chat-RepaintFn
[LAMBDA (Window Region) (* ; "Edited 22-Sep-87 18:43 by R.Beeman")
(LET* [(Chat.State (WINDOWPROP Window 'CHATSTATE))
(Chat.Process (AND Chat.State (type? CHAT.STATE Chat.State)
(fetch (CHAT.STATE TYPEOUTPROC) of Chat.State)))
(ANSI-State (AND Chat.State (type? CHAT.STATE Chat.State)
(fetch (CHAT.STATE TERM.STATE) of Chat.State]
(COND
((AND (PROCESSP Chat.Process)
(NOT (RELPROCESSP Chat.Process))
(type? ANSI-STATE ANSI-State))
(DSPFILL Region NIL NIL (fetch (CHAT.STATE DSP) of Chat.State))
(for Line from 1 to (fetch (ANSI-STATE BottomLine) of ANSI-State)
do (ANSI-Chat-Redisplay-Line Chat.State ANSI-State Line))
(ANSI-Chat-Address-Absolute Chat.State ANSI-State (fetch (ANSI-STATE CursorLine)
of ANSI-State)
(fetch (ANSI-STATE CursorColumn) of ANSI-State])
(ANSI-Chat-Reset-Mode
[LAMBDA (Chat.State ANSI-State) (* ; "Edited 4-Sep-87 14:17 by R.Beeman")
(* ;; "Does mode resetting")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(for Index from 1 to ParameterCount
do (SELECTQ (ELT Parameters Index)
(1 (SETQ Cursor NIL))
(4 (SETQ Scroll NIL))
(5 (COND
(Screen (SETQ Screen NIL)
(INVERTW WINDOW)
(DSPSOURCETYPE (COND
(Negative 'INVERT)
(T 'INPUT))
DSP)
(DSPTEXTURE WHITESHADE DSP))))
(6 (SETQ Origin NIL)
(ANSI-Chat-Address Chat.State ANSI-State 1 1))
(7 (SETQ Wraparound NIL))
NIL])
(ANSI-Chat-ReshapeFn
[LAMBDA (Window OldImage ImageRegion OldScreenRegion) (* ; "Edited 22-Sep-87 16:54 by R.Beeman")
(* ;; "RESHAPEFN for ANSI-Chat windows")
(* ;; "Reshaping copies the upper left portion of the old image into the upper left of the new image. No repainting is done. Extent is assumed to be NIL and is not modified.")
(LET* [(Chat.State (WINDOWPROP Window 'CHATSTATE))
(Chat.Process (AND Chat.State (type? CHAT.STATE Chat.State)
(fetch (CHAT.STATE TYPEOUTPROC) of Chat.State]
(COND
((AND (PROCESSP Chat.Process)
(NOT (RELPROCESSP Chat.Process)))
(with CHAT.STATE Chat.State (* ; "Chat State")
(LET* ((ANSI-State TERM.STATE)
(OldWidth (ITIMES (fetch (ANSI-STATE RightMargin) of ANSI-State)
FONTWIDTH))
(OldHeight (ITIMES (fetch (ANSI-STATE BottomLine) of ANSI-State)
FONTHEIGHT))
(NewClippingRegion (DSPCLIPPINGREGION NIL DSP))
(NewWidth (fetch (REGION WIDTH) of NewClippingRegion))
(NewHeight (fetch (REGION HEIGHT) of NewClippingRegion)))
(SETQ NewWidth (- NewWidth (IMOD NewWidth (RSH FONTWIDTH -1))
(RSH FONTWIDTH -1)))
(SETQ NewHeight (- NewHeight (IMOD NewHeight FONTHEIGHT)))
(BITBLT OldImage (+ (fetch (REGION LEFT) of ImageRegion)
FONTWIDTH)
(+ (fetch (REGION BOTTOM) of ImageRegion)
(IMAX 0 (- OldHeight NewHeight)))
DSP FONTWIDTH (IMAX 0 (- NewHeight OldHeight))
(IMIN OldWidth NewWidth)
(IMIN OldHeight NewHeight)
'INPUT
'REPLACE)
(PROCESS.APPLY Chat.Process (FUNCTION ANSI-Chat-Did-Reshape)
(LIST Chat.State ANSI-State])
(ANSI-Chat-Restore-Cursor
[LAMBDA (Chat.State ANSI-State) (* ; "Edited 22-Sep-87 18:50 by R.Beeman")
(* ;; "Function to restor cursor, etc from storage")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(COND
[(LISTP CursorMemory)
(LET ((CursorColumnLine (fetch (ANSI-Cursor-and-Attributes CursorPosition)
of CursorMemory))
(SavedState (fetch (ANSI-Cursor-and-Attributes StateFlags) of CursorMemory)
))
(ANSI-Chat-Address-Absolute Chat.State ANSI-State (fetch (POSITION YCOORD)
of CursorColumnLine)
(fetch (POSITION XCOORD) of CursorColumnLine))
(SETQ AtRightMargin NIL)
(ANSI-Chat-Set-Character-Attributes Chat.State ANSI-State
(fetch (ANSI-Cursor-and-Attributes SavedCharacterAttributes)
of CursorMemory)
CursorLine)
(SETQ WRAPMODE (CAR SavedState))
(SETQ Origin (CADR SavedState))
(SETQ NotEraseable (CADDR SavedState))
(SETQ CharacterSet (fetch (ANSI-Cursor-and-Attributes CharacterSetShift)
of CursorMemory]
(T (ANSI-Chat-Address Chat.State ANSI-State 1 1)
(ANSI-Chat-Set-Character-Attributes Chat.State ANSI-State 0 CursorLine)
(SETQ WRAPMODE T)
(SETQ Origin NIL)
(SETQ NotEraseable NIL)
(SETQ CharacterSet 0])
(ANSI-Chat-Reverse-Index
[LAMBDA (Chat.State ANSI-State) (* ; "Edited 18-Sep-87 17:18 by R.Beeman")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(LET ((ScrollRegionTop (PLUS 1 TopMargin)))
(COND
((= CursorLine ScrollRegionTop) (* ; "At top of the scrolling region")
(ANSI-Chat-Display-Scroll-Down Chat.State ANSI-State))
(T (ANSI-Chat-Address-Absolute Chat.State ANSI-State
(IMAX (COND
((> CursorLine ScrollRegionTop)
(* ; "In or below scrolling region")
ScrollRegionTop)
(T (* ; "Above scrolling region")
1))
(SUB1 CursorLine))
CursorColumn)))
(SETQ AtRightMargin NIL])
(ANSI-Chat-Save-Cursor
[LAMBDA (Chat.State ANSI-State) (* ; "Edited 18-Sep-87 13:53 by R.Beeman")
(* ;; "Function to save current cursor position, graphic rendition, and character set")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(with ANSI-Cursor-and-Attributes (OR (LISTP CursorMemory)
(SETQ CursorMemory (create
ANSI-Cursor-and-Attributes
)))
(* ; "Saved Cursor State")
(SETQ CursorPosition (create POSITION
XCOORD ← CursorColumn
YCOORD ← CursorLine))
(SETQ SavedCharacterAttributes Attributes)
(SETQ StateFlags (LIST WRAPMODE Origin NotEraseable))
(SETQ CharacterSetShift CharacterSet])
(ANSI-Chat-Screen-Alignment-Display
[LAMBDA (Chat.State ANSI-State) (* ; "Edited 18-Sep-87 17:19 by R.Beeman")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(CLEARW WINDOW)
(SETQ Origin NIL)
[for Index from 1 to BottomLine
do (SETA LineAttributes Index 5)
(LET ((CharacterLine (ELT Characters Index))
(AttributeLine (ELT CharacterAttributes Index)))
(SETA CharacterLine 0 RightMargin)
(for Character from 1 to RightMargin do (SETA CharacterLine Character
(CHARCODE E))
(SETA AttributeLine Character 0]
(ANSI-Chat-Address-Absolute Chat.State ANSI-State 1 1)
(\OUTCHAR DSP (CHARCODE E))
(ANSI-Chat-Address-Absolute Chat.State ANSI-State 1 1)
(SETQ AtRightMargin NIL)
(LET [(Y (ITIMES (SUB1 BottomLine)
FONTHEIGHT))
(ScreenWidth (ITIMES RightMargin FONTWIDTH))
(Log2x (SUB1 (INTEGERLENGTH RightMargin)))
(Log2y (SUB1 (INTEGERLENGTH BottomLine]
[for N from 0 to Log2x do (LET [(Width (ITIMES FONTWIDTH (EXPT 2 N]
(BITBLT DSP FONTWIDTH Y DSP (+ Width FONTWIDTH)
Y
(COND
((= N Log2x)
(- ScreenWidth Width))
(T Width))
FONTHEIGHT
'INPUT
'REPLACE]
(for N from 0 to Log2y
do (LET [(Height (ITIMES FONTHEIGHT (EXPT 2 N]
(BITBLT DSP FONTWIDTH (- Y (- Height FONTHEIGHT))
DSP FONTWIDTH [COND
((= N Log2y)
0)
(T (- Y (- (ITIMES Height 2)
FONTHEIGHT]
ScreenWidth
(COND
((= N Log2y)
(- (+ Y FONTHEIGHT)
Height))
(T Height))
'INPUT
'REPLACE])
(ANSI-Chat-Screen-Parameters
[LAMBDA (Chat.State ANSI-State InStream Window) (* ; "Edited 25-Sep-87 16:01 by R.Beeman")
(* ;; "Sends screen width, height to partner and updates title. ")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(LET* ((OldTitle (WINDOWPROP Window 'TITLE))
(TitleMiddle (STRPOS ", height" OldTitle))
(EMACSMODE CHATINEMACS))
[COND
(InStream (* ;
"If INSTREAM is NIL then only update title.")
(* ;; "Protocol doesn't handle values > 127")
(CHAT.SENDSCREENPARAMS InStream (IMIN BottomLine 127)
(IMIN RightMargin 127]
(WINDOWPROP Window 'TITLE
(CONCAT (SUBSTRING OldTitle 1 (SUB1 (OR TitleMiddle 0)))
", height = " BottomLine ", width = " RightMargin
(COND
[[OR EMACSMODE (AND TitleMiddle (NOT (FIXP (NTHCHAR OldTitle
-1]
(CONCAT ", Emacs " (COND
(EMACSMODE "On")
(T "Off"]
(T ""])
(ANSI-Chat-Set-Character-Attributes
[LAMBDA (Chat.State ANSI-State NewCharacterAttributes Line)
(* ; "Edited 22-Sep-87 18:52 by R.Beeman")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
[LET [(ChangedCharacterAttributes (LOGXOR Attributes NewCharacterAttributes))
(NewLineAttribute (COND
(DoubleWideFonts (ELT LineAttributes Line))
(T 5]
[COND
((BITTEST ChangedCharacterAttributes 1)
(COND
((BITTEST NewCharacterAttributes 1)
(SETQ Bold T)
(DSPFONT (LISTGET (CDR FontDescriptors)
NewLineAttribute)
DSP))
(T (SETQ Bold NIL)
(DSPFONT (LISTGET (CAR FontDescriptors)
NewLineAttribute)
DSP]
[COND
((BITTEST ChangedCharacterAttributes 2)
(SETQ Underscore (BITTEST NewCharacterAttributes 2]
[COND
((BITTEST ChangedCharacterAttributes 4)
(SETQ Blink (BITTEST NewCharacterAttributes 4]
(COND
((BITTEST ChangedCharacterAttributes 8)
(COND
((BITTEST NewCharacterAttributes 8)
(SETQ Negative T)
(DSPSOURCETYPE (COND
(Screen 'INPUT)
(T 'INVERT))
DSP))
(T (SETQ Negative NIL)
(DSPSOURCETYPE (COND
(Screen 'INVERT)
(T 'INPUT))
DSP]
(SETQ Attributes NewCharacterAttributes])
(ANSI-Chat-Set-Character-Set
[LAMBDA (Chat.State ANSI-State ANSI-CharacterSet CharacterCode)
(DECLARE (GLOBALVARS ANSI-ASCII-Graphics-Character-Set ANSI-Supplemental-Graphics-Character-Set
ANSI-Special-Graphics-Character-Set ANSI-British-NRC-Character-Set
ANSI-Dutch-NRC-Character-Set ANSI-Finnish-NRC-Character-Set
ANSI-French-NRC-Character-Set ANSI-French-Canadian-NRC-Character-Set
ANSI-German-NRC-Character-Set ANSI-Italian-NRC-Character-Set
ANSI-Norwegian/Danish-NRC-Character-Set ANSI-Spanish-NRC-Character-Set
ANSI-Swedish-NRC-Character-Set ANSI-Swiss-NRC-Character-Set))
(* ; "Edited 31-Aug-87 13:50 by R.Beeman")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(SETQ EscapeSequence NIL)
[COND
((NOT (LISTP CharacterSets))
(SETQ CharacterSets (LIST 0 ANSI-ASCII-Graphics-Character-Set]
(LISTPUT CharacterSets ANSI-CharacterSet (SELCHARQ CharacterCode
(0
(* ; "DEC Special Graphics")
ANSI-Special-Graphics-Character-Set)
(4
(* ; "Dutch")
ANSI-Dutch-NRC-Character-Set)
(5
(* ; "Finnish")
ANSI-Finnish-NRC-Character-Set)
(6
(* ; "Norwegian/Danish")
ANSI-Norwegian/Danish-NRC-Character-Set)
(7
(* ; "Swedish")
ANSI-Swedish-NRC-Character-Set)
(<
(* ; "DEC Supplemental")
ANSI-Supplemental-Graphics-Character-Set)
(=
(* ; "Swiss")
ANSI-Swiss-NRC-Character-Set)
(A
(* ; "British")
ANSI-British-NRC-Character-Set)
(B
(* ; "ASCII")
ANSI-ASCII-Graphics-Character-Set)
(C
(* ; "Finnish")
ANSI-Finnish-NRC-Character-Set)
(E
(* ; "Norwegian/Danish")
ANSI-Norwegian/Danish-NRC-Character-Set)
(H
(* ; "Swedish")
ANSI-Swedish-NRC-Character-Set)
(K
(* ; "German")
ANSI-German-NRC-Character-Set)
(Q
(* ; "French Canadian")
ANSI-French-Canadian-NRC-Character-Set)
(R
(* ; "French")
ANSI-French-NRC-Character-Set)
(Y
(* ; "Italian")
ANSI-Italian-NRC-Character-Set)
(Z
(* ; "Spanish")
ANSI-Spanish-NRC-Character-Set)
(SHOULDNT
"Unrecognized Character Set Designator"
])
(ANSI-Chat-Set-Line-Attribute
[LAMBDA (Chat.State ANSI-State Line) (* ; "Edited 23-Sep-87 18:04 by R.Beeman")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(COND
([AND DoubleWideFonts (NOT (= LineAttribute (SETQ LineAttribute (ELT
LineAttributes
Line]
(SETQ DoubleWide (NOT (= LineAttribute 5)))
(DSPFONT (LISTGET (COND
(Bold (CDR FontDescriptors))
(T (CAR FontDescriptors)))
LineAttribute)
DSP])
(ANSI-Chat-Set-Mode
[LAMBDA (Chat.State ANSI-State) (* ; "Edited 4-Sep-87 14:18 by R.Beeman")
(* ;; "Does mode setting")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(for Index from 1 to ParameterCount
do (SELECTQ (ELT Parameters Index)
(1 (SETQ Cursor T))
(4 (SETQ Scroll T))
(5 (COND
((NULL Screen)
(SETQ Screen T)
(INVERTW WINDOW)
(DSPSOURCETYPE (COND
(Negative 'INPUT)
(T 'INVERT))
DSP)
(DSPTEXTURE BLACKSHADE DSP))))
(6 (SETQ Origin T)
(ANSI-Chat-Address Chat.State ANSI-State 1 1))
(7 (SETQ Wraparound T))
NIL])
(ANSI-Chat-Set-Top-and-Bottom-Margins
[LAMBDA (Chat.State ANSI-State Pt Pb) (* ; "Edited 11-Sep-87 17:22 by R.Beeman")
(* ;; "Define Scrolling Region")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(COND
((ZEROP Pt)
(SETQ Pt 1)))
(COND
((ZEROP Pb)
(SETQ Pb BottomLine)))
(COND
((AND (<= Pb BottomLine)
(< Pt Pb)) (* ; "Validate parameters")
(SETQ TopMargin (SUB1 Pt))
(SETQ BottomMargin Pb)
(SETQ TOPMARGIN (+ (ITIMES (- BottomLine TopMargin)
FONTHEIGHT)
FONTDESCENT))
(SETQ BOTTOMMARGIN (+ (ITIMES (- BottomLine BottomMargin)
FONTHEIGHT)))
(ANSI-Chat-Address Chat.State ANSI-State 1 1])
(ANSI-Chat-Switch-EMACS
[LAMBDA (Chat.State Window) (* ; "Edited 25-Sep-87 16:02 by R.Beeman")
(* ;;; "Toggles the value of CHAT.IN.EMACS?")
(replace (CHAT.STATE CHATINEMACS) of Chat.State with (NOT (fetch (CHAT.STATE CHATINEMACS)
of Chat.State)))
(* ;
"Now update title to show Emacs state")
(ANSI-Chat-Screen-Parameters Chat.State NIL Window])
(ANSI-Chat-Tabulation-Clear
[LAMBDA (Chat.State Position) (* ; "Edited 31-Aug-87 11:19 by R.Beeman")
(* ;;; "Clear the horizontal tab stop at the given position")
(with CHAT.STATE Chat.State (* ; "Chat State")
(SETQ TERM.TAB.STOPS (DREMOVE Position TERM.TAB.STOPS])
(ANSI-Chat-Underline
[LAMBDA (Chat.State ANSI-State Line Column) (* ; "Edited 18-Sep-87 16:35 by R.Beeman")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(LET [(Width (COND
(DoubleWide (RSH FONTWIDTH -1))
(T FONTWIDTH)))
(Thickness (COND
((= LineAttribute 4)
2)
(T 1]
(BLTSHADE (COND
((EQ 'INPUT (DSPSOURCETYPE NIL DSP))
BLACKSHADE)
(T WHITESHADE))
DSP
(+ (ITIMES (SUB1 Column)
Width)
FONTWIDTH)
(- (+ (ITIMES (- BottomLine Line)
FONTHEIGHT)
(ITIMES FONTDESCENT Thickness))
Thickness)
Width Thickness 'REPLACE])
(ANSI-Chat-Unimplemented-Intermediate-Character
[LAMBDA (Chat.State ANSI-State CharacterCode) (* ; "Edited 23-Sep-87 18:24 by R.Beeman")
(* ;; "Hook for Debugging and Testing")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(COND
(Debug (PRINTOUT PROMPTWINDOW " |Unimplemented Intermediate Character "
CharacterCode " |"])
(ANSI-Chat-Unimplemented-Non-Numeric-Parameter
[LAMBDA (Chat.State ANSI-State CharacterCode) (* ; "Edited 23-Sep-87 18:25 by R.Beeman")
(* ;; "Hook for Debugging and Testing")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(COND
(Debug (PRINTOUT PROMPTWINDOW " |Unimplemented Non-Numeric Parameter "
CharacterCode " |"])
(ANSI-Chat-Unimplemented-Terminator
[LAMBDA (Chat.State ANSI-State CharacterCode) (* ; "Edited 23-Sep-87 18:30 by R.Beeman")
(* ;; "Hook for Debugging and Testing")
(with CHAT.STATE Chat.State (* ; "Chat State")
(with ANSI-STATE ANSI-State (* ; "ANSI State")
(COND
(Debug (PRINTOUT PROMPTWINDOW " |Unimplemented Terminator " CharacterCode " |"])
)
(RPAQQ ANSI-Chat-Icon-Bitmap #*(64 64)@@AOOOOOOOOOOH@@@@C@@@@@@@@@@L@@@@B@@@@@@@@@@D@@@@BCOOOOOOOOLD@@@@BD@@@@@@@@BD@@@@BD@@@@@@@@BD@@@@BD@@@@@@@@BD@@@@BD@@@@@@@@BD@@@@BD@@@@@@@@BD@@@@BD@@@@@@@@BD@@@@BD@@@@@@@@BD@@@@BD@@@@@@@@BD@@@@BD@@@@@@@@BD@@@@BD@@@@@@@@BD@@@@BD@@@@@@@@BD@@@@BD@@@@@@@@BD@@@@BD@@@@@@@@BD@@@@BD@@@@@@@@BD@@@@BD@@@@@@@@BD@@@@BD@@@@@@@@BD@@@@BD@@@@@@@@BD@@@@BD@@@@@@@@BD@@@@BD@@@@@@@@BD@@@@BD@@@@@@@@BD@@@@BD@@@@@@@@BD@@@@BCOOOOOOOOLGN@@@B@@@@@@@@@@DA@@@C@@@@@@@@@@L@H@@AOOOOOOOOOOH@D@@@@@@@@@@@@@@@D@@@@@@@@@@@@@@@D@AOOOOOOOOOOOOHD@B@@@@@@@@@@@@DD@DGOCOIOOCOLONBH@H@@@@@@@@@@@@A@A@JJJJJJJIEDEE@HBAEEEEEEE@JHBJHDDBJJJJJJJIEDAEDBH@@@@@@@@@@@@@@AOOOOOOOOOOOOOOOOH@@@@@@@@@@@@@@AOOOOOOOOOOOOOOOO@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@COOOOOOOOOOOOOOLF@@@@@@@@@@@@@@FL@@@@@@@@@@@@@@CH@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@AL@@@@@@@@@@@@@@CF@@@@@@@@@@@@@@FCOOOOOOOOOOOOOOL
)
(RPAQQ ANSI-Chat-Mask-Bitmap #*(64 64)@@AOOOOOOOOOOH@@@@COOOOOOOOOOL@@@@COOOOOOOOOOL@@@@COOOOOOOOOOL@@@@COOOOOOOOOOL@@@@COOOOOOOOOOL@@@@COOOOOOOOOOL@@@@COOOOOOOOOOL@@@@COOOOOOOOOOL@@@@COOOOOOOOOOL@@@@COOOOOOOOOOL@@@@COOOOOOOOOOL@@@@COOOOOOOOOOL@@@@COOOOOOOOOOL@@@@COOOOOOOOOOL@@@@COOOOOOOOOOL@@@@COOOOOOOOOOL@@@@COOOOOOOOOOL@@@@COOOOOOOOOOL@@@@COOOOOOOOOOL@@@@COOOOOOOOOOL@@@@COOOOOOOOOOL@@@@COOOOOOOOOOL@@@@COOOOOOOOOOL@@@@COOOOOOOOOOOO@@@COOOOOOOOOOOOH@@COOOOOOOOOOOOL@@COOOOOOOOOOLCN@@AOOOOOOOOOOHAN@@@@@@@@@@@@@@@N@@@@@@@@@@@@@@@N@AOOOOOOOOOOOOHN@COOOOOOOOOOOOMN@GOOOOOOOOOOOOON@OOOOOOOOOOOOOOLAOOOOOOOOOOOOOOHCOOOOOOOOOOOOOOLGOOOOOOOOOOOOOONOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@COOOOOOOOOOOOOOLGOOOOOOOOOOOOOONOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOGOOOOOOOOOOOOOONCOOOOOOOOOOOOOOL
)
(RPAQQ ANSI-Chat-Icon-Title-Region (4 2 56 14))
(RPAQ? ANSI-Chat-ReOpen-Menu NIL)
(RPAQ? ANSI-Chat-Icon-Template NIL)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS ANSI-Chat-ReOpen-Menu ANSI-Chat-Icon-Template ANSI-Chat-Icon-Bitmap ANSI-Chat-Mask-Bitmap
ANSI-Chat-Icon-Title-Region)
)
(ADDTOVAR CHAT.DRIVERTYPES (ANSI ANSI-Chat-Handle-Character ANSI-Chat-Initialize))
(/DECLAREDATATYPE 'ANSI-STATE
'(FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG
FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG
FLAG FLAG FLAG FLAG FLAG WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER)
'((ANSI-STATE 0 (FLAGBITS . 0))
(ANSI-STATE 0 (FLAGBITS . 16))
(ANSI-STATE 0 (FLAGBITS . 32))
(ANSI-STATE 0 (FLAGBITS . 48))
(ANSI-STATE 0 (FLAGBITS . 64))
(ANSI-STATE 0 (FLAGBITS . 80))
(ANSI-STATE 0 (FLAGBITS . 96))
(ANSI-STATE 0 (FLAGBITS . 112))
(ANSI-STATE 0 (FLAGBITS . 128))
(ANSI-STATE 0 (FLAGBITS . 144))
(ANSI-STATE 0 (FLAGBITS . 160))
(ANSI-STATE 0 (FLAGBITS . 176))
(ANSI-STATE 0 (FLAGBITS . 192))
(ANSI-STATE 0 (FLAGBITS . 208))
(ANSI-STATE 0 (FLAGBITS . 224))
(ANSI-STATE 0 (FLAGBITS . 240))
(ANSI-STATE 1 (FLAGBITS . 0))
(ANSI-STATE 1 (FLAGBITS . 16))
(ANSI-STATE 1 (FLAGBITS . 32))
(ANSI-STATE 1 (FLAGBITS . 48))
(ANSI-STATE 1 (FLAGBITS . 64))
(ANSI-STATE 1 (FLAGBITS . 80))
(ANSI-STATE 1 (FLAGBITS . 96))
(ANSI-STATE 1 (FLAGBITS . 112))
(ANSI-STATE 1 (FLAGBITS . 128))
(ANSI-STATE 1 (FLAGBITS . 144))
(ANSI-STATE 1 (FLAGBITS . 160))
(ANSI-STATE 1 (FLAGBITS . 176))
(ANSI-STATE 1 (FLAGBITS . 192))
(ANSI-STATE 1 (FLAGBITS . 208))
(ANSI-STATE 1 (FLAGBITS . 224))
(ANSI-STATE 1 (FLAGBITS . 240))
(ANSI-STATE 2 (FLAGBITS . 0))
(ANSI-STATE 2 (FLAGBITS . 16))
(ANSI-STATE 2 (FLAGBITS . 32))
(ANSI-STATE 2 (FLAGBITS . 48))
(ANSI-STATE 2 (FLAGBITS . 64))
(ANSI-STATE 2 (FLAGBITS . 80))
(ANSI-STATE 2 (FLAGBITS . 96))
(ANSI-STATE 2 (FLAGBITS . 112))
(ANSI-STATE 3 (BITS . 15))
(ANSI-STATE 4 (BITS . 15))
(ANSI-STATE 5 (BITS . 15))
(ANSI-STATE 6 (BITS . 15))
(ANSI-STATE 7 (BITS . 15))
(ANSI-STATE 8 (BITS . 15))
(ANSI-STATE 9 (BITS . 15))
(ANSI-STATE 10 (BITS . 15))
(ANSI-STATE 11 (BITS . 15))
(ANSI-STATE 12 (BITS . 15))
(ANSI-STATE 13 (BITS . 15))
(ANSI-STATE 14 (BITS . 15))
(ANSI-STATE 15 (BITS . 15))
(ANSI-STATE 16 (BITS . 15))
(ANSI-STATE 17 (BITS . 15))
(ANSI-STATE 18 (BITS . 15))
(ANSI-STATE 19 (BITS . 15))
(ANSI-STATE 20 (BITS . 15))
(ANSI-STATE 21 (BITS . 15))
(ANSI-STATE 22 (BITS . 15))
(ANSI-STATE 24 POINTER)
(ANSI-STATE 26 POINTER)
(ANSI-STATE 28 POINTER)
(ANSI-STATE 30 POINTER)
(ANSI-STATE 32 POINTER)
(ANSI-STATE 34 POINTER)
(ANSI-STATE 36 POINTER)
(ANSI-STATE 38 POINTER)
(ANSI-STATE 40 POINTER)
(ANSI-STATE 42 POINTER)
(ANSI-STATE 44 POINTER)
(ANSI-STATE 46 POINTER)
(ANSI-STATE 48 POINTER)
(ANSI-STATE 50 POINTER))
'52)
(FILESLOAD ANSICHATCOPY ANSICHATFONT ANSIKEYPAD)
(DECLARE%: EVAL@COMPILE DONTCOPY
(FILESLOAD (SOURCE)
ANSICHATDECLS CHATDECLS STREAMDECLS)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3223 129794 (ANSI-Chat-Address 3233 . 4255) (ANSI-Chat-Address-Absolute 4257 . 5694) (
ANSI-Chat-ButtonEventFn 5696 . 6438) (ANSI-Chat-Character-Attributes 6440 . 8023) (
ANSI-Chat-Clear-From-Menu 8025 . 8794) (ANSI-Chat-Close 8796 . 12699) (ANSI-Chat-CloseFn 12701 . 13012
) (ANSI-Chat-Control-Character 13014 . 16335) (ANSI-Chat-Control-Sequence 16337 . 28223) (
ANSI-Chat-Line-Attribute 28225 . 29102) (ANSI-Chat-CSI-Intermediate 29104 . 31037) (
ANSI-Chat-Cursor-Backward 31039 . 31695) (ANSI-Chat-Cursor-Down 31697 . 33165) (
ANSI-Chat-Cursor-Forward 33167 . 33944) (ANSI-Chat-Cursor-Up 33946 . 35163) (
ANSI-Chat-Deactivate-Window 35165 . 35777) (ANSI-Chat-Debug 35779 . 36291) (
ANSI-Chat-Device-Status-Report 36293 . 37675) (ANSI-Chat-Did-Reshape 37677 . 45700) (
ANSI-Chat-Display-Erase-Region 45702 . 46096) (ANSI-Chat-Display-Erase-to-End-of-Line 46098 . 47375) (
ANSI-Chat-Display-Scroll-Down 47377 . 51058) (ANSI-Chat-Display-Scroll-Up 51060 . 54702) (
ANSI-Chat-EMACS-Move 54704 . 57998) (ANSI-Chat-Erase-In-Display 58000 . 62552) (
ANSI-Chat-Erase-In-Line 62554 . 65029) (ANSI-Chat-Escape-Intermediate 65031 . 67913) (
ANSI-Chat-Escape-Sequence 67915 . 71829) (ANSI-Chat-Handle-Character 71831 . 73891) (
ANSI-Chat-Horizontal-Tab 73893 . 74478) (ANSI-Chat-Horizontal-Tabulation-Set 74480 . 74840) (
ANSI-Chat-IconFn 74842 . 75695) (ANSI-Chat-Identify-Terminal 75697 . 76074) (ANSI-Chat-Index 76076 .
77686) (ANSI-Chat-Initialize 77688 . 81084) (ANSI-Chat-Menu 81086 . 85707) (ANSI-Chat-Move-To 85709 .
86016) (ANSI-Chat-New-Line 86018 . 86522) (ANSI-Chat-NewRegionFn 86524 . 91240) (
ANSI-Chat-Print-Character 91242 . 93725) (ANSI-Chat-Print-From-Character-Set 93727 . 94515) (
ANSI-Chat-Reconnect 94517 . 96560) (ANSI-Chat-Redisplay-Line 96562 . 99408) (ANSI-Chat-RepaintFn 99410
. 100617) (ANSI-Chat-Reset-Mode 100619 . 101890) (ANSI-Chat-ReshapeFn 101892 . 104304) (
ANSI-Chat-Restore-Cursor 104306 . 106400) (ANSI-Chat-Reverse-Index 106402 . 107663) (
ANSI-Chat-Save-Cursor 107665 . 108943) (ANSI-Chat-Screen-Alignment-Display 108945 . 112239) (
ANSI-Chat-Screen-Parameters 112241 . 113974) (ANSI-Chat-Set-Character-Attributes 113976 . 116380) (
ANSI-Chat-Set-Character-Set 116382 . 122406) (ANSI-Chat-Set-Line-Attribute 122408 . 123367) (
ANSI-Chat-Set-Mode 123369 . 124630) (ANSI-Chat-Set-Top-and-Bottom-Margins 124632 . 125847) (
ANSI-Chat-Switch-EMACS 125849 . 126471) (ANSI-Chat-Tabulation-Clear 126473 . 126836) (
ANSI-Chat-Underline 126838 . 128130) (ANSI-Chat-Unimplemented-Intermediate-Character 128132 . 128704)
(ANSI-Chat-Unimplemented-Non-Numeric-Parameter 128706 . 129276) (ANSI-Chat-Unimplemented-Terminator
129278 . 129792)))))
STOP