;;; -*- Mode:LISP; Package:MAC; Readtable:T; Base:10 -*-
;;;
;;; By Renaud Nadeau novembre 1988
;;;

;;;
;;; screen management
;;;



;;; ascii stream

(defflavor ascii-stream
	()
	(si:output-stream))


(defmethod (ascii-stream :tyo) (char)
  (let* ((struct (cold-stream Header-Table))
	 (input-ptr  (kbd-buffer-input  struct))
	 (output-ptr (kbd-buffer-output struct))
	 (start-ptr  (kbd-buffer-start  struct))
	 (end-ptr    (kbd-buffer-end    struct)))
    (when (not (or (equal input-ptr (1+ output-ptr))
		 (and (equal output-ptr end-ptr)
		      (equal start-ptr input-ptr))))
	(setf (kbd-entry-type-modifiers  output-ptr) 0)
	(setf (kbd-entry-char-or-mouse  output-ptr) char)
	(incf output-ptr 8)
	(setf (kbd-buffer-output struct)
	      (if (= output-ptr end-ptr) start-ptr output-ptr)))))



(defmethod (ascii-stream :string-out) (string &optional (start 0) end)
  (or end (setq end (1- (string-length string))))
  (let* ((struct (cold-stream Header-Table))
	 (input-ptr  (kbd-buffer-input  struct))
	 (output-ptr (kbd-buffer-output struct))
	 (start-ptr  (kbd-buffer-start  struct))
	 (end-ptr    (kbd-buffer-end    struct)))
    (loop for i from start to end do
	      (when (not (or (equal input-ptr (1+ output-ptr))
		 (and (equal output-ptr end-ptr)
		      (equal start-ptr input-ptr))))
	(setf (kbd-entry-type-modifiers  output-ptr) 0)
	(setf (kbd-entry-char-or-mouse  output-ptr) (aref string i))
	(incf output-ptr 8)
	(setf (kbd-buffer-output struct)
	      (if (= output-ptr end-ptr) start-ptr output-ptr))))))



(defun send-ascii-stream (string start end)
    (with-idle-state-secured
      (setf (Command-command struct)  CMD-PRINT)
      (setf (command-arg-count struct)1)
      (setf (Command-val-count struct)0)
      (setf (Command-err-code struct) 0)
      (setf (Command-err-string struct) 0)
      (setf (Command-stream struct) 0)
      (setf (command-args struct) (dpb ISA-STRING (byte 8 24.) *command-struct-var-size*))
      (write-BC-mac-string  (+ struct  *command-struct-var-size*) string (- end start))))