(FILECREATED "18-Mar-86 16:44:00" {ERIS}<LISPCORE>LIBRARY>CHATTERMINAL.;8 18553
changes to: (FNS TERM.PRINTCHAR TERM.MODIFY.ATTRIBUTES)
previous date: "18-Nov-85 17:12:42" {ERIS}<LISPCORE>LIBRARY>CHATTERMINAL.;7)
(* Copyright (c) 1984, 1985, 1986 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 (IDIFFERENCE TOPMARGIN FONTHEIGHT])
(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:
"18-Mar-86 16:40")
(* * 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 (FONTCOPY (DSPFONT NIL DSP)
(QUOTE WEIGHT)
(QUOTE MEDIUM))
DSP)
(DSPSOURCETYPE (QUOTE INPUT)
DSP)
(SETQ UNDERLINEMODE NIL))
(BRIGHT (* Implement "BRIGHT"
by using a bold font)
(COND
(INVERTFLG (DSPFONT (FONTCOPY (DSPFONT NIL DSP)
(QUOTE WEIGHT)
(QUOTE MEDIUM))
DSP))
(T (DSPFONT (FONTCOPY (DSPFONT NIL DSP)
(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:
"18-Mar-86 10:28")
(* * 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)
(AND UNDERLINEMODE (TERM.UNDERLINE CHAT.STATE 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 (ADD1 (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 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1244 18156 (TERM.ADDCHAR 1254 . 2088) (TERM.ADDLINE 2090 . 2687) (TERM.CLEAR.TAB 2689
. 2945) (TERM.DELCHAR 2947 . 3725) (TERM.DELETELINE 3727 . 4378) (TERM.DOWN 4380 . 5205) (
TERM.ERASE.IN.DISPLAY 5207 . 6168) (TERM.ERASE.IN.LINE 6170 . 6928) (TERM.ERASE.TO.EOL 6930 . 7210) (
TERM.ERASEBITS 7212 . 7477) (TERM.GODOWN 7479 . 7981) (TERM.HOME 7983 . 8197) (TERM.IDENTIFY.SELF 8199
. 8493) (TERM.LEFT 8495 . 8899) (TERM.MODIFY.ATTRIBUTES 8901 . 11508) (TERM.MOVETO 11510 . 11951) (
TERM.NEWLINE 11953 . 12255) (TERM.PRINTCHAR 12257 . 13225) (TERM.RESET.DISPLAY.PARMS 13227 . 14158) (
TERM.RIGHT 14160 . 14603) (TERM.SCROLLDOWN 14605 . 15178) (TERM.SET.TAB 15180 . 15584) (
TERM.SETMARGINS 15586 . 16055) (TERM.SMOOTHSCROLL 16057 . 16570) (TERM.SPECVARS 16572 . 17007) (
TERM.TAB 17009 . 17452) (TERM.UNDERLINE 17454 . 17768) (TERM.UP 17770 . 18154)))))
STOP