;;;-*- Mode:LISP; Package:TIGER; Base:10; READTABLE:CL -*-

;;; Copyright Lisp Machine, Inc. 1985
;;;   See filename "COPYRIGHT.TEXT" for
;;; licensing and release information.


;;; minimal support for LMI Laser I. one could do a lot better than this.
;;; 2/19/85 09:35:20 -George Carrette
;;; Note: We are in Common-Lisp mode and are using rational numbers and floor/ceiling
;;;       arithmetic.

;;; How:
;;; * support font shifts in text mode.
;;; * support :BITBLT message in graphics mode. Use 2^8 element table to
;;;           do byte-reverse. Use copy-array-portion into byte-hacking 1-D workspace
;;;           then microcompiled utility functions.

(def-tiger-props :laser1
		 tiger-stream-flavor laser1-stream
		 TIGER-SERIAL-HANDSHAKE-TYPE :software
		 tiger-font-type vanilla-font
		 font-directory nil
		 default-x-scale 1
		 default-y-scale 1
		 )

(defvar laser1-simulation-table (make-array 256))

(defvar *laser1-orientation* :PORTRAIT
  "Determine orientation of LASER1 printer, should be
  :LANDSCAPE or :PORTRAIT")

(define-site-variable *laser1-orientation* :laser1-orientation
  "Determine orientation of LASER1 printer, should be
  :LANDSCAPE or :PORTRAIT")

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

(defflavor laser1-stream
	   ((raster-character-buffer (make-array (round (* 300 8.5) 7)
						 ;; big enough for maximum resolution
						 ;; and 8.5 inch width paper.
						 :element-type 'string-char))
	    (buffer-bit-index 0)
	    (number-of-bytes-sent-in-graphics-page 0)
	    (horizontal-pixel-margin 0)
	    (horizontal-decipoint-margin 0)
	    (y-pixel-position 0)
	    (rotation nil)
	    (p/d-numerator 0)
	    (p/d-denominator 0))
	   (basic-printer-stream-mixin)
  (:default-init-plist
    :name :laser1
    :lines-per-page 59
    :character-simulation-table laser1-simulation-table
    :dots-per-line 1))

(defmethod (laser1-stream :setup-normal) ()
  (escape-sequence #\E)
  (cond ((eq *laser1-orientation* :LANDSCAPE)
	 (escape-format "&l1O")
	 (setq lines-per-page 44))
	(t
	 (escape-format "&l0O")
	 (setq lines-per-page 59))))

(defvar *laser1-pixels-per-inch* 100 "this can be 75, 100, 150, or 300, dots per inch")

(defmethod (laser1-stream :set-up-for-graphics) (r)
  ;; set up for 100 dots per inch. 850 dots across.
  ;; support 75, 100, 150 and 300.
  (setq number-of-bytes-sent-in-graphics-page 0)
  (setq p/d-numerator (numerator (/ *laser1-pixels-per-inch* 720)))
  (setq p/d-denominator (denominator (/ *laser1-pixels-per-inch* 720)))
  (escape-format "*t~DR" *laser1-pixels-per-inch*)
  (escape-format "&a-2R")
  ;; should hack portrait/landscape with rotation.
  (setq y-pixel-position 0)
  (setq rotation r)
  (setq horizontal-pixel-margin -1))


(defmethod (laser1-stream :position-horizontal) (pixels)
  (multiple-value-bind (exact leftover)
      (floor pixels p/d-numerator)
    (setq horizontal-decipoint-margin (* exact p/d-denominator))
    (setq buffer-bit-index leftover)
    (laser1-horizontal-position-escapes destination horizontal-decipoint-margin)
    (setq horizontal-pixel-margin pixels)
    (fill raster-character-buffer 0)))

(defun laser1-horizontal-position-escapes (destination decipoints)
  (escape-format "&a~DH" decipoints) 
  (escape-format "*r~DA" 1))

(defmethod (laser1-stream :bitblt) (width height array x y &aux left-bit right-bit)
  (if ( width height)
      (bitblt-to-stream-simple-case width height array x y self)
    (do ((j (1- width) (1- j)))
	((minusp j))
      (cond ((null (setq left-bit (column-bit-search array y (+ x j) height))))
	    ('else
	     (send self :position-horizontal (- left-bit y))
	     (setq right-bit (column-reverse-bit-search array y (+ x j) height))
	     (do ((k left-bit (1+ k)))
		 ((> k right-bit))
	       (send self :print-bit-graphics (aref array k (+ x j))))))
      (send self :new-graphics-line))))

(defun column-bit-search (array1 y1 x1 count1)
  (do ((j1 0 (1+ j1)))
      ((= j1 count1)
       nil)
    (or (zerop (aref array1 (+ y1 j1) x1))
	(return (+ y1 j1))))) 

(defun column-reverse-bit-search (array y x count)
  (do ((position (+ y (1- count)) (1- position)))
      ((< position y)
       nil)
    (or (zerop (aref array position x))
	(return position))))

;; if an art-1b array is displaced to an art-8b array then the bits
;; go into the bytes in what is called "little indian" order. That is,
;; VAX = DEC = Little Indian, 370 = IBM = Big Indian.
;; Our LAMBDA is a little Indian also. 68000 is Big. etc.
;; The Laser1 wants its bytes of pixels in Big indian order.
;; Therefore we cant just do a displaced array, instead you can see the
;; use of floor with a modulus of 8 to get the correct ordering for the Laser1.

(defmethod (laser1-stream :print-bit-graphics) (char)
  ;; we intend that CHAR is actually a bit. put it into the
  ;; raster-character-buffer and frob the buffer-bit-index.
  (when (not (zerop char))
    (multiple-value-bind (bytepos bitpos)
      (floor buffer-bit-index 8)
      (setf (ldb (byte 1 (- 7 bitpos)) (si:aref raster-character-buffer bytepos)) 1)))
  (incf buffer-bit-index))

;; manual claims 59k. We forgot to keep track of bytes used by setup and positioning commands
;; so 57k is comfortable margin. fix in the future.

(defvar *laser1-graphics-byte-storage-limit* 57000
  "experimentally determined")

(defmethod (laser1-stream :new-graphics-line) ()
  (when (minusp horizontal-pixel-margin)
    (send self :position-horizontal 0)
    (send self :print-bit-graphics 0))
  (let ((bytes (ceiling buffer-bit-index 8)))
    (incf number-of-bytes-sent-in-graphics-page bytes)
    (when (> number-of-bytes-sent-in-graphics-page
	     *laser1-graphics-byte-storage-limit*)
	(send destination :tyo (ascii-code #\form))
	(send self :set-up-for-graphics rotation)
	(Laser1-horizontal-position-escapes destination horizontal-decipoint-margin))
    (escape-format "*b~DW" bytes)
    (send destination :string-out raster-character-buffer 0 bytes)
    (escape-format "*rB"))
  (incf y-pixel-position)
  (setq horizontal-pixel-margin -1))


(compile-flavor-methods laser1-stream)

;; Q? why isnt there a way to read the status code through the serial port?
;; how about a decoder for the error message codes.