;;;-*- Mode:LISP; Package:TIGER; Base:8; Fonts:(CPTFONT TR12I); Readtable:T -*-

; Copyright LISP Machine, Inc. 1984
;   See filename "Copyright" for
; licensing and release information.

1;;; Methods for the printer types ARRAY-DISK and ARRAY-TAPE
;;; ARRAY-DISK sends the array file to the TIGER-QUEUE; directory on the machine specified.
;;;     if the spool-p argument is non NIL then a queue entry is created.
;;;
;;; ARRAY-TAPE spools the array file to magtape.  No queue entry is created.*

;;; Note: these are not using the usual tiger hardcopy interface properties.

(def-tiger-props :array-disk
		 si:print-file nil
		 si:print-bit-array array-to-disk-interface
		 si:print-stream nil
		 array-device-p t
		 array-dump-function dump-pixel-array-to-file
		 default-tiger-host-eval si:associated-machine)

(def-tiger-props :array-tape
		 si:print-file nil
		 si:print-bit-array array-to-tape-interface
		 si:print-stream nil
		 array-device-p t
		 array-dump-function dump-pixel-array-to-tape
		 default-tiger-host-eval (find-suitable-array-tape-host))


(defun find-suitable-array-tape-host ()
  ;; our MAKE-MT-FILE-STREAM doesnt support a :HOST option for remote hosts,
  ;; that is, we can only return the value of si:local-host.
  ;; We could get fancy and make sure there is a magtape allocatable on this
  ;; machine, but we might as well let the error happen later if there is
  ;; no such device.
  si:local-host)

;1;; Actually, there aren't any methods here.  This is because *BITBLT-TO-STREAM1 and relatives are never*
;1;; used to these devices.  The properties above, and the functions below which are listed in those properties,*
;1;; are the only important things about these printer types.*

(defvar last-tape-file-version 0)

(defun array-to-file-interface (printer array left top right bottom &rest options)
  (multiple-value-bind (tiger-type tiger-host)
      (figure-out-printer-type-and-host printer)
    tiger-type
    (let ((filename (send (make-tiger-queue-directory-filename tiger-host
							       "TEMP"
							       "ARAY")
			  :string-for-printing)))
      (dump-pixel-array-to-file filename array left top right bottom)
      (push-tiger-queue-entry
	(make-tiger-queue-entry :type :aray-file
				:options (append (copylist options) '(:delete-after t)))))))

(defun array-to-tape-interface (printer array left top right bottom &rest options)
  options					;1Not used*
  (multiple-value-bind (tiger-type tiger-host)
      (figure-out-printer-type-and-host printer)
    tiger-type
    (let ((filename
	    (send (make-tiger-queue-directory-filename
		    tiger-host
		    (string-append
		      "t-"
		      (format nil "~4,VD" #/0 (incf last-tape-file-version)))
		    "aray")
		  :string-for-printing)))
      (dump-pixel-array-to-tape filename array left top right bottom))))

(defun print-array-tape ()
  (condition-case ()
      (do-forever
	(wait-for-tiger-array)
	(multiple-value-bind (array left top right bottom)
	    (restore-pixel-array-from-tape tiger-temporary-bit-array)
	  (tiger-array array :left left :top top :right right :bottom bottom)))
    (fs:end-of-tape t))
  (setq tiger-array-free t))