;;; -*- 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;; Printer stuff for the Anadex DP9000 series printers*

(def-tiger-props :anadex
		 tiger-stream-flavor anadex-stream
		 default-x-scale 1
		 default-y-scale 1
		 tiger-font-type anadex-font
		 tiger-serial-handshake-type :software)

(defvar anadex-simulation-table (make-array 256.)
  "The table used to decide how to simulate characters for the Anadex printer.
The Anadex does not handle formfeed sensibly, so we send it a :NEW-PAGE message instead.")

(stuff-array anadex-simulation-table
  nil
  (t (#\Center-Dot #\Space))
  (t #\Integral)
  (:discard (#\Null 400))
  ((ascii-code #\Linefeed) #\Line)
  ((ascii-code #\Tab) #\Tab)
  (:new-page #\Form)
  ((list (ascii-code #\Return) (ascii-code #\Linefeed)) #\Return))

(defstruct (anadex-font :conc-name
		       (:type :named-array-leader) 
		       (:make-array (:leader-length 3 :dimensions 128.)))
  :name)

(defflavor anadex-stream ((horizontal-position 0)
			   (graphics-mode-p nil)
			   (whitespace-threshold 128.))
	   (basic-printer-stream-mixin)
  (:default-init-plist :name :anadex
		       :font 0
		       :dots-per-line 6
		       :discard-font-changes t
		       :process-font-changes nil
		       :simulation-mode :control))

(defmethod (anadex-stream :set-lines-per-inch) (lpi)
  (if (symbolp lpi) (setq lpi 6.))
  (cond ((eq (round lpi) 8.)
	 (setq lines-per-inch 8.)
	 (escape-sequence (ascii-code #/I)))
	(t (setq lines-per-inch 6.)
	   (escape-sequence (ascii-code #/H)))))

(defmethod (anadex-stream :set-characters-per-inch) (cpi)
  ;1; Note -- this is correct for models DP9000 and DP9500*
  ;1; The commented out version below is for models DP9001 and DP9501*
  (selectq (or (symbolp cpi) (round cpi))
    (send destination :tyo (ascii-code :can))
    ((13. 14.)
     (setq characters-per-inch 13.3s0)
     (send destination :tyo (ascii-code :sub)))
    (12.
     (setq characters-per-inch 12.)
     (send destination :tyo (ascii-code :dc4)))
    (t (setq characters-per-inch 10.)
       (send destination :tyo (ascii-code :dc2)))))

;(defmethod (anadex-stream :set-characters-per-inch) (cpi)
;  ;1; Note -- this is correct for models DP9001 and DP9501*
;  ;1; The uncommented out version above is for models DP9000 and DP9500*
;  (selectq (round cpi)
;    ((12. 13.)
;     (setq characters-per-inch 12.5s0)
;     (send destination :tyo (ascii-code :sub)))
;    ((16. 17.)
;     (setq characters-per-inch 16.7s0)
;     (send destination :tyo (ascii-code :dc4)))
;    (15.
;     (setq characters-per-inch 15.)
;     (send destination :tyo (ascii-code :em)))
;    (t (setq characters-per-inch 10.)
;       (send destination :tyo (ascii-code :dc2)))))

(defmethod (anadex-stream :set-tab-stops) (&optional (n-columns 8.))
  (loop for n-stops from 1 to 8
	for column from (1+ n-columns) by n-columns
	do (escape-sequence (ascii-code #/3))
	   (format destination "~3,VD" (ascii-code #/0) column)))

(defmethod (anadex-stream :setup-normal) ()
  (send destination :tyo (ascii-code :gs))
  (send destination :tyo (ascii-code :can))
  (escape-sequence (ascii-code #/H))
  (send self :set-tab-stops))

(defmethod (anadex-stream :set-elongated-printing) (&optional (elongated-p t))
  (send destination :tyo (if elongated-p (ascii-code :so) (ascii-code :si))))

(defmethod (anadex-stream :before :tyo) (char)
  (if (= char #\form)
      (dotimes (n (- 66. line-number))
	(send destination :tyo (ascii-code #\line)))))

(defmethod (anadex-stream :set-up-for-graphics) (ignore)
  (send destination :tyo (ascii-code :ETB))			;1Close any printing records we left open*
  (send destination :tyo (ascii-code :FS)))			;1Enter Graphics mode*

(defmethod (anadex-stream :dots-per-line) ()
  6.)

(defmethod (anadex-stream :x-scale) ()
  1)

(defmethod (anadex-stream :y-scale) ()
  1)

(defmethod (anadex-stream :position-horizontal) (x)
  (if (> (- x horizontal-position) 100.)
      (progn
	(if ( x 790.)
	    (format destination "0;~3,48D" (+ 1 x)))
	(setq horizontal-position x))
    (dotimes (n (- x horizontal-position))
      (send self :print-bit-graphics 0))))

(defmethod (anadex-stream :print-bit-graphics) (char)
  (if ( horizontal-position 790.)
      (send destination :tyo (+ char 192.)))
  (setq horizontal-position  (+ horizontal-position  1)))

(defmethod (anadex-stream :new-graphics-line) ()
  (send destination :tyo #/6)
  (setq horizontal-position 0))

(compile-flavor-methods anadex-stream)

(defmethod (anadex-stream :test-graphics) ()
  (send self :set-up-for-graphics nil)
  (dotimes (m 7.)
    (dotimes (n 3)
      (send self :position-horizontal (* n 200.))
      (dotimes (x 100.)
	(send self :print-bit-graphics 127.)))
    (send self :new-graphics-line)))

(defun anadex-test ()
  (send (get :anadex 'tiger-stream) :test-graphics))