;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for DVI version 9.1
;;; Reason:
;;;  evaluation of array offsets
;;; Written 7-Aug-86 14:41:35 by gjc at site LMI Cambridge
;;; while running on Azathoth from band 1
;;; with System 110.232, Lambda-Diag 7.17, Experimental Local-File 68.7, FILE-Server 18.4, Unix-Interface 9.1, ZMail 65.14, Object Lisp 3.4, Tape 6.39, Site Data Editor 3.3, Tiger 24.0, KERMIT 31.3, Gateway 4.15, TCP-Kernel 39.7, TCP-User 62.7, TCP-Server 45.5, MEDIUM-RESOLUTION-COLOR 3.4, MICRO-COMPILATION-TOOLS 3.2, System Revision Level 3.99, Experimental Window-Maker 2.0, Experimental DVI 9.0, microcode 1563, SDU Boot Tape 3.12, SDU ROM 102, Beta III.



; From file DJ: GJCX.DVI; DVI-IM-METHODS.LISP#30 at 7-Aug-86 14:41:37
#10R DVI#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "DVI")))
  (COMPILER::PATCH-SOURCE-FILE "DJ: GJCX.DVI; DVI-IM-METHODS.#"

(defun (:saved-paint-image imagen-dvi-xxx) (document command)
  (let (FILE DEFAULTS ARRAY WIDTH HEIGHT MAGNIFICATION H-OFFSET V-OFFSET HSIZE VSIZE BUFFER
	array-h-offset array-v-offset array-width array-height)
    (setq buffer (send document :buffer))
    (format t "~&Loading paint file ~S" (cadr command))
    (multiple-value-setq (array file) (load-paint-array (cadr command)))
    (when (setq defaults (probe-file (send file :new-pathname :type "DEFAULTS" :VERSION :NEWEST)))
      (format t "~&Getting defaults from ~A" defaults)
      (SETQ DEFAULTS (CAR (FORMS-FROM-FILE DEFAULTS))))
    (SETQ WIDTH (PIXEL-ARRAY-WIDTH ARRAY))
    (SETQ HEIGHT (PIXEL-ARRAY-HEIGHT ARRAY))
    (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))
    (when (null *imagen-data-bytes*)
      (setq *imagen-data-bytes* (make-array (// (* 1024 1024) 8)
					    :type 'art-string)))
    (format t " processing ...")
    (setq array-h-offset (eval (getf defaults :array-h-offset 0)))
    (setq array-v-offset (eval (getf defaults :array-v-offset 0)))
    (setq array-width (eval (getf defaults :array-width (- width array-h-offset))))
    (setq array-height (eval (getf defaults :array-height (- height array-v-offset))))
    (setup-imagen-data-bytes array
			     array-h-offset
			     array-v-offset 
			     (min array-width (- width array-h-offset))
			     (min array-height (- height array-v-offset)))
    (setq hsize (nth 0 *imagen-data-size*))
    (setq vsize (nth 1 *imagen-data-size*))
    (write-buffer buffer impress-set-push-mask)
    (write-buffer buffer 255)
    (write-buffer buffer 255)
    (write-buffer buffer impress-push)
    (write-buffer buffer set-magnification)
    (write-buffer buffer magnification)
    (write-buffer buffer set-abs-h)
    (write2-buffer buffer (round h-offset))
    (write-buffer buffer set-abs-v)
    (write2-buffer buffer (round v-offset))
    (write-buffer buffer bitmap)
    (write-buffer buffer opaque)
    (write-buffer buffer hsize)
    (write-buffer buffer vsize)
    (do ((data *imagen-data-bytes*)
	 (j 0 (1+ j))
	 (n (* 128 hsize vsize)))
	((= j n))
      (write-buffer buffer (aref data j)))
    (write-buffer buffer impress-pop)))

))