(FILECREATED "15-Oct-87 13:10:00" {QV}<BRIGGS>LISP>CORRECTTOLERANCE-PATCH.;1
 5066   

      changes to:  (FNS NEWPAGE.IP)

      previous date: "15-Oct-87 12:10:53" {QV}<BRIGGS>LISP>CORRECTTOLERANCE-PATCH.;1)


(* Copyright (c) 1987 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT CORRECTTOLERANCE-PATCHCOMS)

(RPAQQ CORRECTTOLERANCE-PATCHCOMS
 ((* ;; 
				 "requires STREAM record, MOD and FOLDLO macros from exports.all")
				     (FNS NEWPAGE.IP)
				     (INITVARS (CORRECTTOLERANCE 25))))



(* ;; "requires STREAM record, MOD and FOLDLO macros from exports.all")


(DEFINEQ

(NEWPAGE.IP

  [LAMBDA (IPSTREAM)                                         (* N.H.Briggs "15-Oct-87 12:53")

                                                             (* ;;; "Start a new page in an interpress stream")

    (
PROG
 (CFONT HFONT ROTATION XOFFSET YOFFSET (IPDATA (fetch
 IPDATA of
 IPSTREAM)))
	    (
SETQ
 CFONT (fetch
 IPFONT of
 IPDATA))      (* ;; 

							     
"Save current font and make IPFONT be NIL, indicating that there is no actual font at the beginning of a page")

	    (replace
 IPFONT of
 IPDATA with
 NIL)
	    (
SELECTQ
 (fetch
 IPPAGESTATE of
 IPDATA)
		       (PAGE (
ENDPAGE.IP
 IPSTREAM))
		       (PREAMBLE (
ENDPREAMBLE.IP
 IPSTREAM))
		       NIL)
	    (
BEGINPAGE.IP
 IPSTREAM)
	    (replace
 IPPAGEFONTS of
 IPDATA with
 (fetch
 IPPREAMBLEFONTS of
 IPDATA))
	    (replace
 IPNEXTFRAMEVAR of
 IPDATA with
 (fetch
 IPPREAMBLENEXTFRAMEVAR
							    of
 IPDATA))
	    (
SCALE.IP
 IPSTREAM METERSPERMICA)              (* ; "Establish mica page coordinate system")

	    (
CONCATT.IP
 IPSTREAM)
	    (
COND

	      ([
NOT
 (
ZEROP
 (
SETQ
 ROTATION (fetch
 IPROTATION of
 IPDATA]
                                                             (* ; "Take care of any rotation")

		(
ROTATE.IP
 IPSTREAM ROTATION)
		(
CONCATT.IP
 IPSTREAM)))
	    (
COND

	      ([
OR
 [
NOT
 (
ZEROP
 (
SETQ
 XOFFSET (fetch
 IPXOFFSET of
 IPDATA]
		     (
NOT
 (
ZEROP
 (
SETQ
 YOFFSET (fetch
 IPYOFFSET of
 IPDATA]
                                                             (* ; "Take care of any translations")

		(
TRANSLATE.IP
 IPSTREAM XOFFSET YOFFSET)
		(
CONCATT.IP
 IPSTREAM)))
	    [
COND

	      [(fetch
 IPHEADING of
 IPDATA)               (* ; 

							     "If there's a page heading, do something about it.")

		(
SETQ
 HFONT (fetch
 IPHEADINGFONT of
 IPDATA))
		(
\DSPFONT.IP
 IPSTREAM HFONT)               (* ; "Set up heading font")

		(
SELECTQ
 ENCODING
			   (FULLIP-82 (
PRIN3
 (add
 (fetch
 IPPAGENUM of
 IPDATA)
						      1)
					       IPSTREAM)
				      (
FGET.IP
 IPSTREAM (fetch
 IPHEADINGOPVAR
							     of
 (fetch
 IPDATA of
 IPSTREAM)))
                                                             (* ; "Get the heading operator")

				      (
APPENDOP.IP
 IPSTREAM DOSAVE))
			   (IP-82 [
SETXY.IP
 IPSTREAM (fetch
 IPLEFT of
 IPDATA)
					      (
DIFFERENCE
 (fetch
 IPTOP of
 IPDATA)
							    (
FONTPROP
 HFONT (
QUOTE
 ASCENT]
				  (
DSPFONT
 HFONT IPSTREAM)
				  (
PRIN3
 (fetch
 IPHEADING of
 IPDATA)
					   IPSTREAM)
				  (
RELMOVETO
 MICASPERINCH 0 IPSTREAM)
                                                             (* ; "Skip an inch before page number")

				  (
PRIN3
 "Page " IPSTREAM)
				  (
PRIN3
 (add
 (fetch
 IPPAGENUM of
 IPDATA)
						  1)
					   IPSTREAM)
				  (
NEWLINE.IP
 IPSTREAM)    (* ; "Skip 2 lines")

				  (
NEWLINE.IP
 IPSTREAM))
			   (
SHOULDNT
))                     (* ;; 

							     
"SETXY can't be done in HEADINGOP, cause the ascent of the current font is not known at image-time.  We set it in terms of our current font, even though that hasn't yet be re-setup in the imager."
)

		(
SETYREL.IP
 IPSTREAM (
IMINUS
 (
FONTPROP
 CFONT (
QUOTE
 ASCENT]
	      (T (
SETXY.IP
 IPSTREAM (fetch
 IPLEFT of
 IPDATA)
			     (
DIFFERENCE
 (fetch
 IPTOP of
 IPDATA)
					   (
FONTPROP
 CFONT (
QUOTE
 ASCENT]
                                                             (* ; 

							     
"Now we set the imagers font to our (previous) current font, to override heading")

	    (
APPENDINTEGER.IP
 IPSTREAM CORRECTTOLERANCE)   (* ; "Set up so that CORRECTs have to be exact.")

	    (
APPENDINTEGER.IP
 IPSTREAM 0)
	    (
APPENDOP.IP
 IPSTREAM SETCORRECTTOLERANCE)
	    (
COND

	      ((
NOT
 (
EQP
 1 (ffetch
 IPSPACEFACTOR of
 IPDATA)))
                                                             (* ; "Imager variables revert to initial values")

		(
APPENDNUMBER.IP
 IPSTREAM (ffetch
 IPSPACEFACTOR of
 IPDATA))
		(
ISET.IP
 IPSTREAM AMPLIFYSPACE)))
	    (
\DSPFONT.IP
 IPSTREAM CFONT])
)

(RPAQ? CORRECTTOLERANCE
 25)
(PUTPROPS CORRECTTOLERANCE-PATCH COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (596 4940 (NEWPAGE.IP 606 . 4938)))))
STOP