(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")

(FILECREATED "16-Oct-86 19:49:42" {ERIS}<LISPCORE>LIBRARY>CHATTERMINAL.;12


      changes to%:  (FNS TERM.RESET.DISPLAY.PARMS)
                    (VARS CHATTERMINALCOMS)
                    (FILES CHATDECLS)

      previous date%: "26-Mar-86 12:35:25" {ERIS}<LISPCORE>LIBRARY>CHATTERMINAL.;10)


(* "
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))
        (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
                                             'INPUT
                                             '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)
                 'INPUT
                 '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
                                            'INPUT
                                            '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)
                 'INPUT
                 '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 'TEXTURE
                                       '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)
                                                                  'WEIGHT
                                                                  'MEDIUM)
                                                         DSP)
                                                  (DSPSOURCETYPE 'INPUT DSP)
                                                  (SETQ UNDERLINEMODE NIL))
                                          (BRIGHT            (* Implement "BRIGHT" by using a bold 

                                                             font)

                                                  (COND
                                                     (INVERTFLG (DSPFONT (FONTCOPY (DSPFONT NIL DSP)
                                                                                'WEIGHT
                                                                                'MEDIUM)
                                                                       DSP))
                                                     (T (DSPFONT (FONTCOPY (DSPFONT NIL DSP)
                                                                        'WEIGHT
                                                                        '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 'INPUT DSP))
                                                      (T (DSPSOURCETYPE '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)
                                       (* edited%: "26-Mar-86 12:30")

                                                             (* 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 'DESCENT))
          (SETQ TTYWIDTH (WINDOWPROP WINDOW 'WIDTH))
          (SETQ TTYWIDTH (ITIMES (IQUOTIENT TTYWIDTH FONTWIDTH)
                                FONTWIDTH))                  (* Make TTYWIDTH multiple of FONTWIDTH)

          (SETQ TOPMARGIN (SETQ TTYHEIGHT (IPLUS (ITIMES (IQUOTIENT (WINDOWPROP WINDOW 'HEIGHT)
                                                                FONTHEIGHT)
                                                        FONTHEIGHT)
                                                 FONTDESCENT)))
          (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
                                                                                           ))
                                       'INPUT
                                       '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 'INPUT '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)
                                       (* edited%: "26-Mar-86 11:06")

    (with
 CHAT.STATE CHAT.STATE (LET ((CURSORX (ADD1 (IQUOTIENT XPOS FONTWIDTH)))
                                      NEXT.STOP)
                                     (COND
                                        ((SETQ NEXT.STOP (for
 CX in
 TERM.TAB.STOPS
                                                            thereis
 (IGEQ 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
                                       'INVERT
                                       '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
 )
(DECLARE%: EVAL@COMPILE DONTCOPY 
(FILESLOAD (SOURCE)
       CHATDECLS)
)
(PUTPROPS CHATTERMINAL COPYRIGHT ("Xerox Corporation" 1984 1985 1986))
STOP