(FILECREATED "29-Dec-84 15:13:33" {ERIS}<LISPCORE>SOURCES>CHATTERMINAL.;1 15279
previous date: "15-Nov-84 18:24:29" {ERIS}<SCHOEN>CHATTERMINAL.;5)
(* Copyright (c) 1984 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))))))
(DEFINEQ
(TERM.ADDCHAR
[LAMBDA NIL (* ejs: "30-Oct-84 15:19")
(* Insert a space at cursor position, pushing rest of
line to right)
(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 XPOS Y FONTWIDTH FONTHEIGHT])
(TERM.ADDLINE
[LAMBDA (ATYPOS) (* ejs: "30-Oct-84 15:20")
(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 0 (IDIFFERENCE ATYPOS FONTDESCENT)
TTYWIDTH FONTHEIGHT])
(TERM.CLEAR.TAB
[LAMBDA (TERMINAL.X) (* ejs: "30-Oct-84 16:02")
(* * Clear a tab stop)
(SETQ TERM.TAB.STOPS (DREMOVE TERMINAL.X TERM.TAB.STOPS])
(TERM.DELCHAR
[LAMBDA NIL (* ejs: "30-Oct-84 15:20")
(* Delete character under cursor, moving rest of line
to left)
(PROG ((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 (IDIFFERENCE TTYWIDTH FONTWIDTH)
Y FONTWIDTH FONTHEIGHT])
(TERM.DELETELINE
[LAMBDA (ATYPOS) (* ejs: "30-Oct-84 15:20")
(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 0 DSP 0 FONTHEIGHT TTYWIDTH (IDIFFERENCE ATYPOS FONTDESCENT)
(QUOTE INPUT)
(QUOTE REPLACE))
(TERM.ERASEBITS 0 0 TTYWIDTH FONTHEIGHT])
(TERM.DOWN
(LAMBDA (NLINES) (* ejs: "15-Nov-84 17:05")
(* * Move down NLINES (default = 1), pegging at bottom if NLINES not 1, else wrap or roll)
(COND
((IGREATERP YPOS FONTDESCENT)
(MOVETO XPOS (SETQ YPOS (IMAX FONTDESCENT (IDIFFERENCE YPOS (ITIMES FONTHEIGHT
(OR NLINES (SETQ 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 HOMEPOS)))))
(TERM.ERASE.IN.DISPLAY
[LAMBDA (PARAM) (* ejs: "30-Oct-84 15:42")
(* Do erasing functions)
(SELECTQ PARAM
(0 (* Erase to end of screen)
(TERM.ERASE.TO.EOL)
(TERM.ERASEBITS 0 0 TTYWIDTH (IDIFFERENCE YPOS FONTDESCENT)))
(1 (* Erase from HOME to current position)
(TERM.ERASEBITS 0 (IPLUS YPOS FONTHEIGHT)
TTYWIDTH
(IDIFFERENCE HOMEPOS (IPLUS YPOS FONTHEIGHT)))
(TERM.ERASEBITS 0 (IDIFFERENCE YPOS FONTDESCENT)
XPOS FONTHEIGHT))
(2 (* Erase screen)
(CLEARW WINDOW)
(MOVETO XPOS YPOS DSP))
NIL])
(TERM.ERASE.IN.LINE
[LAMBDA (PARAM) (* ejs: "30-Oct-84 15:44")
(* Do line-oriented erasing)
(SELECTQ PARAM
(0 (* Erase to end-of-line)
(TERM.ERASE.TO.EOL))
(1 (* Erase from beginning of line to current pos)
(TERM.ERASEBITS 0 (IDIFFERENCE YPOS FONTDESCENT)
XPOS FONTHEIGHT))
(2 (* Erase entire line)
(TERM.ERASEBITS 0 (IDIFFERENCE YPOS FONTDESCENT)
TTYWIDTH FONTHEIGHT))
NIL])
(TERM.ERASE.TO.EOL
[LAMBDA NIL (* ejs: "30-Oct-84 15:03")
(TERM.ERASEBITS XPOS (IDIFFERENCE YPOS FONTDESCENT)
(IDIFFERENCE TTYWIDTH XPOS)
FONTHEIGHT])
(TERM.ERASEBITS
[LAMBDA (LEFT BOTTOM WIDTH HEIGHT) (* bvm: "28-APR-82 18:13")
(BITBLT NIL NIL NIL DSP LEFT BOTTOM WIDTH HEIGHT (QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE])
(TERM.GODOWN
(LAMBDA (NLINES) (* ejs: "15-Nov-84 17:05")
(* * Move down NLINES, pegging at the bottom of the window)
(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 NIL (* bvm: "28-APR-82 16:42")
(MOVETO (SETQ XPOS 0)
(SETQ YPOS HOMEPOS)
DSP])
(TERM.IDENTIFY.SELF
[LAMBDA (SOCKET) (* ejs: "30-Oct-84 15:45")
(* * Identify self to the host operating system)
(SOUT SOCKET TERM.IDENTITY.STRING])
(TERM.LEFT
(LAMBDA (NCHARS) (* ejs: "15-Nov-84 17:48")
(* * Move the cursor NCHARS (default = 1), pegging at the left margin)
(COND
((IGREATERP XPOS 0)
(MOVETO (SETQ XPOS (IMAX 0 (IDIFFERENCE XPOS (ITIMES FONTWIDTH (OR NCHARS 1)))))
YPOS DSP)))))
(TERM.MODIFY.ATTRIBUTES
(LAMBDA (ATTRIBUTES INVERTFLG) (* ejs: "13-Nov-84 17:05")
(* * Function to do character attribute setting. Attributes is a list of attribute modifying commands)
(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 (CX CY) (* ejs: "30-Oct-84 16:32")
(* * Set our cursor position)
(MOVETO (SETQ XPOS (IMIN (ITIMES CX FONTWIDTH)
(IDIFFERENCE TTYWIDTH FONTWIDTH)))
[SETQ YPOS (IMAX FONTDESCENT (IDIFFERENCE HOMEPOS (ITIMES CY FONTHEIGHT]
DSP])
(TERM.NEWLINE
[LAMBDA NIL (* ejs: "30-Oct-84 15:14")
(* Do a CRLF.)
(TERM.DOWN)
(MOVETO (SETQ XPOS 0)
YPOS DSP])
(TERM.PRINTCHAR
[LAMBDA (CHAR WRAPFLG) (* ejs: "30-Oct-84 15:22")
(* * 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)
(\OUTCHAR DSP CHAR)
(COND
((IGEQ (add XPOS FONTWIDTH)
TTYWIDTH) (* Have reached right margin, so wrap around)
(COND
(WRAPFLG (TERM.NEWLINE))
(T (MOVETO (add XPOS (IMINUS FONTWIDTH))
YPOS DSP])
(TERM.RESET.DISPLAY.PARMS
[LAMBDA NIL
(DECLARE (USEDFREE (DSP WINDOW COM FONTHEIGHT FONTWIDTH PLAINFONT FONT FONTDESCENT TTYWIDTH
TTYHEIGHT HOMEPOS))) (* bvm: " 2-Jun-84 15:31")
(* Reset 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 TTYHEIGHT (WINDOWPROP WINDOW (QUOTE HEIGHT)))
(SETQ HOMEPOS (IPLUS (ITIMES (SUB1 (IQUOTIENT TTYHEIGHT FONTHEIGHT))
FONTHEIGHT)
FONTDESCENT])
(TERM.RIGHT
(LAMBDA (NCHARS) (* ejs: "15-Nov-84 17:08")
(* * Move the cursor NCHARS to the right, pegging at the right margin)
(COND
((ILESSP (IPLUS XPOS FONTWIDTH)
TTYWIDTH)
(SETQ XPOS (IMIN TTYWIDTH (IPLUS XPOS (ITIMES FONTWIDTH (OR NLINES 1)))))
(MOVETO XPOS YPOS DSP)))))
(TERM.SCROLLDOWN
[LAMBDA (TOP) (* ejs: "30-Oct-84 15:25")
(* * Scroll down a line, from the line at TOP)
(BITBLT DSP 0 (IPLUS BOTTOMMARGIN FONTHEIGHT)
DSP 0 BOTTOMMARGIN TTYWIDTH (IDIFFERENCE TOP (IPLUS BOTTOMMARGIN FONTHEIGHT))
(QUOTE INPUT)
(QUOTE REPLACE))
(TERM.ERASEBITS 0 (IDIFFERENCE (IDIFFERENCE TOP FONTHEIGHT)
FONTDESCENT)
TTYWIDTH FONTHEIGHT])
(TERM.SET.TAB
[LAMBDA (TERMINAL.X) (* ejs: "30-Oct-84 15:53")
(* * Set a new tab stop for the terminal)
[COND
((NULL TERM.TAB.STOPS)
(SETQ TERM.TAB.STOPS (LIST TERMINAL.X)))
(T (for X on TERM.TAB.STOPS until (OR (NULL (CDR X))
(ILEQ TERMINAL.X (CADR X)))
finally (COND
[(CDR X)
(COND
((NEQ (CADR X)
TERMINAL.X)
(push (CDR X)
TERMINAL.X]
(T (NCONC1 TERM.TAB.STOPS TERMINAL.X]
TERM.TAB.STOPS])
(TERM.SETMARGINS
[LAMBDA (TOP BOTTOM) (* ejs: " 8-NOV-82 08:16")
(* * Function to set top and bottom margins)
(SETQ TOPMARGIN (IDIFFERENCE HOMEPOS (ITIMES (IDIFFERENCE TOP 2)
FONTHEIGHT)))
(SETQ BOTTOMMARGIN (IDIFFERENCE (IDIFFERENCE HOMEPOS (ITIMES (SUB1 BOTTOM)
FONTHEIGHT))
FONTDESCENT])
(TERM.SMOOTHSCROLL
[LAMBDA NIL (* ejs: "30-Oct-84 15:26")
(* * For those of you who can stand smooth scrolling, this will scroll in the normal direction, one
(pixel) line at a time)
(for I from 1 to FONTHEIGHT do (BITBLT DSP 0 0 DSP 0 1 TTYWIDTH TTYHEIGHT (QUOTE INPUT)
(QUOTE REPLACE)))
(TERM.ERASEBITS 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 NIL (* ejs: "30-Oct-84 15:48")
(PROG ((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 (CHAR) (* ejs: " 8-NOV-82 09:33")
(BITBLT DSP XPOS (IDIFFERENCE YPOS 2)
DSP XPOS (SUB1 YPOS)
(CHARWIDTH CHAR FONT)
1
(QUOTE INVERT)
(QUOTE REPLACE])
(TERM.UP
(LAMBDA (NLINES) (* ejs: "15-Nov-84 17:03")
(* * Go up NLINES (default = 1), pegging at top)
(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)))
(PUTPROPS CHATTERMINAL COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (979 14987 (TERM.ADDCHAR 989 . 1700) (TERM.ADDLINE 1702 . 2224) (TERM.CLEAR.TAB 2226 .
2447) (TERM.DELCHAR 2449 . 3193) (TERM.DELETELINE 3195 . 3674) (TERM.DOWN 3676 . 4411) (
TERM.ERASE.IN.DISPLAY 4413 . 5269) (TERM.ERASE.IN.LINE 5271 . 5977) (TERM.ERASE.TO.EOL 5979 . 6214) (
TERM.ERASEBITS 6216 . 6447) (TERM.GODOWN 6449 . 6909) (TERM.HOME 6911 . 7091) (TERM.IDENTIFY.SELF 7093
. 7314) (TERM.LEFT 7316 . 7680) (TERM.MODIFY.ATTRIBUTES 7682 . 8942) (TERM.MOVETO 8944 . 9318) (
TERM.NEWLINE 9320 . 9579) (TERM.PRINTCHAR 9581 . 10156) (TERM.RESET.DISPLAY.PARMS 10158 . 11129) (
TERM.RIGHT 11131 . 11535) (TERM.SCROLLDOWN 11537 . 12035) (TERM.SET.TAB 12037 . 12653) (
TERM.SETMARGINS 12655 . 13078) (TERM.SMOOTHSCROLL 13080 . 13539) (TERM.SPECVARS 13541 . 13976) (
TERM.TAB 13978 . 14362) (TERM.UNDERLINE 14364 . 14643) (TERM.UP 14645 . 14985)))))
STOP