;;; -*- Mode:Lisp; Readtable:ZL; Package:DVI; Base:10; Patch-File:T -*-
;;; Patch file for DVI version 6.1
;;; Reason:
;;;  add arithmetic to offsets of bitmaps, e.g. :v-offset (+ 150 :pixel-v)
;;; Written 11-Jul-86 11:13:42 by GJC (George Carrette) at site LMI Cambridge
;;; while running on Moe from band 1
;;; with Experimental System 116.7, Experimental Lambda-Diag 10.0, Experimental Local-File 70.0, Experimental FILE-Server 19.0, Experimental ZMail 66.0, Experimental TCP-Kernel 40.0, Experimental TCP-User 63.0, Experimental TCP-Server 46.0, Experimental DVI 6.0, Experimental Tape 7.0, microcode 1660, SDU Boot Tape 3.13, SDU ROM 103.



; From modified file DJ: GJCX.DVI; LMSCREEN-METHODS.LISP#21 at 11-Jul-86 11:13:43
#10R DVI#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "DVI")))
  (COMPILER::PATCH-SOURCE-FILE "DJ: GJCX.DVI; LMSCREEN-METHODS.#"

(defun (:impress-bitmap screen-dvi-xxx) (document command)
  (let (defaults hsize vsize magnification h-offset v-offset width height)
    (with-open-stream (stream (open-8b-input (cadr command)))
      (setq defaults (probe-file (send (send stream :truename) :new-pathname :type "DEFAULTS" :version :newest)))
      (cond (defaults
	     (with-open-file (ds defaults)
	       (setq defaults (read ds)))))
      (setq hsize (send stream :tyi))
      (setq vsize (send stream :tyi))
      (setq width (read-32-le stream))
      (setq height (read-32-le stream)))
    (setq magnification (get (cdr command) :magnification (getf defaults :magnification 0)))
    (setq h-offset (evaluate-offset (get (cdr command) :h-offset (getf defaults :h-offset 0))
				    document))
    (setq v-offset (evaluate-offset (get (cdr command) :v-offset (getf defaults :v-offset 0))
				    document))
    ;; now, simulate the impress BITMAP command
    ;; just draw a box
    ;; Imagen would be 300 pixels per inch.
    ;; We are hsize*32*2^mag
    (let ((divisor (quotient 300.0 (send document :printer-resolution))))
      (tv:%draw-rectangle (round (* width (expt 2 magnification)) divisor)
			  (round (* height (expt 2 magnification)) divisor)
			  (round h-offset divisor)
			  (round v-offset divisor)
			  tv:alu-ior
			  (send document :buffer)))))

))

; From modified file DJ: GJCX.DVI; DVI-IM-METHODS.LISP#21 at 11-Jul-86 11:22:37
#10R DVI#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "DVI")))
  (COMPILER::PATCH-SOURCE-FILE "DJ: GJCX.DVI; DVI-IM-METHODS.#"

(defun (:impress-bitmap imagen-dvi-xxx) (document command)
  (let ((buffer (send document :buffer)))
    (format t "~&Reading impress bitmap from ~S ~{~S ~S~^, ~}~%" (cadr command) (cddr command))
    (cond ((not (probe-file (cadr command)))
	   (format t "File does not exist. Continuing...~%"))
	  ('else
	   (write-buffer buffer impress-set-push-mask)
	   (write-buffer buffer 255)
	   (write-buffer buffer 255)
	   (write-buffer buffer impress-push)
	   (with-open-stream (stream (open-8b-input (cadr command)))
	     (let ((defaults))
	       (setq defaults (probe-file (send (send stream :truename) :new-pathname :type "DEFAULTS" :version :newest)))
	       (cond (defaults
		      (format t "~&Getting defaults from ~A~%" defaults)
		      (with-open-file (ds defaults)
			(setq defaults (read ds)))))
	       (let ((hsize (send stream :tyi))
		     (vsize (send stream :tyi)))
		 (read-32-le stream)
		 (read-32-le stream)
		 (write-buffer buffer set-magnification)
		 (write-buffer buffer (get (cdr command) :magnification (getf defaults :magnification 0)))
		 (write-buffer buffer set-abs-h)
		 (write2-buffer buffer (round (evaluate-offset (get (cdr command) :h-offset (getf defaults :h-offset 0))
							       document)))
		 (write-buffer buffer set-abs-v)
		 (write2-buffer buffer (round (evaluate-offset (get (cdr command) :v-offset (getf defaults :v-offset 0))
							       document)))
		 (write-buffer buffer bitmap)
		 (write-buffer buffer opaque)
		 (write-buffer buffer hsize)
		 (write-buffer buffer vsize)
		 (let ((s-stream))
		   (setq s-stream #'(lambda (op &optional arg1 &rest args)
				      (si:selectq-with-which-operations op
					(:tyo
					  (write-buffer buffer arg1))
					(:string-out
					  (do ((j (or (car args) 0) (1+ j))
					       (end (or (cadr args) (length arg1)))
					       (to buffer))
					      ((= j end))
					    (write-buffer to (aref arg1 j))))
					(t
					  (stream-default-handler s-stream op arg1 args)))))
		   (stream-copy-until-eof stream s-stream))
		 (write-buffer buffer impress-pop))))))))

))

; From modified file DJ: GJCX.DVI; DVI-IM-METHODS.LISP#21 at 11-Jul-86 11:22:45
#10R DVI#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "DVI")))
  (COMPILER::PATCH-SOURCE-FILE "DJ: GJCX.DVI; DVI-IM-METHODS.#"

(defun evaluate-offset (x document)
  ;; return an offset in imagen-sized pixels, i.e. 300 per inch.
  ;; common input is (+ :pixel-v 150), for 1/2 inch under the last text.
  (etypecase x
    (number x)
    (symbol
     (* (quotient 300.0 (send document :printer-resolution))
	(ecase x
	  (:pixel-h (send document :pixel-h))
	  (:pixel-v (send document :pixel-v)))))
    (cons
     (apply (car x) (mapcar #'(lambda (a) (evaluate-offset a document)) (cdr x))))))

))