(FILECREATED " 4-Sep-85 18:53:06" {ERIS}<LISPCORE>LIBRARY>CHATTERMINAL.;5 16749
changes to: (VARS CHATTERMINALCOMS)
previous date: "26-Aug-85 12:28:26" {ERIS}<LISPCORE>LIBRARY>CHATTERMINAL.;4)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT CHATTERMINALCOMS)
(RPAQQ CHATTERMINALCOMS ((FNS TERM.ADDCHAR TERM.ADDLINE TERM.CLEAR.TAB TERM.DELCHAR TERM.DELETELINE
TERM.DOWN TERM.ERASE.IN.DISPLAY TERM.ERASE.IN.LINE TERM.ERASE.TO.EOL
TERM.ERASEBITS TERM.GODOWN TERM.HOME TERM.IDENTIFY.SELF TERM.LEFT
TERM.MODIFY.ATTRIBUTES TERM.MOVETO TERM.NEWLINE TERM.PRINTCHAR
TERM.RESET.DISPLAY.PARMS TERM.RIGHT TERM.SCROLLDOWN TERM.SET.TAB
TERM.SETMARGINS TERM.SMOOTHSCROLL TERM.SPECVARS TERM.TAB TERM.UNDERLINE
TERM.UP)
(INITVARS (TERM.SPECVARS))
[VARS (TERM.FONT (QUOTE (GACHA 10 MRR)))
(TERM.NORMAL.FONT (FONTCREATE TERM.FONT))
(TERM.BOLD.FONT (FONTCOPY TERM.NORMAL.FONT (QUOTE FACE)
(QUOTE BOLD]
(DECLARE: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
CHATDECLS))))
(DEFINEQ
(TERM.ADDCHAR
(LAMBDA (CHAT.STATE) (* ejs: "12-May-85 14:43")
(* Insert a space at cursor position, pushing rest of
line to right)
(with CHAT.STATE CHAT.STATE (PROG ((Y (IDIFFERENCE YPOS FONTDESCENT)))
(BITBLT DSP XPOS Y DSP (IPLUS XPOS FONTWIDTH)
Y
(IPLUS (IDIFFERENCE TTYWIDTH XPOS)
FONTWIDTH)
FONTHEIGHT
(QUOTE INPUT)
(QUOTE REPLACE))
(* Blt remainder of line to the right by FONTWIDTH,
then erase the character under the cursor)
(TERM.ERASEBITS CHAT.STATE XPOS Y FONTWIDTH FONTHEIGHT)))))
(TERM.ADDLINE
(LAMBDA (CHAT.STATE ATYPOS) (* ejs: "12-May-85 14:44")
(with CHAT.STATE CHAT.STATE (OR ATYPOS (SETQ ATYPOS YPOS))
(* To insert line at ATYPOS, we blt everything below it
down one, then clear the line at ATYPOS)
(BITBLT DSP 0 FONTHEIGHT DSP 0 0 TTYWIDTH (IDIFFERENCE ATYPOS FONTDESCENT)
(QUOTE INPUT)
(QUOTE REPLACE))
(TERM.ERASEBITS CHAT.STATE 0 (IDIFFERENCE ATYPOS FONTDESCENT)
TTYWIDTH FONTHEIGHT))))
(TERM.CLEAR.TAB
(LAMBDA (CHAT.STATE TERMINAL.X) (* ejs: "12-May-85 14:45")
(* * Clear a tab stop)
(with CHAT.STATE CHAT.STATE (SETQ TERM.TAB.STOPS (DREMOVE TERMINAL.X TERM.TAB.STOPS)))))
(TERM.DELCHAR
(LAMBDA (CHAT.STATE) (* ejs: "12-May-85 14:46")
(* Delete character under cursor, moving rest of line
to left)
(with CHAT.STATE CHAT.STATE (LET ((Y (IDIFFERENCE YPOS FONTDESCENT)))
(BITBLT DSP (IPLUS XPOS FONTWIDTH)
Y DSP XPOS Y (IPLUS (IDIFFERENCE TTYWIDTH XPOS)
FONTWIDTH)
FONTHEIGHT
(QUOTE INPUT)
(QUOTE REPLACE)) (* Blt remainder of line to the left by FONTWIDTH, then
erase the rightmost character position)
(TERM.ERASEBITS CHAT.STATE (IDIFFERENCE TTYWIDTH FONTWIDTH)
Y FONTWIDTH FONTHEIGHT)))))
(TERM.DELETELINE
(LAMBDA (CHAT.STATE ATYPOS) (* ejs: "12-May-85 19:08")
(with CHAT.STATE CHAT.STATE (OR ATYPOS (SETQ ATYPOS YPOS))
(* To delete line at ATYPOS, we blt everything below it
up one, then clear the bottom line)
(BITBLT DSP 0 BOTTOMMARGIN DSP 0 (IPLUS FONTHEIGHT BOTTOMMARGIN)
TTYWIDTH
(IDIFFERENCE (IDIFFERENCE ATYPOS FONTDESCENT)
BOTTOMMARGIN)
(QUOTE INPUT)
(QUOTE REPLACE))
(TERM.ERASEBITS CHAT.STATE 0 BOTTOMMARGIN TTYWIDTH FONTHEIGHT))))
(TERM.DOWN
(LAMBDA (CHAT.STATE NLINES) (* ejs: "12-May-85 19:06")
(* * Move down NLINES (default = 1), pegging at bottom if NLINES not 1, else wrap or roll)
(with CHAT.STATE CHAT.STATE (COND
((IGREATERP YPOS (IPLUS BOTTOMMARGIN FONTDESCENT))
(MOVETO XPOS (SETQ YPOS (IMAX (IPLUS BOTTOMMARGIN FONTDESCENT)
(IDIFFERENCE YPOS (ITIMES FONTHEIGHT (OR NLINES 1)))))
DSP))
((NULL ROLLMODE) (* Wraparound to top)
(MOVETO XPOS (SETQ YPOS HOMEPOS)
DSP))
(T (* On bottom line in rollmode, scroll screen up one)
(TERM.DELETELINE CHAT.STATE HOMEPOS))))))
(TERM.ERASE.IN.DISPLAY
(LAMBDA (CHAT.STATE PARAM) (* ejs: "12-May-85 14:48")
(* Do erasing functions)
(with CHAT.STATE CHAT.STATE (SELECTQ PARAM
(0 (* Erase to end of screen)
(TERM.ERASE.TO.EOL CHAT.STATE)
(TERM.ERASEBITS CHAT.STATE 0 0 TTYWIDTH (IDIFFERENCE
YPOS FONTDESCENT)))
(1 (* Erase from HOME to current position)
(TERM.ERASEBITS CHAT.STATE 0 (IPLUS YPOS FONTHEIGHT)
TTYWIDTH
(IDIFFERENCE HOMEPOS (IPLUS YPOS
FONTHEIGHT)))
(TERM.ERASEBITS CHAT.STATE 0 (IDIFFERENCE YPOS
FONTDESCENT)
XPOS FONTHEIGHT))
(2 (* Erase screen)
(CLEARW WINDOW)
(MOVETO XPOS YPOS DSP))
NIL))))
(TERM.ERASE.IN.LINE
(LAMBDA (CHAT.STATE PARAM) (* ejs: "12-May-85 14:48")
(* Do line-oriented erasing)
(with CHAT.STATE CHAT.STATE (SELECTQ PARAM
(0 (* Erase to end-of-line)
(TERM.ERASE.TO.EOL CHAT.STATE))
(1 (* Erase from beginning of line to current pos)
(TERM.ERASEBITS CHAT.STATE 0 (IDIFFERENCE YPOS
FONTDESCENT)
XPOS FONTHEIGHT))
(2 (* Erase entire line)
(TERM.ERASEBITS CHAT.STATE 0 (IDIFFERENCE YPOS
FONTDESCENT)
TTYWIDTH FONTHEIGHT))
NIL))))
(TERM.ERASE.TO.EOL
(LAMBDA (CHAT.STATE) (* ejs: "12-May-85 16:18")
(with CHAT.STATE CHAT.STATE (TERM.ERASEBITS CHAT.STATE XPOS (IDIFFERENCE YPOS FONTDESCENT)
(IDIFFERENCE TTYWIDTH XPOS)
FONTHEIGHT))))
(TERM.ERASEBITS
(LAMBDA (CHAT.STATE LEFT BOTTOM WIDTH HEIGHT) (* ejs: "12-May-85 16:17")
(with CHAT.STATE CHAT.STATE (BITBLT NIL NIL NIL DSP LEFT BOTTOM WIDTH HEIGHT (QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE))))
(TERM.GODOWN
(LAMBDA (CHAT.STATE NLINES) (* ejs: "12-May-85 14:49")
(* * Move down NLINES, pegging at the bottom of the window)
(with CHAT.STATE CHAT.STATE (COND
((IGREATERP YPOS (IPLUS BOTTOMMARGIN FONTDESCENT))
(MOVETO XPOS (SETQ YPOS (IMAX (IPLUS BOTTOMMARGIN FONTDESCENT)
(SETQ YPOS (IDIFFERENCE YPOS (ITIMES FONTHEIGHT
(OR NLINES 1))))))
DSP))))))
(TERM.HOME
(LAMBDA (CHAT.STATE) (* ejs: "12-May-85 16:59")
(with CHAT.STATE CHAT.STATE (MOVETO (SETQ XPOS 0)
(SETQ YPOS HOMEPOS)
DSP))))
(TERM.IDENTIFY.SELF
(LAMBDA (CHAT.STATE) (* ejs: "12-May-85 20:22")
(* * Identify self to the host operating system)
(with CHAT.STATE CHAT.STATE (PRIN1 TERM.IDENTITY.STRING OUTSTREAM)
(FORCEOUTPUT OUTSTREAM))))
(TERM.LEFT
(LAMBDA (CHAT.STATE NCHARS) (* ejs: "12-May-85 14:50")
(* * Move the cursor NCHARS (default = 1), pegging at the left margin)
(with CHAT.STATE CHAT.STATE (COND
((IGREATERP XPOS 0)
(MOVETO (SETQ XPOS (IMAX 0 (IDIFFERENCE XPOS (ITIMES FONTWIDTH (OR NCHARS 1)))))
YPOS DSP))))))
(TERM.MODIFY.ATTRIBUTES
(LAMBDA (CHAT.STATE ATTRIBUTES INVERTFLG) (* ejs: "12-May-85 14:53")
(* * Function to do character attribute setting. Attributes is a list of attribute modifying commands)
(with CHAT.STATE CHAT.STATE (for A inside ATTRIBUTES
do (SELECTQ A
(NORMAL (DSPFONT TERM.NORMAL.FONT DSP)
(DSPSOURCETYPE (QUOTE INPUT)
DSP)
(SETQ UNDERLINEMODE NIL))
(BRIGHT (* Implement "BRIGHT" by using a bold font)
(COND
(INVERTFLG (DSPFONT TERM.NORMAL.FONT DSP))
(T (DSPFONT (OR TERM.BOLD.FONT
(SETQ TERM.BOLD.FONT
(FONTCOPY TERM.NORMAL.FONT
(QUOTE WEIGHT)
(QUOTE BOLD))))
DSP))))
((BLINK UNDERLINE)
(* Implement "BLINK" with underline, for now.
Blinking characters are probably a bit too expensive)
(SETQ UNDERLINEMODE (NOT INVERTFLG)))
(INVERSE (COND
(INVERTFLG (DSPSOURCETYPE (QUOTE INPUT)
DSP))
(T (DSPSOURCETYPE (QUOTE INVERT)
DSP))))
NIL)))))
(TERM.MOVETO
(LAMBDA (CHAT.STATE CX CY) (* ejs: "12-May-85 14:53")
(* * Set our cursor position)
(with CHAT.STATE CHAT.STATE (MOVETO (SETQ XPOS (IMIN (ITIMES CX FONTWIDTH)
(IDIFFERENCE TTYWIDTH FONTWIDTH)))
(SETQ YPOS (IMAX FONTDESCENT (IDIFFERENCE HOMEPOS
(ITIMES CY
FONTHEIGHT))))
DSP))))
(TERM.NEWLINE
(LAMBDA (CHAT.STATE) (* ejs: "12-May-85 14:54")
(* Do a CRLF.)
(with CHAT.STATE CHAT.STATE (TERM.DOWN CHAT.STATE)
(MOVETO (SETQ XPOS 0)
YPOS DSP))))
(TERM.PRINTCHAR
(LAMBDA (CHAT.STATE CHAR WRAPFLG) (* ejs: "12-May-85 15:01")
(* * Print a character. If WRAPFLG 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 (\OUTCHAR DSP CHAR)
(COND
((IGEQ (SETQ XPOS (PLUS XPOS FONTWIDTH))
TTYWIDTH) (* Have reached right margin, so wrap around)
(COND
(WRAPFLG (TERM.NEWLINE CHAT.STATE))
(T (MOVETO (SETQ XPOS (PLUS XPOS (IMINUS FONTWIDTH)))
YPOS DSP))))))))
(TERM.RESET.DISPLAY.PARMS
(LAMBDA (CHAT.STATE) (* ejs: "12-May-85 19:13")
(* Reset state)
(with CHAT.STATE CHAT.STATE (SETQ FONTHEIGHT (IMINUS (DSPLINEFEED NIL DSP)))
(SETQ FONTWIDTH (CHARWIDTH (CHARCODE A)
(SETQ PLAINFONT (SETQ FONT (DSPFONT NIL DSP)))))
(SETQ FONTDESCENT (FONTPROP FONT (QUOTE DESCENT)))
(SETQ TTYWIDTH (WINDOWPROP WINDOW (QUOTE WIDTH)))
(SETQ TTYWIDTH (ITIMES (IQUOTIENT TTYWIDTH FONTWIDTH)
FONTWIDTH)) (* Make TTYWIDTH multiple of FONTWIDTH)
(SETQ TOPMARGIN (SETQ TTYHEIGHT (WINDOWPROP WINDOW (QUOTE HEIGHT))))
(SETQ HOMEPOS (IPLUS (ITIMES (SUB1 (IQUOTIENT TTYHEIGHT FONTHEIGHT))
FONTHEIGHT)
FONTDESCENT)))))
(TERM.RIGHT
(LAMBDA (CHAT.STATE NCHARS) (* ejs: "12-May-85 15:33")
(* * Move the cursor NCHARS to the right, pegging at the right margin)
(with CHAT.STATE CHAT.STATE (COND
((ILESSP (IPLUS XPOS FONTWIDTH)
TTYWIDTH)
(SETQ XPOS (IMIN TTYWIDTH (IPLUS XPOS (ITIMES FONTWIDTH (OR NCHARS 1)))))
(MOVETO XPOS YPOS DSP))))))
(TERM.SCROLLDOWN
(LAMBDA (CHAT.STATE TOP) (* ejs: "12-May-85 14:56")
(* * Scroll down a line, from the line at TOP)
(with CHAT.STATE CHAT.STATE (BITBLT DSP 0 (IPLUS BOTTOMMARGIN FONTHEIGHT)
DSP 0 BOTTOMMARGIN TTYWIDTH (IDIFFERENCE TOP
(IPLUS BOTTOMMARGIN
FONTHEIGHT))
(QUOTE INPUT)
(QUOTE REPLACE))
(TERM.ERASEBITS CHAT.STATE 0 (IDIFFERENCE (IDIFFERENCE TOP FONTHEIGHT)
FONTDESCENT)
TTYWIDTH FONTHEIGHT))))
(TERM.SET.TAB
(LAMBDA (CHAT.STATE TERMINAL.X) (* ejs: "26-Aug-85 12:28")
(* * Set a new tab stop for the terminal)
(with CHAT.STATE CHAT.STATE (COND
((NULL TERM.TAB.STOPS)
(SETQ TERM.TAB.STOPS (LIST TERMINAL.X)))
(T (push TERM.TAB.STOPS TERMINAL.X)
(SORT TERM.TAB.STOPS)))
TERM.TAB.STOPS)))
(TERM.SETMARGINS
(LAMBDA (CHAT.STATE TOP BOTTOM) (* ejs: "12-May-85 14:58")
(* * Function to set top and bottom margins)
(with CHAT.STATE CHAT.STATE (SETQ TOPMARGIN (IDIFFERENCE HOMEPOS (ITIMES (IDIFFERENCE TOP 2)
FONTHEIGHT)))
(SETQ BOTTOMMARGIN (IDIFFERENCE (IDIFFERENCE HOMEPOS (ITIMES (SUB1 BOTTOM)
FONTHEIGHT))
FONTDESCENT)))))
(TERM.SMOOTHSCROLL
(LAMBDA (CHAT.STATE) (* ejs: "12-May-85 14:58")
(* * For those of you who can stand smooth scrolling, this will scroll in the normal direction, one
(pixel) line at a time)
(with CHAT.STATE CHAT.STATE (for I from 1 to FONTHEIGHT
do (BITBLT DSP 0 0 DSP 0 1 TTYWIDTH TTYHEIGHT (QUOTE INPUT)
(QUOTE REPLACE)))
(TERM.ERASEBITS CHAT.STATE 0 0 TTYWIDTH FONTHEIGHT))))
(TERM.SPECVARS
(LAMBDA (DISPLAYNAME) (* ejs: "15-Nov-84 18:15")
(* * Return a list of variables we'd like bound at the top level of the typeout process.)
(for X in (CDR (FASSOC DISPLAYNAME TERM.SPECVARS)) collect (COND
((NLISTP X)
(CONS X))
(T (CONS (CAR X)
(EVAL (CADR X))))))))
(TERM.TAB
(LAMBDA (CHAT.STATE) (* ejs: "12-May-85 14:59")
(with CHAT.STATE CHAT.STATE (LET ((CURSORX (IQUOTIENT XPOS FONTWIDTH))
NEXT.STOP)
(COND
((SETQ NEXT.STOP (for CX in TERM.TAB.STOPS thereis (IGREATERP CX CURSORX)))
(MOVETO (SETQ XPOS (ITIMES NEXT.STOP FONTWIDTH))
YPOS DSP)))))))
(TERM.UNDERLINE
(LAMBDA (CHAT.STATE CHAR) (* ejs: "12-May-85 14:59")
(with CHAT.STATE CHAT.STATE (BITBLT DSP XPOS (IDIFFERENCE YPOS 2)
DSP XPOS (SUB1 YPOS)
(CHARWIDTH CHAR FONT)
1
(QUOTE INVERT)
(QUOTE REPLACE)))))
(TERM.UP
(LAMBDA (CHAT.STATE NLINES) (* ejs: "12-May-85 14:59")
(* * Go up NLINES (default = 1), pegging at top)
(with CHAT.STATE CHAT.STATE (COND
((ILESSP YPOS HOMEPOS)
(MOVETO XPOS (SETQ YPOS (IMIN HOMEPOS (IPLUS YPOS (ITIMES FONTHEIGHT (OR NLINES 1)))))
DSP))))))
)
(RPAQ? TERM.SPECVARS )
(RPAQQ TERM.FONT (GACHA 10 MRR))
(RPAQ TERM.NORMAL.FONT (FONTCREATE TERM.FONT))
(RPAQ TERM.BOLD.FONT (FONTCOPY TERM.NORMAL.FONT (QUOTE FACE)
(QUOTE BOLD)))
(DECLARE: EVAL@COMPILE DONTCOPY
(FILESLOAD (SOURCE)
CHATDECLS)
)
(PUTPROPS CHATTERMINAL COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1109 16382 (TERM.ADDCHAR 1119 . 1953) (TERM.ADDLINE 1955 . 2552) (TERM.CLEAR.TAB 2554
. 2810) (TERM.DELCHAR 2812 . 3590) (TERM.DELETELINE 3592 . 4243) (TERM.DOWN 4245 . 5056) (
TERM.ERASE.IN.DISPLAY 5058 . 6019) (TERM.ERASE.IN.LINE 6021 . 6779) (TERM.ERASE.TO.EOL 6781 . 7061) (
TERM.ERASEBITS 7063 . 7328) (TERM.GODOWN 7330 . 7832) (TERM.HOME 7834 . 8048) (TERM.IDENTIFY.SELF 8050
. 8344) (TERM.LEFT 8346 . 8750) (TERM.MODIFY.ATTRIBUTES 8752 . 10088) (TERM.MOVETO 10090 . 10531) (
TERM.NEWLINE 10533 . 10835) (TERM.PRINTCHAR 10837 . 11489) (TERM.RESET.DISPLAY.PARMS 11491 . 12422) (
TERM.RIGHT 12424 . 12867) (TERM.SCROLLDOWN 12869 . 13442) (TERM.SET.TAB 13444 . 13848) (
TERM.SETMARGINS 13850 . 14319) (TERM.SMOOTHSCROLL 14321 . 14834) (TERM.SPECVARS 14836 . 15271) (
TERM.TAB 15273 . 15678) (TERM.UNDERLINE 15680 . 15994) (TERM.UP 15996 . 16380)))))
STOP