;;; -*- 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;; New ascii (serial now, but maybe not someday) printer software.*
;1;; This stuff attempts to be more general than the old stuff so it will work with various printer types.*
;1;;*
;1;; The way it works is that each printer type has a *PRINTER-STREAM1 defined for it.  This has methods*
;1;; which do the special things for the printer.  The rest of the server isn't supposed to know anything*
;1;; about specific printers.*
;1;;*
;1;; The streams are all based on *BASIC-PRINTER-STREAM-MIXIN1.  The stream has a *DESTINATION1 associated*
;1;; with it.  This is a stream which performs the actual I/O.  The *PRINTER-STREAM1 acts like a *filter1 --*
;1;; characters pass through it and get transformed on the way.*
;1;;*
;1;; Methods of the stream actually perform I/O by sending appropriate messages to *DESTINATION1.  These*
;1;; can be *:TYO1, *:STRING-OUT1, etc.*
;1;;*
;1;; *DESTINATION1 must be some appropriate sort of stream.  For serial printers, it should be *SI:SERIAL-STREAM
;1;; or one of its relatives.*

(defflavor basic-printer-stream-mixin
	   (name
	    (destination nil)
	    (discard-font-changes t)
	    (process-font-changes nil)
	    (discard-next-character nil)
	    (font-change-on-next-character nil)
	    (font-history (make-array 64. :fill-pointer 0))
	    (graphics-font-p nil)
	    (simulate-lispm-characters t)
	    (simulation-mode :control)
	    (character-simulation-table default-simulation-table)
	    (vertical-position-change-alist default-vertical-position-change-alist)
	    (characters-per-inch 10.)
	    (lines-per-inch 6.)
	    (elongated-characters nil)
	    (new-line-p nil)
	    (tab-stops 8.)
	    (form-length 11.)
	    (font nil)
	    (font-list nil)
	    (lines-per-page 60.)
	    (page-headings t)
	    (heading-line "")
	    (line-number 0)
	    (page-number 1)
	    dots-per-line
	    (x-scale 1) 
	    (y-scale 1))
	   (si:line-output-stream-mixin si:output-stream)
;  (:documentation :essential-mixin "The basis of all printer streams.
;This handles form-length hacking, simulation of Lisp Machine characters, etc.
;The actual stream for the printer type must provide methods for some things.")
  :initable-instance-variables
  :gettable-instance-variables
  :settable-instance-variables
  :abstract-flavor)

(defmacro escape-sequence (&rest characters)
  `(progn (send destination :tyo (ascii-code :Escape))
 	  ,@(loop for char in characters
		  collect `(send destination :tyo ,char))))

(defmacro escape-format (string &rest args)
  `(progn (send destination :tyo (ascii-code :Escape))
	  (format destination ,string ,@args)))


;1;; To handle translation of Lisp Machine characters into a form which the printer can handle,*
;1;; we use this *:TYO1 method.  This will work regardless of what the base type of*
;1;; stream the printer-stream is built on may be (serial, parallel, file, whatever).*
;1;;*
;1;; The following options are available for changing output:*
;1;; 1.  *DISCARD-FONT-CHANGES1 can be set to *T1.  If so, any sequence *#/Epsilon-X1 is thrown away*
;1;;*	1(not printed).*
;1;; 2.  Lisp machine characters not in the printer character set can be simulated.  Characters will*
;1;;*	1only be simulated if *SIMULATE-LISPM-CHARACTERS1 is not *NIL1.*
;1;;*	1The type of simulation performed is under the control of the *CHARACTER-SIMULATION-TABLE1.*
;1;;*	1Each character in the character set should have an entry in this table telling what to do with it.*
;1;;*	1The following values are possible:*
;1;;*	NIL		1Print this character normally.*
;1;;*	T		1Simulate this character according to *SIMULATION-MODE1.  This may have as*
;1;;*			1its value any of the symbols allowed in the *CHARACTER-SIMULATION-TABLE1.*
;1;;*			1It may not contain a list or a fixnum.*
;1;;*	:CONTROL	1Print this character as *^X1.*
;1;;*	:SIMULATE-WITH-GRAPHICS
;1;;*			1Use graphics mode to print this character.  The *PRINTER-STREAM1 must supply*
;1;;*			1a *:SIMULATE-WITH-GRAPHICS1 method for this to work.*
;1;;*	:DISCARD	1Throw this character away completely; don't print anything.*
;1;;*	:LOZENGE
;1;;*			1Print the Lisp Machine name of the character inside a lozenge (as is done on*
;1;;*			1the Lisp Machine display).  The *PRINTER-STREAM1 must supply a*
;1;;*			:SIMULATE-WITH-LOZENGE1 method for this to work.*
;1;;*	1a symbol*		1Send that message to the stream, with the character as argument.*
;1;;*			1(The method may use or ignore the argument as appropriate.)*
;1;;*	1a fixnum*	1Output the character specified by the number literally.*
;1;;*	1a list*		1Output each of the characters in the list literally (without translation by*
;1;;*			1this method).*

(defmethod (basic-printer-stream-mixin :tyo) (char)
  (cond (discard-next-character (setq discard-next-character nil))
	(font-change-on-next-character
	 (cond ((eq char #/*)
		(send self :pop-font))
	       (t (send self :set-font char)))
	 (setq font-change-on-next-character nil))
	((and (eq char #\Epsilon) process-font-changes)
	 (setq font-change-on-next-character t))
	((and (eq char #\Epsilon) discard-font-changes)
	 (setq discard-next-character t))
	;1; Note that if neither *DISCARD-FONT-CHANGES1 or *PROCESS-FONT-CHANGES1 is on,*
	;1; the *Epsilon1 character will fall through and be output normally.*
	;1; Also note that *PROCESS-FONT-CHANGES1 overrides *DISCARD-FONT-CHANGES1.*
	((not simulate-lispm-characters)
	 (send destination :tyo char))
	((or (minusp char) ( char (array-active-length character-simulation-table)))
	 (ferror nil "The character ~C cannot be handled by the printer." char))
	(t (let ((char-translation (aref character-simulation-table char)))
	     (cond ((consp char-translation)
		    (dolist (lchar char-translation)
		      (send destination :tyo lchar)))
		   ((fixnump char-translation)
		    (send destination :tyo char-translation))
		   (t
		    (cond
		      ((eq char-translation nil)
		       (send destination :tyo char))
		      (t
		       (condition-case (c)
			   (selectq char-translation
			     ((t) (send self simulation-mode char))
			     (t (send self char-translation char)))
			 (error
			  (format
			    error-output
			    "~&Trouble printing character: ~A ...~&"
			    (if (fixnump char)
				(format nil "~:@C" char)
			      (format nil "~A (unrecognized character format)" char)))
			  (send c ':report error-output)
			  (format error-output "~&... will now continue to print."))))))))))
  (let ((vertical-position-change (cdr (assq char vertical-position-change-alist))))
    (cond ((eq vertical-position-change :new-page)
	   (setq line-number 0)
	   (when page-headings (send self :print-heading)))
	  ((fixnump vertical-position-change)
	   (incf line-number vertical-position-change)
	   (when ( line-number lines-per-page)
	     (send self :tyo #\Form))))))

(defmethod (basic-printer-stream-mixin :control) (char)
  (send destination :tyo (ascii-code #/^))
  (send destination :tyo (+ char (ascii-code #/@))))

(defmethod (basic-printer-stream-mixin :graphics-maybe) (char)
  (if graphics-font-p
      (send self :simulate-with-graphics char font)
    (send destination :tyo char)))

(defmethod (basic-printer-stream-mixin :discard) (&rest ignore) nil)

(defvar default-simulation-table (make-array 256.)
  "The usual table to use to decide how to simulate Lisp Machine characters on the printer.
A given printer type might need to define its own table because of limited capabilities.
Also, a user might want to change the table because he doesn't like the defaults.")

(stuff-array default-simulation-table
  nil
  (t (#\Center-Dot #\Space))
  (t #\Integral)
  (:discard (#\Null 400))
  ((ascii-code #\line) #\Line)
  ((ascii-code #\tab) #\Tab)
  ((ascii-code #\form) #\Form)
  ((list (ascii-code #\return) (ascii-code #\line)) #\Return))

(defvar all-simulation-table (make-array 256.)
  "A table to use if you want all characters to be printed in graphics mode.")

(stuff-array all-simulation-table
  nil
  (t (#\Space #\Integral))
  (t (#\Center-Dot #\Space))
  (t #\Integral)
  (:discard (#\Null 400))
  ((ascii-code #\line) #\Line)
  ((ascii-code #\tab) #\Tab)
  ((ascii-code #\form) #\Form)
  ((list (ascii-code #\return) (ascii-code #\line)) #\Return))

(defvar default-vertical-position-change-alist
	`((,(ascii-code #\return) . 1)
	  (,(ascii-code #\line) . 1)
	  (,(ascii-code #\form) . :new-page)
	  (#\Return . 1)
	  (#\Line . 1)
	  (#\Form . :new-page))
  "The usual table to use to determine how much vertical movement a character causes.")

(defmethod (basic-printer-stream-mixin :before :set-destination) (new-destination)
  new-destination
  (when destination (send destination :force-output)))

(defmethod (basic-printer-stream-mixin :force-output) ()
  (send destination :force-output))

(defmethod (basic-printer-stream-mixin :close) (&optional (abort-p nil))
  (send destination :close abort-p))

(defmethod (basic-printer-stream-mixin :before :setup-normal) ()
  (setf (fill-pointer font-history) 0))

(defmethod (basic-printer-stream-mixin :before :set-font) (&optional (new-font 0)
								     (literal-p nil)
								     (push-p t))
  new-font
  literal-p
  (when push-p (array-push-extend font-history font)))

(defmethod (basic-printer-stream-mixin :set-font) (&rest ignore) nil)

(defmethod (basic-printer-stream-mixin :pop-font) ()
  (send self :set-font (array-pop font-history) t nil))

(defmethod (basic-printer-stream-mixin :print-heading) ()
  (send self :set-font)
  (send self :send-if-handles :set-elongated-printing t)
  (format self "Page ~D	   " page-number)
  (incf page-number)
  (send self :line-out heading-line)
  (send self :send-if-handles :set-elongated-printing nil)
  (send self :pop-font)
  (send self :line-out "")
  (send self :line-out ""))

;1;; Array (bit map) printing stuff.*
;1;;*
;1;; The way this works is that the *PRINTER-STREAM1 provides a method for *:DOTS-PER-LINE1.*
;1;; The function *PRINT-BIT-ARRAY1 figures out how to unpack the*
;1;; bit array based on these numbers, and sends a *:PRINT-BIT-GRAPHICS1 message to the stream.*
;1;; The argument to the method is a character representing one row of dots for the printer.*
;1;; The *:PRINT-BIT-GRAPHICS1 method must unpack this into multiple characters if necessary.*
;1;;*
;1;; It is also possible for the *PRINTER-STREAM1 to specify scaling.  This is specified by the values of*
;1;; instance variables *X-SCALE1 and *Y-SCALE1.  These can be any positive fixnum.  Each array pixel will*
;1;; be turned into that number of pixels before being sent to the *PRINTER-STREAM1.*
;1;;*
;1;; The characters contain the dots to be printed in the low-order bits, with the highest bit in the*
;1;; highest-order bit position.*
;1;;*
;1;; *PRINTER:PRINT-BIT-ARRAY1 will also use a method for *:POSITION-HORIZONTAL-ABSOLUTE1.*
;1;; The argument is a horizontal position, expressed in pixels.  This will be done to skip*
;1;; over white space.*
;1;;*
;1;; There are no methods actually here.  That is because the printer type itself must provide them all.