;;; -*- Mode: Common-Lisp; Package: PRINTER; Base: 10.; Patch-File: T -*-

;;; Reason: Binded *read-default-float-format* to single-float. Double-float cause the postscript-printer to error.[9868]

;;;                           RESTRICTED RIGHTS LEGEND
;;;
;;; Use, duplication, or disclosure by the Government is subject to
;;; restrictions as set forth in subdivision (c)(1)(ii) of the Rights in
;;; Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;   TEXAS INSTRUMENTS INCORPORATED      
;;;   P.O. BOX 2909, M/S 2151             
;;;   AUSTIN, TEXAS 78769                 
;;;
;;; Copyright (C) 1989 Texas Instruments Incorporated.
;;; All rights reserved.

;;; Patch file for PRINTER-TYPES version 6.2
;;; Written 10/04/89 10:31:04 by BERGER,
;;; while running on ARIES from band LODX
;;; With SYSTEM 6.17, VIRTUAL-MEMORY 6.2, EH 6.5, MAKE-SYSTEM 6.1, MICRONET 6.0, LOCAL-FILE 6.1,
;;;  BASIC-PATHNAME 6.1, NETWORK-SUPPORT-COLD 6.0, BASIC-NAMESPACE 6.2, NETWORK-NAMESPACE 6.0,
;;;  DISK-IO 6.1, DISK-LABEL 6.0, BASIC-FILE 6.3, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.0,
;;;  COMPILER 6.12, TV 6.15, DATALINK 6.0, CHAOSNET 6.1, GC 6.3, MEMORY-AUX 6.0, NVRAM 6.1,
;;;  SYSLOG 6.1, STREAMER-TAPE 6.4, UCL 6.0, INPUT-EDITOR 6.0, METER 6.1, ZWEI 6.5,
;;;  DEBUG-TOOLS 6.3, NETWORK-SUPPORT 6.0, NETWORK-SERVICE 6.1, DATALINK-DISPLAYS 6.0,
;;;  FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.3, MAC-PRINTER-TYPES 6.1, PRINTER-TYPES 6.1,
;;;  IMAGEN 6.0, SUGGESTIONS 6.0, MAIL-DAEMON 6.2, MAIL-READER 6.2, TELNET 6.0, VT100 6.0,
;;;  NAMESPACE-EDITOR 6.0, PROFILE 6.1, VISIDOC 6.4, TI-CLOS 6.24, CLEH 6.5, IP 3.50,
;;;  Experimental CLX 6.3, CLUE 6.17, X11M 6.14, Experimental BUG 11.15, VISIDOC-SERVER 6.1,
;;;   microcode 429, Band Name: Rel 6.0 + SLE 8/30

#!C
; From file POSTSCRIPT-PRINTER.LISP#> PRINTER-TYPES; SYS:
#10R PRINTER#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "PRINTER"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: PRINTER-TYPES; POSTSCRIPT-PRINTER.#"


(DEFMETHOD (postscript-printer :print-bitmap) 
	   (bitmap-array
	    &OPTIONAL width height (start-x 0) (start-y 0) orientation dots-per-inch
	    &AUX picstr-width (image-hex 0) (image-bit 0) pic-width (default-scale .24)
	    user-scale bit-add (top-margin 700.0) (rotate-angle 0) (scale-multiplier 2)
	    (x-fudge 100) (y-fudge 50)
	    )
  "Copy the bitmap array to a print stream;
printer-stream could be a file stream or serial stream. It assumes 8 bit data transfer"
  (let ((*read-default-float-format* 'single-float))  ; DAB 10-04-89 Bind here. Lots of problems is double-float
						;if I am printing to a remote host, don't do :bitmap-setup
						; because it will be done by :print-raw file on the server
    (UNLESS  (member (intern-local (TYPE-OF (SEND self :printer-stream)) 'printer)	;08-19-88 DAB
		     '(lm-character-output-stream
			nfs-buffered-output-character-stream)	;07-18-88 DAB Added for screen prints on a MX.
		     :test #'equal)
      (SEND self :bitmap-setup))
    
    (IF (EQUAL orientation :landscape )
	(PROGN (SETQ rotate-angle 90)
	       (SETQ top-margin 10)
	       (SETF x-fudge 50)
	       (SETF y-fudge 50)
	       (SETQ scale-multiplier 3)))
    (IF (NUMBERP dots-per-inch)
	(SETQ scale-multiplier dots-per-inch))
    (SETF user-scale (* default-scale scale-multiplier))
    (unless width
      (setq width (ARRAY-DIMENSION bitmap-array 1)))
    (unless height
      (setq height (ARRAY-DIMENSION bitmap-array 0)))
    
    (IF (EQUAL   width  (* (quotient  width  8) 8))
	(SETF pic-width  width )
	(PROGN
	  (SETF pic-width (* 8 (+ (quotient width 8) 1)) )
	  (SETF width pic-width)))
    (SETF picstr-width (quotient pic-width 8))
    
    (FORMAT (SEND self :printer-stream) "~d" rotate-angle )
    (SEND self :tyo-raw 10)
    (FORMAT (SEND self :printer-stream) "~d" user-scale)
    (SEND self :tyo-raw 10)
    (FORMAT (SEND self :printer-stream) "~d" width)
    (SEND self :tyo-raw 10)  
    (FORMAT (SEND self :printer-stream) "~d" height)
    (SEND self :tyo-raw 10)
;  (FORMAT (SEND self :printer-stream) "~d" x-fudge)
;  (SEND self :tyo-raw 10)
    (FORMAT (SEND self :printer-stream) "~d" (- (- (quotient top-margin user-scale)  height) y-fudge))
    (SEND self :tyo-raw 10)
    (FORMAT (SEND self :printer-stream) "~d" picstr-width)
    (SEND self :tyo-raw 10)
    (FORMAT (SEND self :printer-stream) "~d" pic-width)
    (SEND self :tyo-raw 10)
    (LET ((*print-base* 16))
      
      (DO (( y  start-y  (+ y 1))) ((EQUAL y    height  )  ()) 
	(DO (( x  start-x  (+ x 1))) ((= x    width ) ())
	  (SETF bit-add (AREF bitmap-array y x))
	  (IF (= bit-add 0)(SETF bit-add 1)(SETF bit-add 0))
	  (SETF image-hex (+ image-hex  bit-add ))
	  (SETF image-bit (+ image-bit 1))
	  (IF (EQUAL image-bit 8) (PROGN
				    (IF (< image-hex 16)(PRINC "0" (SEND self :printer-stream)))
				    (SETF image-bit 0)
				    (princ image-hex (SEND self :printer-stream ))
				    (princ " " (SEND self :printer-stream ))
				    (SEND self :tyo-raw 10)
				    (SETF image-hex 0)
				    )
	      )
	  (SETF image-hex (LSH image-hex 1))
	  )
	))
    (FORMAT (SEND self :printer-stream) "showpage")(SEND self :tyo-raw 10)
    (SEND self :tyo-raw 04)
    )						; DAB 08-03-89 End let
  
  )
))