;;; -*- Mode:Common-Lisp; Package:SI; Base:10; Cold-Load: T -*-

;;;                           RESTRICTED RIGHTS LEGEND

;;;Use, duplication, or disclosure by the Government is subject to
;;;restrictions as set forth in subdivision (c)(1)(ii) of the Rights in
;;;Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;                     TEXAS INSTRUMENTS INCORPORATED.
;;;                              P.O. BOX 2909
;;;                           AUSTIN, TEXAS 78769
;;;                                 MS 2151
;;;
;;; Copyright (C) 1983-1989 Texas Instruments Incorporated. All rights reserved.
;	** (c) Copyright 1980 Massachusetts Institute of Technology **

;;; This file contains those portions of the window system that need
;;; to be in the cold-load, including the basic keyboard software and
;;; the cold load stream.

;;;
;;; Change History
;;;
;;;  Date        Author  Description
;;; -------------------------------------------------------------------------------------
;;; 08/20/88    KJF      o [MAY] Change to complement-screen to work on Multiple CSIB systems.
;;;                        System patch (first 4-85) updated 4-95
;;;  6-28-88    BJ       o Queueing changes.
;;;  6-15-88    ab       o Fix :STRING-OUT to allow arbitrarily long strings (for VIEW-FILE).
;;;  6/7/88	jjp	 o Speed up mx :string out by sending whole string to MX and get
;;;			   resulting cursor position back from acb.
;;;  2/16/88	DNG 	 o Delete :CURRENT-FONT method since FONT slot not bound on MX.
;;;  2/16/88     ab      SYS 4.18
;;;                      o Restore COLD-LOAD-STREAM defvar (seems to have disappeared).
;;;                      o Change INITIALIZE-COLD-LOADS not to send command to MX host
;;;                      because of form which runs on the crash list in the cold band.
;;;  2/09/88	DNG	 o Add COLD-LOAD attribute. Add EXPORT for TV symbols.  Add 
;;;			 :GETTABLE-INSTANCE-VARIABLES and methods :CURRENT-FONT, 
;;;			 :INSIDE-WIDTH, and :INSIDE-HEIGHT for greater compatibility
;;;			 with regular windows.
;;; 01/30/88     ab      o Change DEFVAR of TV:COLD-LOAD-STREAM-OWNS-KEYBOARD to
;;;                      SI:COLD-LOAD-STREAM-OWNS-KEYBOARD, since the latter is the one
;;;                      the keyboard process looks at!
;;;                      o Integrate JJP & GG changes for MX Cold Load Stream


;;
;; Variables
;;

(DEFVAR Cold-Load-Stream NIL)			;ab 2/16/88

(export '(cold-load-stream    ; DAB 04-24-89
	   with-help-stream
	   *null-stream*
	   )
	'sys)  ; DAB 04-24-89

(DEFVAR COLD-LOAD-STREAM-OWNS-KEYBOARD NIL
  "Non-NIL means something reading from cold load stream, so turn off KBD-PROCESS.")

(EXPORT '( TV:ALU-AND TV:ALU-ANDCA TV:ALU-IOR TV:ALU-SETA TV:ALU-SETZ 
	  TV:ALU-XOR TV:ALU-TRANSP TV:ALU-MAX TV:ALU-MIN TV:ALU-AVG TV:ALU-ADD 
	  TV:ALU-SUB TV:ALU-ADDS TV:ALU-SUBC TV:ALU-BACK
	  TV:KBD-LAST-ACTIVITY-TIME TV:KEYPAD-IN-APPLICATION-MODE-P 
	  TV:MORE-PROCESSING-GLOBAL-ENABLE TV:SETUP-APPLICATION-MODE 
	  TV:SETUP-KEYPAD-MODE ) 'TV) ; external TV symbols defined in the cold band

(DEFVAR TV:MORE-PROCESSING-GLOBAL-ENABLE t)

(DEFVAR TV:DEFAULT-BACKGROUND-STREAM 'TV:BACKGROUND-STREAM)

(DEFVAR TV:KBD-LAST-ACTIVITY-TIME 0
  "Time user last typed a key or clicked mouse.")

(defvar scrolled-lines 0)

;;; The following constants are used to specify how pixels being drawn are
;;; to be combined with existing pixels on the screen (or in an array if one
;;; is using BITBLT).  The word ALU is an abbreviation for the words
;;; Arithmetic Logic Unit.  The number is a 4 bit binary number which is the
;;; result of applying the two input bits to a truth table.  For example,
;;; TV:ALU-ANDCA is 2 which is 0010 in binary.  Converting this to a truth
;;; table one gets:
;;; 
;;; 
;;; 		ANDCA | 0   1 <- src array values
;;; 		------+-------
;;;    Screen	   0  | 0   0  
;;;    Contents	->    |         <- New pixel values
;;; (dest array)   1  | 1   0
;;; 
;;; Note that the truth table is constructed from the binary number, filling
;;; the first row with the 2 leading binary digits and the second row with
;;; the 2 low order binary digits.  A total of 16 ALU constants are possible
;;; but only the following six seem reasonable.

(DEFCONSTANT TV:ALU-SETA  5 "Alu function for copying bits to the destination.")
(DEFCONSTANT TV:ALU-XOR   6 "Alu function for flipping bits in destination.")
(DEFCONSTANT TV:ALU-ANDCA 2 "Alu function for clearing bits in destination.")
(DEFCONSTANT TV:ALU-IOR   7 "Alu function for setting bits in destination.")
(DEFCONSTANT TV:ALU-SETZ  0 "Alu function for setting bits in the destination to zero.")
(DEFCONSTANT TV:ALU-AND   1 "Alu function to AND source and destination bits together.")

(DEFCONSTANT TV:alu-setca 10.  "Alu function for setting destination after complementing the first argument.")
(DEFCONSTANT TV:alu-transp 16. "Alu function for drawing in color transparency mode.") 
(DEFCONSTANT TV:alu-max 17.    "Alu function for setting destination to max of source or destination.")
(DEFCONSTANT TV:alu-min 18.    "Alu function for setting destination to min of source or destination.")
(DEFCONSTANT TV:alu-avg 19.    "Alu function for setting destination to the average of the source or destination.")
(DEFCONSTANT TV:alu-adds 20.   "Alu function for adding with saturation.")
(DEFCONSTANT TV:alu-subc 21.   "Alu function for subtracting with clamping.")
(DEFCONSTANT TV:alu-back 22.   "Alu function for forcing destination to the background color.")
(DEFCONSTANT TV:alu-add  23.   "Alu function for adding with NO saturation")
(DEFCONSTANT TV:alu-sub  24.   "Alu function for subtracting with NO clamping.")

;;; Call this when the state of a process may have changed.
;;; In the cold-load because called by process stuff, loaded before window stuff.
(DEFUN TV:WHO-LINE-PROCESS-CHANGE (PROC)
  (AND (FBOUNDP 'TV:WHO-LINE-RUN-STATE-UPDATE)
       (EQ PROC TV:LAST-WHO-LINE-PROCESS)
       (TV:WHO-LINE-RUN-STATE-UPDATE)))


;;
;; Cold Load Stream Flavor
;;

(Defflavor COLD-LOAD-STREAM
  (ARRAY					;The array into which bits go      *** ucode knows index 1
   LOCATIONS-PER-LINE				;Number of words in a screen line  *** ucode knows index 2
   HEIGHT					;Height of screen
   CURSOR-X					;Current x position
   CURSOR-Y					;Current y position
   FONT						;The one and only font
   CHAR-WIDTH					;Width of a character
   LINE-HEIGHT					;Height of line, including vsp
   BUFFER					;The hardward buffer location
   CONTROL-ADDRESS				;Hardware controller address
   UNRCHF					;For :UNTYI
   RUBOUT-HANDLER-BUFFER			;For :RUBOUT-HANDLER
   KEYPAD-ENABLE				;Distinguish keypad characters on input?
   WIDTH					;Width of screen                   *** ucode knows index 14.
   )
  () :ordered-instance-variables
  (:GETTABLE-INSTANCE-VARIABLES HEIGHT WIDTH CURSOR-X CURSOR-Y CHAR-WIDTH 
				LINE-HEIGHT KEYPAD-ENABLE)
  (:SETTABLE-INSTANCE-VARIABLES KEYPAD-ENABLE))

(DEFMETHOD (COLD-LOAD-STREAM :PRINT-SELF) (STREAM &REST IGNORE)
  (FORMAT STREAM "#<~A ~O>" (TYPE-OF SELF) (%POINTER SELF))) 

;;ab 2/10/88.  Use SYMEVAL-IN-INSTANCE instead of :EVAL-INSIDE-YOURSELF which conses.
(DEFUN mx-cold-load-p (cold-load)
  (NULL (SYMEVAL-IN-INSTANCE cold-load 'si:buffer)))

(DEFVAR all-cold-loads nil)

(DEFMETHOD (COLD-LOAD-STREAM :INIT) (PLIST)
  (OR (BOUNDP 'KBD-TRANSLATE-TABLE)
      (KBD-INITIALIZE))
  (OR (BOUNDP 'TV:DEFAULT-SCREEN)
      (SETQ TV:DEFAULT-SCREEN SELF))
  (COND ((GET plist :mx)
	 (PROGN
	   (SETQ CURSOR-X 0 CURSOR-Y 0
		 UNRCHF NIL
		 WIDTH (GET PLIST :WIDTH)
		 HEIGHT (GET PLIST :HEIGHT)
		 BUFFER nil
		 LOCATIONS-PER-LINE (TRUNCATE WIDTH 32.)
		 CHAR-WIDTH (GET plist :char-width)
		 LINE-HEIGHT  (GET plist :char-height)
		 RUBOUT-HANDLER-BUFFER (MAKE-ARRAY 512. :TYPE ART-STRING :LEADER-LIST '(0 0))
		 KEYPAD-ENABLE NIL)))	 
	(t
	 (SETQ CURSOR-X 0 CURSOR-Y 0
	       FONT (OR (GET PLIST :FONT) FONTS:CPTFONT)
	       UNRCHF NIL
	       WIDTH (GET PLIST :WIDTH)
	       HEIGHT (GET PLIST :HEIGHT)
	       BUFFER (GET PLIST :BUFFER)
	       CONTROL-ADDRESS (GET PLIST :CONTROL-ADDRESS)
	       ARRAY (MAKE-ARRAY (LIST HEIGHT WIDTH) :TYPE ART-1B :DISPLACED-TO BUFFER)
	       LOCATIONS-PER-LINE (TRUNCATE WIDTH 32.)
	       CHAR-WIDTH (TV:FONT-CHAR-WIDTH FONT)
	       LINE-HEIGHT (+ 2 (TV:FONT-CHAR-HEIGHT FONT))
	       RUBOUT-HANDLER-BUFFER (MAKE-ARRAY 512. :TYPE ART-STRING :LEADER-LIST '(0 0))
	       KEYPAD-ENABLE NIL))))


(DEFPARAMETER cold-load-stream-channel si:%Chan-Type-Misc)




(DEFMETHOD (COLD-LOAD-STREAM :READ-CURSORPOS) (&OPTIONAL (UNITS :PIXEL))
  (let ((X CURSOR-X)
	(Y CURSOR-Y))
    (when (EQ UNITS :CHARACTER)
      (SETQ X (TRUNCATE X CHAR-WIDTH)
	    Y (TRUNCATE Y LINE-HEIGHT)))
    (VALUES X Y)))

(DEFMETHOD (COLD-LOAD-STREAM :SET-CURSORPOS) (X Y &OPTIONAL (UNITS :PIXEL))
  (AND (NUMBERP UNITS)				;***CROCK***, flush when format fixed
       (PSETQ UNITS X X Y Y UNITS))
  (AND (EQ UNITS :CHARACTER)
       (SETQ X (* X CHAR-WIDTH)
	     Y (* Y LINE-HEIGHT)))
  (SETQ CURSOR-X (MAX 0 (MIN WIDTH X))
	CURSOR-Y (MAX 0 (MIN (- HEIGHT LINE-HEIGHT) Y)))
  (when (mx-cold-load-p self)
      (mx-cold-setpos cursor-x cursor-y)))

(DEFMETHOD (COLD-LOAD-STREAM :HOME-CURSOR) ()
  (SETQ CURSOR-X 0 CURSOR-Y 0)
   (when (mx-cold-load-p self)
       (mx-cold-setpos 0 0)
       (setf scrolled-lines 0)))

(DEFUN mx-cold-setpos (x y)
  (let ((acb (add:get-acb 8 t))
	(ch  (add:find-channel cold-load-stream-channel)))
    (unwind-protect
	(progn
	  (add:init-acb acb
			si:%MC-tvcalls
			si:%TC-SETPOS)
	  (add:set-parm-32b acb 0 x)
	  (add:set-parm-32b acb 1 y) 
	  (add:transmit-packet-and-wait acb ch)
	  (add:check-error acb))
      (setf (add:requestor-complete acb) t)
      (add:return-acb-fast acb))))

(DEFUN mx-cold-cursor (onoff)
  (let ((acb (add:get-acb 4 t))
	(ch  (add:find-channel cold-load-stream-channel)))
    (unwind-protect
	(progn
	  (add:init-acb acb
			si:%MC-tvcalls
			si:%TC-CURSOR)
	  (add:set-parm-32b acb 0 onoff)
	  (add:transmit-packet-and-wait acb ch)
	  (add:check-error acb))
      (setf (add:requestor-complete acb) t)
      (add:return-acb-fast acb))))

(DEFMETHOD (COLD-LOAD-STREAM :HANDLE-EXCEPTIONS) ())

(DEFMETHOD (COLD-LOAD-STREAM :CLEAR-SCREEN) ()
  (SETQ CURSOR-X 0 CURSOR-Y 0)
  (COND ((mx-cold-load-p self)
	 (let ((acb (add:get-acb 2 t))
	       (ch  (add:find-channel cold-load-stream-channel)))
	   (unwind-protect
	       (progn
		 (add:init-acb acb
			       si:%MC-tvcalls
			       si:%TC-CLRSCR) 
		 (add:transmit-packet-and-wait acb ch)
		 (add:check-error acb))
	     (setf (add:requestor-complete acb) t)
	     (add:return-acb-fast acb)))
	 (setf  scrolled-lines 0)
	 (mx-cold-setpos cursor-x cursor-y))
	(t
	 (LET ((CURRENTLY-PREPARED-SHEET SELF))
	   (%DRAW-RECTANGLE WIDTH HEIGHT 0 0 TV:ALU-ANDCA SELF)))))


(defun ctyo (char)				;send a character to the debug screen
  (let ((acb (add:get-acb 2 t))
	(ch  (add:find-channel cold-load-stream-channel)))
    (unwind-protect
	(progn
	  (add:init-acb acb
			si:%MC-tvcalls
			si:%TC-TYO)		;out char
	  
	  (add:load-parms-8b acb (logand #x7f char))
	  
	  (add:transmit-packet-and-wait acb ch)
	  (add:check-error acb))
      (setf (add:requestor-complete acb) t)
      (add:return-acb-fast acb))))

(defun ctyi ()   ;get a character from the debug screen, if any
  (mx-get-key))


(defun clisten ()   ;get a character from the debug screen, if any
  (mx-char-avail))

(DEFUN cget-char ()
  (loop (if (clisten)
	    (return (tv:kbd-convert-mac (ctyi))))))

(defmethod (cold-load-stream :line-in) (ignore)
  (let ((buf (make-array 64. :element-type 'string-char
			 :fill-pointer 0)))
    (setf (fill-pointer buf) 0)
    (values  buf
	    (do ((tem (send self :tyi ()) (send self :tyi ())))
		((or (null tem) (= tem #\NEWLINE) (= tem #\END))
		 (adjust-array buf (array-active-length buf))
		 (null tem))
	      (vector-push-extend tem buf)))))


(DEFMETHOD (COLD-LOAD-STREAM :CLEAR-EOL) ()
  (COND ((mx-cold-load-p self)
	 (mx-cold-setpos cursor-x cursor-y)	; make sure where are where we think we are
	 (let ((acb (add:get-acb 2 t))
	       (ch  (add:find-channel cold-load-stream-channel)))
	   (unwind-protect
	       (progn
		 (add:init-acb acb
			       si:%MC-tvcalls
			       si:%TC-CLREOL) 
		 (add:transmit-packet-and-wait acb ch)
		 (add:check-error acb))
	     (setf (add:requestor-complete acb) t)
	     (add:return-acb-fast acb))))
	
	(t (LET ((CURRENTLY-PREPARED-SHEET SELF))
	     (%DRAW-RECTANGLE (- WIDTH CURSOR-X) LINE-HEIGHT CURSOR-X CURSOR-Y TV:ALU-ANDCA SELF)))))

(DEFMETHOD (COLD-LOAD-STREAM :TYO) (CH)
  (COND ((mx-cold-load-p self)
	 (let ((ch-code (char-code ch)))
	   (cond ((< CH-code #o200)	; normal character
	       (AND (> (+ CURSOR-X char-width) WIDTH)	;End of line exception
		    (FUNCALL SELF :TYO #\CR))
	       (SETQ CURSOR-X (+ CURSOR-X char-width))	     	     
	       (ctyo ch))

	      ((= CH #\CR)
	       (SETQ CURSOR-X 0
		     CURSOR-Y (+ CURSOR-Y LINE-HEIGHT))
	       (cond ((>= cursor-y HEIGHT)
		      
		   (SETQ cursor-y (- height line-height))
		   (mx-cold-setpos cursor-x cursor-y)))
	       (incf scrolled-lines)
	       (ctyo ch)    ; tell mac to move cursor *before* we do ereol
	       (FUNCALL SELF :CLEAR-EOL)
	       (WHEN (and TV:MORE-PROCESSING-GLOBAL-ENABLE
				 (> scrolled-lines (- (floor height line-height) 3)))
			(FUNCALL SELF :STRING-OUT "**MORE**")
			(FUNCALL SELF :TYI)
			(setf scrolled-lines 0
			      cursor-x 0)
			(SETQ CURSOR-X 0)
			(mx-cold-setpos cursor-x cursor-y)
			(FUNCALL SELF :CLEAR-EOL))
	       )

	      ((= CH #\TAB)
	       (DOTIMES (I (- 8 (zlc:remainder (TRUNCATE CURSOR-X CHAR-WIDTH) 8)))
		 (FUNCALL SELF :TYO #\SP)))

	      ((< CH-CODE #o240)
	       (LET* ((CHNAME (symbol-name (CAR (RASSOC CH-CODE XR-SPECIAL-CHARACTER-NAMES))))
		      (CHWIDTH (+ (* (ARRAY-ACTIVE-LENGTH CHNAME) char-width) (* 2 char-width))))
		 (AND (> (+ CURSOR-X CHWIDTH) WIDTH)	;Won't fit on line
		      (FUNCALL SELF :TYO #\CR))
		 ;; Put the string surrounded by < >
		 (send self :tyo #\<)
		 (DO ((I 0 (1+ I))
		      (N (ARRAY-ACTIVE-LENGTH CHNAME)))
		     ((>= I N))
		   (ctyo (aref chname i)))
		 (send self :tyo #\>)
	       (SETQ CURSOR-X (+ cursor-x chwidth (* 2 char-width)))
	       (mx-cold-setpos cursor-x cursor-y))))))

	;; Regular system case
	(t
	 (LET ((CURRENTLY-PREPARED-SHEET SELF)
	       (ch-code (char-code ch)))
	   (COND ((< CH-code #o200)
		  (LET ((CHAR-WIDTHS (TV:FONT-CHAR-WIDTH-TABLE FONT))
			(FIT-ENTRY (TV:FONT-INDEXING-TABLE FONT))
			(DELTA-X))
		    (SETQ DELTA-X (IF CHAR-WIDTHS (AREF CHAR-WIDTHS CH-CODE) (TV:FONT-CHAR-WIDTH FONT)))
		    (AND (> (+ CURSOR-X DELTA-X) WIDTH)	;End of line exception
			 (FUNCALL SELF :TYO #\CR))
		    (IF (NULL FIT-ENTRY)
			(%DRAW-CHARACTER FONT CH-CODE DELTA-X CURSOR-X CURSOR-Y TV:ALU-IOR SELF)
			;;  This is a character wider than 32 bits, so it's broken into smaller chunks
			;;  so %draw-char(acter) can handle it.  We're using font-raster-width for the
			;;  width because it will be wide enough for all cases, though maybe too wide
			;;  for some.  - pf, Nov 4, 1986
			(DO ((CH (AREF FIT-ENTRY CH-CODE) (1+ CH))
			     (LIM (AREF FIT-ENTRY (1+ CH-CODE)))
			     (XPOS CURSOR-X (+ XPOS (TV:FONT-RASTER-WIDTH FONT))))
			    ((= CH LIM))
			  (%DRAW-CHARACTER FONT CH-CODE (TV:FONT-RASTER-WIDTH FONT) XPOS CURSOR-Y TV:ALU-IOR SELF)))
		    (SETQ CURSOR-X (+ CURSOR-X DELTA-X))))
		 ((= CH #\CR)
		  (SETQ CURSOR-X 0
			CURSOR-Y (+ CURSOR-Y LINE-HEIGHT))
		  (COND ((>= CURSOR-Y HEIGHT)	;End-of-page exception
			 (SETQ CURSOR-Y 0))
			((>= CURSOR-Y (- HEIGHT (* 2 LINE-HEIGHT)))	;MORE exception
			 (FUNCALL SELF :CLEAR-EOL)	;In case wholine is there
			 (WHEN TV:MORE-PROCESSING-GLOBAL-ENABLE
			   (FUNCALL SELF :STRING-OUT "**MORE**")
			   (FUNCALL SELF :TYI))
			 (SETQ CURSOR-X 0)
			 (FUNCALL SELF :CLEAR-EOL)
			 (SETQ CURSOR-Y 0)))
		  (FUNCALL SELF :CLEAR-EOL))
		 ((= CH #\TAB)
		  (DOTIMES (I (- 8 (zlc:remainder (TRUNCATE CURSOR-X CHAR-WIDTH) 8)))
		    (FUNCALL SELF :TYO #\SP)))
		 ((AND (< CH-CODE #o240) (BOUNDP 'FONTS:5X5))
		  ;; This won't work in the initial cold-load environment, hopefully no one
		  ;; will touch those keys then, but if they do we just type nothing.
		  ;; This code is like SHEET-DISPLAY-LOSENGED-STRING
		  (LET* ((CHNAME (symbol-name (CAR (RASSOC CH-CODE XR-SPECIAL-CHARACTER-NAMES))))
			 (CHWIDTH (+ (* (ARRAY-ACTIVE-LENGTH CHNAME) 6) 10.)))
		    (AND (> (+ CURSOR-X CHWIDTH) WIDTH)	;Won't fit on line
			 (FUNCALL SELF :TYO #\CR))
		    ;; Put the string then the box around it
		    (LET ((X0 CURSOR-X)
			  (Y0 (1+ CURSOR-Y))
			  (X1 (+ CURSOR-X (1- CHWIDTH)))
			  (Y1 (+ CURSOR-Y 9)))
		      (DO ((X (+ X0 5) (+ X 6))
			   (I 0 (1+ I))
			   (N (ARRAY-ACTIVE-LENGTH CHNAME)))
			  ((>= I N))
			;;  Since 5x5 is probably going to stay fixed-width, use the font-char-width.  - pf, Nov 4, 1986
			(%DRAW-CHARACTER FONTS:5X5 (AREF CHNAME I) (TV:FONT-CHAR-WIDTH FONTS:5X5)
					 X (+ Y0 2) TV:ALU-IOR SELF))
		      
		      (%DRAW-RECTANGLE (- CHWIDTH 8) 1 (+ X0 4) Y0 TV:ALU-IOR SELF)
		      (%DRAW-RECTANGLE (- CHWIDTH 8) 1 (+ X0 4) Y1 TV:ALU-IOR SELF)
		      (compiler2:%DRAW-SHADED-TRIANGLE  X0 (+ Y0 4) (+ X0 3) (1+ Y0)(+ X0 3) (1+ Y0)
							TV:ALU-IOR t t T nil SELF)
		      (compiler2:%DRAW-SHADED-TRIANGLE  (1+ X0) (+ Y0 5) (+ X0 3) (1- Y1)(+ X0 3) (1- Y1)
							TV:ALU-IOR t t T nil SELF)
		      (compiler2:%DRAW-SHADED-TRIANGLE  X1 (+ Y0 4) (- X1 3) (1+ Y0)(- X1 3) (1+ Y0)
							TV:ALU-IOR t t T nil SELF)
		      (compiler2:%DRAW-SHADED-TRIANGLE  (1- X1) (+ Y0 5) (- X1 3) (1- Y1)(- X1 3) (1- Y1)
							TV:ALU-IOR t t T nil SELF)
		      (SETQ CURSOR-X (1+ X1))))))
	   )))
  ch)


(DEFMETHOD (COLD-LOAD-STREAM :FRESH-LINE) ()
  (IF (ZEROP CURSOR-X) (FUNCALL SELF :CLEAR-EOL)
      (FUNCALL SELF :TYO #\CR)))


(DEFMETHOD (COLD-LOAD-STREAM :STRING-OUT) (STRING &OPTIONAL (START 0) END)
  (COND ((AND (mx-cold-load-p self) (<= (ARRAY-ACTIVE-LENGTH STRING) 200.))
	 ;; batch up string, send to mx, acb returns cursor pos
	 (SETF end (OR END (ARRAY-ACTIVE-LENGTH STRING)))
	 (WHEN (>= end start)
	   (let ((acb (add:get-acb 201.)))
	     (add:init-acb acb
			   si:%MC-tvcalls
			   si:%TC-string-out)

	     (add:COPY-parms-8b  acb string :to-acb (MIN 200 (- end start))
				 0 start)
	     (add:set-parm-8b acb (MIN 200 (- end start)) 0)
	     (DO ((I 0 (1+ I))
		  (carray (add:parm-block-accessor acb 8.)))
		 ((>= I end))
	       (WHEN (= #\newline (AREF carray I))
		 (SETF (AREF carray i) #x0a)))
	     (add:transmit-packet-and-wait acb cold-load-stream-channel)
	     (add:check-error acb)
	     (SETF cursor-x (add:parm-16b acb 0)
		   cursor-y (add:parm-16b acb 1))
	     (add:return-acb-fast acb t))))
	(t 
	 (DO ((I START (1+ I))
	      (END (OR END (ARRAY-ACTIVE-LENGTH STRING))))
	     ((>= I END))
	   (FUNCALL SELF :TYO (AREF STRING I))))))

(DEFMETHOD (COLD-LOAD-STREAM :LINE-OUT) (STRING &OPTIONAL (START 0) END)
  (FUNCALL SELF :STRING-OUT STRING START END)
  (FUNCALL SELF :TYO #\CR))

(DEFMETHOD (COLD-LOAD-STREAM :UNTYI) (CH)
  (IF RUBOUT-HANDLER
      (DECF (ARRAY-LEADER RUBOUT-HANDLER-BUFFER 1))
    (SETQ UNRCHF CH)))

(DEFMETHOD (COLD-LOAD-STREAM :LISTEN) ()
  (OR UNRCHF
      (if (mx-cold-load-p self)
	  (let ((got-a-char (clisten)))
	    (WHEN got-a-char
	      (SEND self :untyi (cget-char)) ;;; (LOGAND #xffdffff (cget-char)))) ;;; got-a-char)
	      (values t)))
	  (DO () ((NOT (KBD-HARDWARE-CHAR-AVAILABLE)) NIL)
	    (AND (SETQ UNRCHF (KBD-CONVERT-TO-SOFTWARE-CHAR (KBD-GET-HARDWARE-CHAR)))
		 (RETURN T))))))

(DEFMETHOD (COLD-LOAD-STREAM :ANY-TYI) (&OPTIONAL IGNORE)
  (FUNCALL SELF :TYI))

(DEFMETHOD (COLD-LOAD-STREAM :ANY-TYI-NO-HANG) ()
  (FUNCALL SELF :TYI-NO-HANG))


(DEFMETHOD (COLD-LOAD-STREAM :TYI) (&OPTIONAL IGNORE &AUX IDX)
  ;; 10/07/87 DNG - Fix to recognize ABORT key.  [SPR 6668]
  ;; 10/16/87 DNG - Add use of KEYPAD-ENABLE option.
  (declare (special eh:*reading-command* eh:*abort-object*))
  (LET-GLOBALLY ((sys:cold-load-stream-owns-keyboard t))
    (without-interrupts
      (COND ((NOT RUBOUT-HANDLER)
	     (IF UNRCHF
		 (PROG1 UNRCHF (SETQ UNRCHF NIL))
		 (DO-FOREVER
		   (LET ((CHAR
			   (IF (mx-cold-load-p self)
			       (PROGN (setf scrolled-lines 0)
				      (cold-load-stream-wait-for-char)
				      (cget-char))
			       (progn (COLD-LOAD-STREAM-WAIT-FOR-CHAR)
				      (KBD-CONVERT-TO-SOFTWARE-CHAR (KBD-GET-HARDWARE-CHAR))))))
		     (COND ((NULL CHAR))			;Unreal character
			   ((CHAR= CHAR #\BREAK) (BREAK "BREAK"))
			   ;; Horrible kludge to make the debugger usable in
			   ;; the cold-load stream.  How could this reasonably be done?
			   ((CHAR= CHAR #\ABORT) (IF EH:*READING-COMMAND* (RETURN CHAR)
						     (SIGNAL EH:*ABORT-OBJECT*)))
			   ((NOT KEYPAD-ENABLE)
			    (RETURN (%LOGDPB 0 %%KBD-KEYPAD CHAR)))
			   (T (RETURN CHAR)))))))
	    ((> (ARRAY-LEADER RUBOUT-HANDLER-BUFFER 0)
		(SETQ IDX (ARRAY-LEADER RUBOUT-HANDLER-BUFFER 1)))
	     (STORE-ARRAY-LEADER (1+ IDX) RUBOUT-HANDLER-BUFFER 1)
	     (AREF RUBOUT-HANDLER-BUFFER IDX))
	    (T
	     (COLD-LOAD-STREAM-RUBOUT-HANDLER))))))

(DEFMETHOD (COLD-LOAD-STREAM :TYI-NO-HANG) ()
  (AND (FUNCALL SELF :LISTEN)
       (FUNCALL SELF :TYI)))


(DEFVAR COLD-LOAD-STREAM-BLINKER-TIME 15.)

(DEFVAR COLD-LOAD-STREAM-WAIT-TIME-EXP1 1000.)
(DEFVAR COLD-LOAD-STREAM-WAIT-TIME-EXP2 8000.)
(DEFVAR COLD-LOAD-STREAM-WAIT-TIME-MX   6000.)

(DEFUN COLD-LOAD-STREAM-WAIT-FOR-CHAR ()
  (declare (:self-flavor cold-load-stream))
  ;; 10/15/87 DNG - Use SLEEP instead of (DOTIMES (I COLD-LOAD-STREAM-WAIT-TIME))
  ;;	    so that the cursor blinker looks like the normal one and so that
  ;;	    other processes are allowed to run.
  ;; 01/11/89 RJF - Changed so sleep is only used for MX kernel band.  Sleep will
  ;;        cause problems if we are in the cold-load-stream because the scheduler
  ;;        got an error.
  (DO ((PHASE NIL)
       (BLINKER-COUNT 0)
       (CURRENTLY-PREPARED-SHEET SELF))
      ((IF (mx-cold-load-p self)
	   (clisten)
	   (KBD-HARDWARE-CHAR-AVAILABLE))
       (AND PHASE
	    (IF (mx-cold-load-p self)
		(mx-cold-cursor 1)
		(%DRAW-RECTANGLE (TV:FONT-BLINKER-WIDTH FONT) (TV:FONT-BLINKER-HEIGHT FONT) CURSOR-X
			     CURSOR-Y TV:ALU-XOR SELF))))
    (COND ((MINUSP (SETQ BLINKER-COUNT (1- BLINKER-COUNT)))
	   (IF (mx-cold-load-p self)
	       (mx-cold-cursor 0)
	       (%DRAW-RECTANGLE (TV:FONT-BLINKER-WIDTH FONT) (TV:FONT-BLINKER-HEIGHT FONT) CURSOR-X
			    CURSOR-Y TV:ALU-XOR SELF))
	   (SETQ PHASE (NOT PHASE)
		 BLINKER-COUNT COLD-LOAD-STREAM-BLINKER-TIME)))
    (if (boundp 'tv:all-the-screens)
	(DOTIMES (I (select (processor-type) 
                       (:Explorer-II COLD-LOAD-STREAM-WAIT-TIME-EXP2 ) 
                       (:Explorer-I  COLD-LOAD-STREAM-WAIT-TIME-EXP1 ) 
                       (:micro-explorer  COLD-LOAD-STREAM-WAIT-TIME-MX)
                       (:otherwise  COLD-LOAD-STREAM-WAIT-TIME-EXP2)))) 
	(PROCESS-SLEEP 1 "Cold-Keyboard"))
    ))

(DEFVAR RUBOUT-HANDLER-OPTIONS NIL
  "Within rubout handler, the options supplied as first arg to
:RUBOUT-HANDLER operation.")

(DEFVAR COLD-LOAD-STREAM-ACTIVATION-CHARACTER)


;;; Give a single character, or do rubout processing, throws to RUBOUT-HANDLER on editing.
(DEFUN COLD-LOAD-STREAM-RUBOUT-HANDLER ()
  ;;  10/16/87 DNG - Added CTRL-C and META-C support.
  (declare (:self-flavor cold-load-stream))
  (WHEN (= (ARRAY-LEADER RUBOUT-HANDLER-BUFFER 1) #o7777777)
    (SETF (ARRAY-LEADER RUBOUT-HANDLER-BUFFER 1) 0)
    (THROW 'RUBOUT-HANDLER T))
  (IF COLD-LOAD-STREAM-ACTIVATION-CHARACTER
      (RETURN-FROM COLD-LOAD-STREAM-RUBOUT-HANDLER
	(PROG1 COLD-LOAD-STREAM-ACTIVATION-CHARACTER
	       (SETQ COLD-LOAD-STREAM-ACTIVATION-CHARACTER NIL))))
  (DO ((CH)
       (RUBBED-OUT-SOME)
       (LEN)
       (RUBOUT-HANDLER NIL)
       (PASS-THROUGH (CDR (ASSOC :PASS-THROUGH (THE LIST RUBOUT-HANDLER-OPTIONS) :TEST #'EQ)))
       (EDITING-COMMAND (CDR (ASSOC :EDITING-COMMAND (THE LIST RUBOUT-HANDLER-OPTIONS) :TEST #'EQ)))
       (DO-NOT-ECHO (CDR (ASSOC :DO-NOT-ECHO (THE LIST RUBOUT-HANDLER-OPTIONS) :TEST #'EQ)))
       (COMMAND-HANDLER	 (ASSOC :COMMAND (THE LIST RUBOUT-HANDLER-OPTIONS) :TEST #'EQ))
       (ACTIVATION-HANDLER (ASSOC :ACTIVATION (THE LIST RUBOUT-HANDLER-OPTIONS) :TEST #'EQ))
       (INITIAL-INPUT (CADR (ASSOC :INITIAL-INPUT (THE LIST RUBOUT-HANDLER-OPTIONS) :TEST #'EQ))))
      (NIL)
    (when initial-input
      (let ((length (length initial-input)))
	(funcall self :string-out initial-input)
	(if (< (array-length rubout-handler-buffer) length)
	    (setq rubout-handler-buffer (adjust-array rubout-handler-buffer (+ length length))))
	(copy-array-portion initial-input 0 length rubout-handler-buffer 0 length)
	(setf (fill-pointer rubout-handler-buffer ) length)
	(setq initial-input nil)
	;;gross kludge.
	(setq rubout-handler-options (remove-if-not #'(lambda (x) (eq (car x) :initial-input))
						 rubout-handler-options))
	(setq rubbed-out-some t)))
    (SETQ CH (FUNCALL SELF :TYI))
    (COND ((AND COMMAND-HANDLER
		(APPLY (CADR COMMAND-HANDLER) CH (CDDR COMMAND-HANDLER)))
	     (SETF (ARRAY-LEADER RUBOUT-HANDLER-BUFFER 1) 0)
	     (THROW 'TV:RETURN-FROM-RUBOUT-HANDLER
		     (VALUES
		       `(:COMMAND ,CH 1)
		       :COMMAND)))
	  ;; Don't touch this character, just return it to caller.
	  ((OR (MEMBER CH EDITING-COMMAND :TEST #'char=)
	       (ASSoc-CAREFUL CH EDITING-COMMAND))
	   ;; Cause rubout handler rescan next time the user does :TYI.
	   (IF RUBBED-OUT-SOME
	       (SETF (ARRAY-LEADER RUBOUT-HANDLER-BUFFER 1) #o7777777))
	   (RETURN CH))
	  ((AND (NOT (OR (MEMBER CH DO-NOT-ECHO :TEST #'char=)
			 (MEMBER CH PASS-THROUGH :TEST #'char=)
			 (AND ACTIVATION-HANDLER
			      (APPLY (CADR ACTIVATION-HANDLER) CH (CDDR ACTIVATION-HANDLER)))))
		(OR (LDB-TEST %%KBD-CONTROL-META CH)
		    (MEMBER CH '(#\RUBOUT #\CLEAR-INPUT #\CLEAR-SCREEN #\DELETE) :TEST #'char=)))
	   (COND
	     ((= CH #\CLEAR-INPUT)			;CLEAR flushes all buffered input
	      (STORE-ARRAY-LEADER 0 RUBOUT-HANDLER-BUFFER 0)
	      (SETQ RUBBED-OUT-SOME T)		;Will need to throw out
	      (FUNCALL SELF :TYO CH)		;Echo and advance to new line
	      (FUNCALL SELF :TYO #\CR))
	     ((OR (= CH #\FORM) (= CH #\VT))	;Retype buffered input
	      (FUNCALL SELF :TYO CH)		;Echo it
	      (IF (= CH #\FORM) (FUNCALL SELF :CLEAR-SCREEN) (FUNCALL SELF :TYO #\CR))
	      (LET ((PROMPT (CADR (OR (ASSOC :REPROMPT (THE LIST RUBOUT-HANDLER-OPTIONS) :TEST #'EQ)
				      (ASSOC :PROMPT (THE LIST RUBOUT-HANDLER-OPTIONS) :TEST #'EQ)))))
		(AND PROMPT
		     (IF (STRINGP PROMPT)
			 (PRINC PROMPT SELF)
		       (FUNCALL PROMPT SELF CH))))
	      (FUNCALL SELF :STRING-OUT RUBOUT-HANDLER-BUFFER))
	     ((= CH #\RUBOUT)
	      (COND ((NOT (ZEROP (SETQ LEN (ARRAY-LEADER RUBOUT-HANDLER-BUFFER 0))))
		     (SETQ CURSOR-X (MAX 0 (- CURSOR-X CHAR-WIDTH)))
		     (FUNCALL SELF :CLEAR-EOL)
		     (STORE-ARRAY-LEADER (SETQ LEN (1- LEN)) RUBOUT-HANDLER-BUFFER 0)
		     (SETQ RUBBED-OUT-SOME T)
		     (COND ((ZEROP LEN)
			    (STORE-ARRAY-LEADER 0 RUBOUT-HANDLER-BUFFER 1)
			    (THROW 'RUBOUT-HANDLER T))))))
	     ((OR (= CH #\CTRL-C) (= CH #\META-C)) ; yank last form typed
	      (LET ((START (FILL-POINTER RUBOUT-HANDLER-BUFFER))
		    (FORM +))
		(WHEN (= CH #\META-C) (SETQ FORM ++))
		(WHEN (AND (CONSP FORM)
			   (EQ (CAR FORM) 'SI:DISPLACED))
		  (SETQ FORM (SECOND FORM)))
		(FORMAT (THE STRING RUBOUT-HANDLER-BUFFER) "~S" FORM)
		(LET ((LAST (1- (FILL-POINTER RUBOUT-HANDLER-BUFFER))))
		  (WHEN (EQL (CHAR RUBOUT-HANDLER-BUFFER LAST) #\))
		    (SETF (FILL-POINTER RUBOUT-HANDLER-BUFFER) LAST)))
		(SEND SELF :STRING-OUT RUBOUT-HANDLER-BUFFER START)
		(SETF (ARRAY-LEADER RUBOUT-HANDLER-BUFFER 1) (1+ START))
		(RETURN (CHAR RUBOUT-HANDLER-BUFFER START)) ))
	     ((LDB-TEST %%KBD-CONTROL-META CH)
	      (KBD-CONVERT-BEEP)))
	   (COND ((AND (ZEROP (FILL-POINTER RUBOUT-HANDLER-BUFFER))
		       (ASSOC :FULL-RUBOUT (THE LIST RUBOUT-HANDLER-OPTIONS) :TEST #'EQ))
		  (SETF (ARRAY-LEADER RUBOUT-HANDLER-BUFFER 1) 0)
		  (THROW 'RUBOUT-HANDLER T))))
	  (T						;It's a self-inserting character
	   (COND ((MEMBER CH DO-NOT-ECHO :TEST #'char=)
		  (SETQ COLD-LOAD-STREAM-ACTIVATION-CHARACTER CH))
		 ((AND ACTIVATION-HANDLER
		       (APPLY (CADR ACTIVATION-HANDLER) CH (CDDR ACTIVATION-HANDLER)))
		  (SETQ CH `(:ACTIVATION ,CH 1))
		  (SETQ COLD-LOAD-STREAM-ACTIVATION-CHARACTER CH))
		 (T
		  (IF (LDB-TEST %%KBD-CONTROL-META CH)	;in :pass-through, but had bucky bits
		      (KBD-CONVERT-BEEP)
		    (FUNCALL SELF :TYO CH)
		    (VECTOR-PUSH-EXTEND CH RUBOUT-HANDLER-BUFFER))))
	   (COND ((AND (ATOM CH)
		       (LDB-TEST %%KBD-CONTROL-META CH)))	;do nothing
		 (RUBBED-OUT-SOME
		  (STORE-ARRAY-LEADER 0 RUBOUT-HANDLER-BUFFER 1)
		  (THROW 'RUBOUT-HANDLER T))
		 (T
		  (STORE-ARRAY-LEADER (ARRAY-LEADER RUBOUT-HANDLER-BUFFER 0)
				      RUBOUT-HANDLER-BUFFER 1)
		  (SETQ COLD-LOAD-STREAM-ACTIVATION-CHARACTER NIL)
		  (RETURN CH)))))))

(DEFMETHOD (COLD-LOAD-STREAM :RUBOUT-HANDLER)
		     (RUBOUT-HANDLER-OPTIONS FUNCTION &REST ARGS)
  (STORE-ARRAY-LEADER 0 RUBOUT-HANDLER-BUFFER 0)
  (STORE-ARRAY-LEADER 0 RUBOUT-HANDLER-BUFFER 1)
  (MULTIPLE-VALUE-BIND (PROMPT-STARTING-X PROMPT-STARTING-Y)
      (FUNCALL SELF :READ-CURSORPOS)
    (LET ((PROMPT (CADR (ASSOC :PROMPT (THE LIST RUBOUT-HANDLER-OPTIONS) :TEST #'EQ))))
      (AND PROMPT				;Prompt if desired
	   (IF (STRINGP PROMPT)
	       (PRINC PROMPT SELF)
	     (FUNCALL PROMPT SELF NIL))))
    (CATCH 'TV:RETURN-FROM-RUBOUT-HANDLER
      (DO ((RUBOUT-HANDLER T)			;Establish rubout handler
	   (INHIBIT-SCHEDULING-FLAG T)		;Make sure all chars come here
	   (COLD-LOAD-STREAM-ACTIVATION-CHARACTER NIL))
	  (NIL)
	(CATCH 'RUBOUT-HANDLER			;Throw here when rubbing out
	  (CONDITION-CASE (ERROR)
	      (RETURN (APPLY FUNCTION ARGS))	;Call read type function
	    (PARSE-ERROR
	     (TERPRI SELF)
	     (PRINC ">>ERROR: " SELF)
	     (SEND ERROR :REPORT SELF)
	     (TERPRI SELF)
	     (FUNCALL SELF :STRING-OUT RUBOUT-HANDLER-BUFFER)	;On error, retype buffered
	     (DO () (NIL) (FUNCALL SELF :TYI)))))		;and force user to edit it
	;;Maybe return when user rubs all the way back
	(AND (ZEROP (ARRAY-LEADER RUBOUT-HANDLER-BUFFER 0))
	     (LET ((FULL-RUBOUT-OPTION (ASSOC :FULL-RUBOUT (THE LIST RUBOUT-HANDLER-OPTIONS) :TEST #'EQ)))
	       (WHEN FULL-RUBOUT-OPTION
		 ;; Get rid of the prompt, if any.
		 (FUNCALL SELF :SET-CURSORPOS PROMPT-STARTING-X PROMPT-STARTING-Y)
		 (FUNCALL SELF :CLEAR-EOL)
		 (RETURN (VALUES NIL (CADR FULL-RUBOUT-OPTION))))))))))



(DEFMETHOD (COLD-LOAD-STREAM :CLEAR-INPUT) ()
  (SETQ UNRCHF NIL)
  (STORE-ARRAY-LEADER 0 RUBOUT-HANDLER-BUFFER 0)
  (STORE-ARRAY-LEADER 0 RUBOUT-HANDLER-BUFFER 1)
  (unless (mx-cold-load-p cold-load-stream)
    (DO () ((NOT (KBD-HARDWARE-CHAR-AVAILABLE)))
      ;;Call the convert routine for up-shifts too
      (KBD-CONVERT-TO-SOFTWARE-CHAR (KBD-GET-HARDWARE-CHAR)))))


;;AB for GRH 06/25/87. New, for CSIB.
;;; clm 11/03/88 - fixed for MX.  Conditionalized so that if SIB not
;;; present, do nothing but beep.
(DEFUN complement-screen (&optional fslot)
  "Complement the black & white screen whether running on the SIB or CSIB.
 This does nothing for color screens."
  (if (resource-present-p :SIB)
      (progn
	(unless fslot
	  (setf fslot tv:tv-slot-number))
	(COND ((POSITION (LDB 4 fslot) tv:*csib-slots*)  ;; CSIB
	       (si:%Nubus-Write
		 fslot
		 SI:%CSib-Tv-Video-Attribute
		 (LOGXOR (DPB -1 SI:%%CSib-Tv-Video-Black-On-White 0)
			 (si:%Nubus-Read fslot
					 SI:%CSib-Tv-Video-Attribute))))
	      ((POSITION (LDB 4 fslot) tv:*sib-slots*)   ;; SIB
	       (si:%Nubus-Write
		 fslot
		 SI:%Sib-Tv-Video-Attribute
		 (LOGXOR (DPB -1 SI:%%Sib-Tv-Video-Black-On-White 0)
			 (si:%Nubus-Read fslot
					 SI:%Sib-Tv-Video-Attribute))))
	      (t (BEEP))))
      (beep))
    )


;;AB for GRH 06/25/87. New, for CSIB.
(defun toggle-blank-color-screen ()
  "Toggle the color screen blanking bit on the CSIB, an alternative to 
 reverse video on the color screen.  If blank is non-nil screen is blanked,
 else screen blanking is cleared."
  (and (resource-present-p :SIB)
       tv:sib-is-csib		
       (si:%Nubus-Write
	 tv:tv-slot-number	
	 SI:%CSib-Tv-Video-Attribute
	 (Logxor (Dpb -1
		      SI:%%CSib-Tv-Video-blank-mask 0)
		 (si:%Nubus-Read tv:Tv-Slot-Number
				 SI:%CSib-Tv-Video-Attribute)))))

;;AB for GRH 06/25/87. New, for CSIB.
(defun screen-black-on-white-p ()
  "Returns t if screen displays ones bits as black, else nil.
 Works for B&W monitor on SIB or CSIB."
  (COND ((resource-present-p :SIB)
	  (if tv:sib-is-csib
	      ;; zerop because zero = white on our color map - GRH 8/5/88
	      (zerop (Logand (Dpb -1 %%CSIB-TV-video-black-on-white 0)
			    (si:%Nubus-Read tv:Tv-Slot-Number %CSib-Tv-Video-Attribute)))
	      (plusp (Logand (Dpb -1 %%SIB-TV-video-black-on-white 0)
			    (si:%Nubus-Read tv:Tv-Slot-Number %Sib-Tv-Video-Attribute)))))
	(t t)))

;;AB for GRH 06/25/87.  Changed for CSIB.
(defmethod (cold-load-stream :Beep) (&rest ignore)
  (if (mx-cold-load-p self)
      (let ((acb (add:get-acb 2 t))
	    (ch  (add:find-channel cold-load-stream-channel)))
	(unwind-protect
	    (progn
	      (add:init-acb acb
			    si:%MC-tvcalls
			    si:%TC-Beep)
						; Execute
	      (add:transmit-packet-and-wait acb ch)
	      (add:check-error acb))
	  (setf (add:requestor-complete acb) t)
	  (add:return-acb-fast acb)))
      (progn
	(complement-screen)
	(toggle-blank-color-screen)
	(dotimes (i 500.) nil)
	(complement-screen)
	(dotimes (i 10000.) nil) ; wait a little longer.
	(toggle-blank-color-screen))))


(compile-flavor-methods cold-load-stream)

;;AB 6/25/87. Change this to use new var *BW-TV-IO-SPACE-VIRTUAL-ADDRESS*
(DEFPARAMETER COLD-LOAD-STREAM-INIT-PLIST
  `(nil
     :WIDTH 1024.
     :HEIGHT 808.
     :BUFFER ,*BW-TV-IO-SPACE-VIRTUAL-ADDRESS*
     ))

(DEFPARAMETER COLD-LOAD-STREAM-INIT-PLIST-MX
  `(nil
     :WIDTH 608.				;***TEMP
     :HEIGHT 424.
     :CHAR-WIDTH 6.
     :CHAR-HEIGHT 11.
     :MX t
     )) 

;;AB 6/25/87. Execute this when making the color system.  For GRH.
(DEFMETHOD (COLD-LOAD-STREAM :convert-to-color) ()
  (SETQ buffer *IO-SPACE-VIRTUAL-ADDRESS*
        ARRAY (MAKE-ARRAY (LIST HEIGHT WIDTH) :TYPE ART-8B :DISPLACED-TO BUFFER)))

(DEFMETHOD (COLD-LOAD-STREAM :INSIDE-WIDTH) () WIDTH)
(DEFMETHOD (COLD-LOAD-STREAM :INSIDE-HEIGHT) () HEIGHT)

(DEFUN get-exp-cold-load ()
  (FIRST all-cold-loads))

(DEFUN get-mx-cold-load ()
  (SECOND all-cold-loads))

(DEFUN install-exp-cold-load ()
  (SETQ cold-load-stream (get-exp-cold-load)))

(DEFUN install-mx-cold-load ()
  ;; Add width, height, etc to plist
  
  (let ((ch  (add:find-channel cold-load-stream-channel))
	(acb (add:get-acb 16. t)))
    (unwind-protect
	(progn
	  (add:init-acb acb
			si:%MC-tvcalls
			si:%TC-SCREEN-INFO)
	  (add:transmit-packet-and-wait acb ch)
	  
	  (LOOP for x from 0 to 3
		for (a b) on (REST COLD-LOAD-STREAM-INIT-PLIST-MX) by #'CDDR	
		do (SETF (GET COLD-LOAD-STREAM-INIT-PLIST-MX a) (add:parm-32b acb x)))
	  
	  (add:check-error acb))
      (setf (add:requestor-complete acb) t)
      (add:return-acb-fast acb))
    
    (prog1 (SETQ cold-load-stream (get-mx-cold-load))
	   (SEND cold-load-stream :INIT COLD-LOAD-STREAM-INIT-PLIST-MX)
	   (SEND cold-load-stream :clear-screen))))


(DEFUN initialize-cold-loads ()
  (LET ((cl))
    (SETQ all-cold-loads (LIST :exp :mx)
	  cold-load-stream nil)
    
    ;; Make regular Cold-Load-Stream
    (SETQ cl (%MAKE-INSTANCE 'COLD-LOAD-STREAM))
    (FUNCALL cl :INIT COLD-LOAD-STREAM-INIT-PLIST)
    (SETF (FIRST all-cold-loads) cl)

    ;; Make cold-load For MX
    (SETQ cl (%MAKE-INSTANCE 'COLD-LOAD-STREAM))
    (SETF (SECOND all-cold-loads) cl)
    
    (COND ((AND (addin-p) (fboundp 'micronet-channel-boot-initialize))
	   (SETQ cold-load-stream (get-mx-cold-load)))
	  (t
	   (SETQ cold-load-stream (get-exp-cold-load))))
    
    ;;Avoid lossage when processes are in use but window system is not loaded yet.
    (OR (FBOUNDP 'TV:BACKGROUND-STREAM)
	(FSET 'TV:BACKGROUND-STREAM COLD-LOAD-STREAM))
    
    ))

#|
(defun start-mx-listener () ;Temporary function for testing -- D.N.G. 1/19/88
  "Initiate a primitive Lisp Listener using the MX debug window."
  (process-run-function "simple listener"
			#'(lambda ()
				 (LET* ((STREAM (get-mx-cold-load))
					(cold-load-stream stream)
					(TV:DEFAULT-BACKGROUND-STREAM stream))
				   (lisp-top-level1 stream)
				   (VALUES))))
  )
|#
 
(PROGN (initialize-cold-loads)
       ;;ab 2/15/88.  Don't call (install-mx-cold-load) from the Crash-List in the cold band.
       ;;             Only do this when loading file in full-up environment.
       (WHEN (NOT (VARIABLE-BOUNDP si:lisp-crash-list))
	 (COND ((AND (addin-p) (find-system-named 'micronet-comm t t))
		(install-mx-cold-load))
	       (t
		(install-exp-cold-load)))))