(FILECREATED "20-Sep-85 12:53:22" {ERIS}<LISPCORE>LIBRARY>DMCHAT.;6
 11567  

      changes to:  (FNS DMCHAT.HANDLECHARACTER)

      previous date: " 5-Sep-85 15:12:27" {ERIS}<LISPCORE>LIBRARY>DMCHAT.;5)


(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT DMCHATCOMS)

(RPAQQ DMCHATCOMS
 ((* DM peculiar functions)
		   (FNS DMCHAT.ADDRESS DMCHAT.CLEAR DMCHAT.CLEARMODES DMCHAT.HANDLECHARACTER 
			DMCHAT.NEWLINE DMCHAT.PRINTCHAR DMCHAT.RIGHT DMCHAT.STATE)
		   (* Terminal emulator support)
		   (FILES CHATTERMINAL)
		   (ADDVARS (CHAT.DRIVERTYPES (DM2500 DMCHAT.HANDLECHARACTER DMCHAT.STATE)))
		   (DECLARE: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
							  CHATDECLS)
			     (RECORDS DM2500.STATE))
		   (INITRECORDS DM2500.STATE)))



(* DM peculiar functions)


(DEFINEQ

(DMCHAT.ADDRESS

  (LAMBDA (CHAT.STATE DM2500.STATE CHAR)                     (* ejs: "12-May-85 15:26")

                                                             (* In the middle of doing absolute address.

							     Return T unless a cancel is received)

    (with
 CHAT.STATE CHAT.STATE (with
 DM2500.STATE DM2500.STATE
				      (
COND

					((
SELCHARQ
 CHAR
						   ((^X ^^ ^_)
						     T)
						   NIL)      (* Cancel it)

					  (
SETQ
 ADDRESSING NIL))
					((
EQ
 CHAR (
CHARCODE
 ^L))
                                                             (* Restarting the address in the middle of the address 

							     is legal)

					  (
SETQ
 ADDRESSING -1))
					((
ILESSP
 ADDRESSING 0)
                                                             (* Accept first position)

					  (
SETQ
 ADDRESSING (
LOGXOR
 CHAR 96)))
					(T                   (* Accept second position and go there)

					   (
MOVETO
 (
SETQ
 XPOS (
IMIN
 (
ITIMES
 ADDRESSING FONTWIDTH)
								    (
IDIFFERENCE
 TTYWIDTH FONTWIDTH)))
						   (
SETQ
 YPOS (
IMAX
 FONTDESCENT
								    (
IDIFFERENCE
 HOMEPOS
										 (
ITIMES

										   (
LOGXOR
 CHAR 96)
										   FONTHEIGHT))))
						   DSP)
					   (
SETQ
 ADDRESSING)
					   T))))))

(DMCHAT.CLEAR

  (LAMBDA (CHAT.STATE DM2500.STATE SETROLL)                  (* ejs: "12-May-85 17:13")

    (with
 CHAT.STATE CHAT.STATE (with
 DM2500.STATE DM2500.STATE (
CLEARW
 WINDOW)
				      (DMCHAT.CLEARMODES
 CHAT.STATE DM2500.STATE)
				      (
AND
 SETROLL (
SETQ
 ROLLMODE T))
				      (
TERM.HOME
 CHAT.STATE)))))

(DMCHAT.CLEARMODES

  (LAMBDA (CHAT.STATE DM2500.STATE)                          (* ejs: "12-May-85 15:08")

    (with
 CHAT.STATE CHAT.STATE (with
 DM2500.STATE DM2500.STATE (
COND

					((
OR
 BLINKMODE BRIGHTMODE)
                                                             (* Restore normal font)

					  (
DSPFONT
 PLAINFONT DSP)
					  (
SETQ
 FONT PLAINFONT)
					  (
SETQ
 BRIGHTMODE (
SETQ
 BLINKMODE))))
				      (
SETQ
 IDMODE (
SETQ
 ADDRESSING))))))

(DMCHAT.HANDLECHARACTER

  [LAMBDA (CHAR CHAT.STATE DM2500.STATE)                     (* edited: "20-Sep-85 12:26")

                                                             (* Here and/or below)

    (
PROG
 NIL
          (with
 DM2500.STATE DM2500.STATE (with
 CHAT.STATE CHAT.STATE
						[
COND

						  ((
EQ
 CHAR (
CHARCODE
 BELL))
						    (
RETURN
 (
COND

							      ((
OR
 (
EQ
 \MACHINETYPE \DANDELION)
								   (
EQ
 \MACHINETYPE \DAYBREAK))
								(
BOUT
 (
WINDOWPROP
 WINDOW
										  (
QUOTE
 DSP))
								      7))
							      ((
NOT
 DINGED)
								(
APPLY*
 INVERTWINDOWFN WINDOW)
                                                             (* Complement window)

								(
SETQ
 DINGED T]
						(
COND

						  (DINGED (
APPLY*
 INVERTWINDOWFN WINDOW)
							  (
SETQ
 DINGED NIL)))
						(
COND

						  ((
AND
 AUTOLF (
OR
 (
NEQ
 CHAR (
CHARCODE
 CR))
								   (
NOT
 EATTOCRLF)))

          (* We last received a CR, so DM wants auto LF after it. However, we postpone doing so until the next char is 

	  received, so that we get scroll holding right)



						    (
TERM.DOWN
 CHAT.STATE)
						    (
SETQ
 AUTOLF NIL)))
						[
COND

						  (ADDRESSING (
COND

								((DMCHAT.ADDRESS
 CHAT.STATE 
										 DM2500.STATE CHAR)
								  (
RETURN
]
						[
COND

						  ((
AND
 (
IGEQ
 CHAR (
CHARCODE
 SPACE))
							(
ILESSP
 CHAR (
CHARCODE
 DEL)))
                                                             (* Normal char)

						    (
SETQ
 EATLF (
SETQ
 EATCRLF NIL))
						    (
RETURN
 (
COND

							      ((
NOT
 EATTOCRLF)
                                                             (* Print the char)

								(
COND

								  (IDMODE 
                                                             (* this is discouraged by the DM manual, but apparently

							     EMACS does it, so might as well support it)

									  (
TERM.ADDCHAR
 CHAT.STATE)))
								(DMCHAT.PRINTCHAR
 CHAT.STATE 
										  DM2500.STATE CHAR]
						[
COND

						  (EATLF (
SETQ
 EATLF NIL)
                                                             (* LF is ignored after CR)

							 (
COND

							   ((
EQ
 CHAR (
CHARCODE
 LF))
							     (
RETURN
]
						[
COND

						  (EATCRLF 
                                                             (* We just wrapped around, so ignore CR and/or LF if 

							     next)

							   (
COND

							     ((
EQ
 CHAR (
CHARCODE
 CR))
							       (
SETQ
 EATLF T)
							       (
RETURN
 (
SETQ
 EATCRLF NIL)))
							     (T 
                                                             (* Intervening control characters do not stop the 

							     eating, except for a few inconsistent exceptions...)

								(SELCHARQ CHAR
									  ((^B ^\ ^^ ^_)
									    (
SETQ
 EATCRLF NIL))
									  NIL]
						(SELCHARQ CHAR
							  [LF (
COND

								(IDMODE (
TERM.ADDLINE
 CHAT.STATE))
								(T (
TERM.DOWN
 CHAT.STATE]
							  (CR (
SETQ
 EATTOCRLF NIL)
							      (DMCHAT.NEWLINE
 CHAT.STATE DM2500.STATE 
									      T))
							  [BS (
COND

								(IDMODE (
TERM.DELCHAR
 CHAT.STATE))
								(T (
TERM.LEFT
 CHAT.STATE]
							  (^W 
                                                             (* Erase to end of line)

							      (
TERM.ERASE.TO.EOL
 CHAT.STATE))
							  (^L 
                                                             (* Start of cursor address)

							      (
SETQ
 ADDRESSING -1))
							  (^B 
                                                             (* Homes cursor, cancels some modes)

							      (
TERM.HOME
 CHAT.STATE)
							      (DMCHAT.CLEARMODES
 CHAT.STATE 
										 DM2500.STATE))
							  (^X 
                                                             (* Cancel --resets modes)

							      (DMCHAT.CLEARMODES
 CHAT.STATE 
										 DM2500.STATE)
							      (
SETQ
 ROLLMODE))
							  ((^^ ^_)
                                                             (* Master Reset -- Clears screen, modes)

							    (DMCHAT.CLEAR
 CHAT.STATE DM2500.STATE))
							  [^\ 
                                                             (* Forward space)

							      (
COND

								((
NOT
 EATTOCRLF)
								  (
COND

								    (IDMODE (
TERM.ADDCHAR
 CHAT.STATE))
								    (T (DMCHAT.RIGHT
 CHAT.STATE 
										     DM2500.STATE]
							  [^Z 
                                                             (* Up)

							      (
COND

								(IDMODE (
TERM.DELETELINE
 CHAT.STATE))
								(T (
TERM.UP
 CHAT.STATE]
							  [(^N ^O)
                                                             (* Enter blink mode, enter protected mode.

							     Do both as embolden)

							    (
TERM.MODIFY.ATTRIBUTES

							      CHAT.STATE
							      (
QUOTE
 BRIGHT)
							      (
NOT
 (
SETQ
 BRIGHTMODE (
NOT
 BRIGHTMODE]
							  (^P 
                                                             (* Enter i/d mode)

							      (
SETQ
 IDMODE T))
							  (^%] 
                                                             (* Set roll mode)

							       (
SETQ
 ROLLMODE T))
							  NIL])

(DMCHAT.NEWLINE

  (LAMBDA (CHAT.STATE DM2500.STATE EXPLICIT)                 (* ejs: "12-May-85 15:12")

                                                             (* Do a CRLF. EXPLICIT = T means a CR was received, NIL

							     means we did autowraparound)

    (with
 CHAT.STATE CHAT.STATE (with
 DM2500.STATE DM2500.STATE (
MOVETO
 (
SETQ
 XPOS 0)
									YPOS DSP)
                                                             (* Do only the CR part now, saving the LF for when next

							     char arrives)

				      (
SETQ
 AUTOLF T)
				      (
COND

					(EXPLICIT (
SETQ
 EATLF T))
					(T (
SETQ
 EATCRLF T)))))))

(DMCHAT.PRINTCHAR

  (LAMBDA (CHAT.STATE DM2500.STATE CHAR)                     (* ejs: "12-May-85 16:42")

    (with
 CHAT.STATE CHAT.STATE (with
 DM2500.STATE DM2500.STATE (
\OUTCHAR
 DSP CHAR)
				      (
COND

					((
IGEQ
 (
SETQ
 XPOS (
PLUS
 XPOS FONTWIDTH))
					       TTYWIDTH)     (* Have reached right margin, so wrap around)

					  (
COND

					    (CHAT.AUTOCRLF (DMCHAT.NEWLINE
 CHAT.STATE DM2500.STATE))
					    (T (
SETQ
 EATTOCRLF T)))))))))

(DMCHAT.RIGHT

  (LAMBDA (CHAT.STATE DM2500.STATE)                          (* ejs: "12-May-85 15:31")

    (with
 CHAT.STATE CHAT.STATE (with
 DM2500.STATE DM2500.STATE (
COND

					((
ILESSP
 (
IPLUS
 XPOS FONTWIDTH)
						 TTYWIDTH)
					  (
SETQ
 XPOS (
PLUS
 XPOS FONTWIDTH))
					  (
MOVETO
 XPOS YPOS DSP))
					(T                   (* Auto crlf)

					   (DMCHAT.NEWLINE
 CHAT.STATE DM2500.STATE)))))))

(DMCHAT.STATE

  [LAMBDA (CHAT.STATE)                                       (* AJB "23-May-85 15:24")

    (TERM.RESET.DISPLAY.PARMS CHAT.STATE)
    (TERM.HOME CHAT.STATE)
    (create
 DM2500.STATE])
)



(* Terminal emulator support)


(FILESLOAD CHATTERMINAL)

(ADDTOVAR CHAT.DRIVERTYPES
 (DM2500 DMCHAT.HANDLECHARACTER DMCHAT.STATE))
(DECLARE: EVAL@COMPILE DONTCOPY 
(FILESLOAD (SOURCE)
	   CHATDECLS)

[DECLARE: EVAL@COMPILE 

(DATATYPE DM2500.STATE
 ((DINGED FLAG)
			(EATLF FLAG)
			(EATCRLF FLAG)
			(EATTOCRLF FLAG)
			(AUTOLF FLAG)
			ADDRESSING
			(IDMODE FLAG)
			(BLINKMODE FLAG)
			(BRIGHTMODE FLAG)))
]
(/DECLAREDATATYPE (QUOTE DM2500.STATE)
		  (QUOTE (FLAG FLAG FLAG FLAG FLAG POINTER FLAG FLAG FLAG))
		  [QUOTE ((DM2500.STATE 0 (FLAGBITS . 0))
			  (DM2500.STATE 0 (FLAGBITS . 16))
			  (DM2500.STATE 0 (FLAGBITS . 32))
			  (DM2500.STATE 0 (FLAGBITS . 48))
			  (DM2500.STATE 0 (FLAGBITS . 64))
			  (DM2500.STATE 0 POINTER)
			  (DM2500.STATE 0 (FLAGBITS . 80))
			  (DM2500.STATE 0 (FLAGBITS . 96))
			  (DM2500.STATE 0 (FLAGBITS . 112]
		  (QUOTE 2))
)
(/DECLAREDATATYPE (QUOTE DM2500.STATE)
		  (QUOTE (FLAG FLAG FLAG FLAG FLAG POINTER FLAG FLAG FLAG))
		  [QUOTE ((DM2500.STATE 0 (FLAGBITS . 0))
			  (DM2500.STATE 0 (FLAGBITS . 16))
			  (DM2500.STATE 0 (FLAGBITS . 32))
			  (DM2500.STATE 0 (FLAGBITS . 48))
			  (DM2500.STATE 0 (FLAGBITS . 64))
			  (DM2500.STATE 0 POINTER)
			  (DM2500.STATE 0 (FLAGBITS . 80))
			  (DM2500.STATE 0 (FLAGBITS . 96))
			  (DM2500.STATE 0 (FLAGBITS . 112]
		  (QUOTE 2))
(PUTPROPS DMCHAT COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (817 10147 (DMCHAT.ADDRESS 827 . 2144) (DMCHAT.CLEAR 2146 . 2496) (DMCHAT.CLEARMODES 
2498 . 2993) (DMCHAT.HANDLECHARACTER 2995 . 8327) (DMCHAT.NEWLINE 8329 . 8998) (DMCHAT.PRINTCHAR 9000
 . 9493) (DMCHAT.RIGHT 9495 . 9935) (DMCHAT.STATE 9937 . 10145)))))
STOP