;;; -*- Mode:LISP; Package:SI; Base:8 -*-
;	** (c) Copyright 1980 Massachusetts Institute of Technology **

;;; This file contains a stream to write to a debug port.
;;; 
;;; derived from WINDOW>COLD

(DEFINSTANCE-IMMEDIATE DEBUG-STREAM
  CURSOR-X					;Current x position
  CURSOR-Y					;Current y position
  TV:CONTROL-ADDRESS				;Hardware controller address
  UNRCHF					;For :UNTYI
  )

(DEFMETHOD-IMMEDIATE (DEBUG-STREAM :PRINT-SELF) (STREAM &REST IGNORE)
  (FORMAT STREAM "#<~A ~O>" (TYPEP SELF) (%POINTER SELF)))

(DEFMETHOD-IMMEDIATE (DEBUG-STREAM :INIT) (PLIST)
  (SETQ CURSOR-X 0 CURSOR-Y 0
	UNRCHF NIL
	TV:CONTROL-ADDRESS (GET PLIST ':CONTROL-ADDRESS)))

;(DEFMETHOD-IMMEDIATE (DEBUG-STREAM :READ-CURSORPOS) (&OPTIONAL (UNITS ':PIXEL)
;					       &AUX (X CURSOR-X) (Y CURSOR-Y))
;  (AND (EQ UNITS ':CHARACTER)
;       (SETQ X (// X CHAR-WIDTH)
;	     Y (// Y LINE-HEIGHT)))
;  (PROG () (RETURN X Y)))

(DEFMETHOD-IMMEDIATE (DEBUG-STREAM :SET-CURSORPOS) (X Y)
  (SETQ CURSOR-X X CURSOR-Y Y))

(DEFMETHOD-IMMEDIATE (DEBUG-STREAM :HOME-CURSOR) ()
  (SETQ CURSOR-X 0 CURSOR-Y 0))

(DEFMETHOD-IMMEDIATE (DEBUG-STREAM :HANDLE-EXCEPTIONS) ())

(DEFMETHOD-IMMEDIATE (DEBUG-STREAM :TYO) (CH)
  (COND ((< CH 200)
	 (%XBUS-WRITE 377000 CH))
;	((= CH #\TAB)
;	   (DOTIMES (I (- 8 (\ (// CURSOR-X CHAR-WIDTH) 8)))
;	     (FUNCALL-SELF ':TYO #\SP)))
	((= CH #\CR)
	 (%XBUS-WRITE 377000 12)
	 (FUNCALL-SELF ':CLEAR-EOL)))
  CH)

(DEFMETHOD-IMMEDIATE (DEBUG-STREAM :CLEAR-EOL) ())

(DEFMETHOD-IMMEDIATE (DEBUG-STREAM :CLEAR-SCREEN) ()
  (SETQ CURSOR-X 0 CURSOR-Y 0))

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

(DEFMETHOD-IMMEDIATE (DEBUG-STREAM :STRING-OUT) (STRING &OPTIONAL (START 0) END)
  (DO ((I START (1+ I))
       (END (OR END (ARRAY-ACTIVE-LENGTH STRING))))
      (( I END))
    (FUNCALL-SELF ':TYO (AREF STRING I))))

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

;(DEFMETHOD-IMMEDIATE (DEBUG-STREAM :UNTYI) (CH)
;  (SETQ UNRCHF CH))

;(DEFMETHOD-IMMEDIATE (DEBUG-STREAM :LISTEN) ()
;  (OR UNRCHF
;      (DO () ((NOT (KBD-HARDWARE-CHAR-AVAILABLE)) NIL)
;	(AND (SETQ UNRCHF (KBD-CONVERT-TO-SOFTWARE-CHAR (KBD-GET-HARDWARE-CHAR)))
;	     (RETURN T)))))

;(DEFMETHOD-IMMEDIATE (DEBUG-STREAM :TYI) (&AUX IDX (INHIBIT-SCHEDULING-FLAG T))
;  (COND (UNRCHF
;	 (PROG1 UNRCHF (SETQ UNRCHF NIL)))
;	((NOT RUBOUT-HANDLER)
;	 (DO () (())
;	   (LET ((CHAR (KBD-CONVERT-TO-SOFTWARE-CHAR (KBD-GET-HARDWARE-CHAR))))
;	     (SELECTQ CHAR
;	       (NIL)				;Unreal character
;	       (#\BREAK (BREAK T))
;	       (OTHERWISE (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
;	 (DEBUG-STREAM-RUBOUT-HANDLER))))

;(DEFMETHOD-IMMEDIATE (DEBUG-STREAM :TYI-NO-HANG) ()
;  (AND (FUNCALL-SELF ':LISTEN)
;       (FUNCALL-SELF ':TYI)))

(DECLARE-INSTANCE-IMMEDIATE-INSTANCE-VARIABLES (DEBUG-STREAM))



(MAKE-INSTANCE-IMMEDIATE DEBUG-STREAM
			 :CONTROL-ADDRESS 377000)