(FILECREATED " 2-AUG-83 01:15:20" {PHYLUM}<LISPCORE>SOURCES>INTERPRESS.;114)


(* Copyright (c) 1983 by Xerox Corporation)

(PRETTYCOMPRINT INTERPRESSCOMS)

(RPAQQ INTERPRESSCOMS ((* Literal interface)
	[DECLARE: DONTCOPY (* Change (or remove)
			      when IP-82 exists on printers)
		  (CONSTANTS (ENCODING (QUOTE IP-82]
	(COMS (* Rational operations and useful constants)
	      (FNS \RTIMES2 \RPLUS2 RMINUS CREATERATIONAL RATIONALTOINTEGER)
	      (DECLARE: DONTCOPY (CONSTANTS * RATIONALS))
	      (RECORDS RATIONAL))
	(FNS APPENDBYTE.IP APPENDIDENTIFIER.IP APPENDINT.IP APPENDINTEGER.IP APPENDLARGEVECTOR.IP 
	     APPENDLISPSTRING.IP APPENDNUMBER.IP APPENDOP.IP APPENDRATIONAL.IP 
	     APPENDSEQUENCEDESCRIPTOR.IP BYTESININT.IP EXTRACTBYTE.IP)
	(* Operator interface)
	(FNS BEGINMASTER.IP BEGINPAGE.IP BEGINPREAMBLE.IP CONCATT.IP CONCAT.IP DRAWLINE.IP 
	     DRAWTRAJECTORY.IP ENDMASTER.IP ENDPAGE.IP ENDPREAMBLE.IP FGET.IP FILLTRAJECTORY.IP 
	     FSET.IP GETFRAMEVAR.IP INITIALIZEMASTER.IP LINETO.IP MOVETO.IP ROTATE.IP SCALE.IP 
	     SCALE2.IP SETFONT.IP SETXREL.IP SETXY.IP SETXYREL.IP SETYREL.IP SHOW.IP SHOWSTRING.IP 
	     TRAJECTORY.IP TRANSLATE.IP TRANS.IP)
	(* Graphics)
	(FNS MASKSTROKE.IP STARTTRAJECTORY.IP TRAJECTORYSEGMENT.IP)
	(* User interface)
	(FNS CLOSEIPSTREAM FONTNAME.IP FONTTEMPLATE.IP HEADINGOP.IP INTERPRESS.OUTCHARFN 
	     MAKEINTERPRESS NEWLINE.IP NEWPAGE.IP NEWPAGE?.IP OPENIPSTREAM SETUPFONTS.IP 
	     SHOWBITMAP.IP)
	(DECLARE: DONTCOPY (MACROS IPBOUTCHARCODE SHOWBITMAP1.IP))
	(FNS \INTERPRESSINIT)
	(DECLARE: DONTEVAL@LOAD DOCOPY (P (\INTERPRESSINIT)))
	(FNS SCALEREGION)
	[DECLARE: DONTEVAL@LOAD DOCOPY
		  (INITVARS (DEFAULTPAGEREGION (SCALEREGION 2540
							    (create REGION LEFT ← 1.1 BOTTOM ← .75 
								    HEIGHT ← (FDIFFERENCE 10.5 .75)
								    WIDTH ← (FDIFFERENCE 7.5 1.1]
	[GLOBALRESOURCES (\IPSHOWSTREAM (\OPENFILE (QUOTE {NODIRCORE})
						   (QUOTE BOTH)
						   (QUOTE OLD/NEW]
	(* Interpress encoding values)
	(DECLARE: DONTCOPY (CONSTANTS * NONPRIMS)
		  (CONSTANTS * SEQUENCETYPES)
		  (CONSTANTS * TYPES)
		  (CONSTANTS * OPERATORS)
		  (CONSTANTS * TOKENFORMATS)
		  (CONSTANTS * IMAGERVARIABLES)
		  (CONSTANTS * STROKEENDS)
		  (CONSTANTS * IP82CONSTANTS))
	(DECLARE: DONTCOPY (MACROS APPENDBYTE.IP APPENDOP.IP)
		  (RECORDS IPSTREAM INTERPRESSDATA))
	(INITRECORDS IPSTREAM INTERPRESSDATA)
	(FNS IP.LISTFILES1)
	(FNS INTERPRESSBITMAP IP.SCALEFACTOR IP.PRIN3 IP.PRINTCENTERED)
	(ALISTS (PRINTERMODES INTERPRESS))
	(VARS DEFAULT.INTERPRESS.BITMAP.ROTATION)
	(ADDVARS (LITATOM.HIT.LIST APPENDBYTE.IP APPENDIDENTIFYER.IP APPENDINT.IP APPENDINTEGER.IP 
				   APPENDLARGEVECTOR.IP APPENDLISPSTRING.IP APPENDNUMBER.IP 
				   APPENDOP.IP APPENDRATIONAL.IP APPENDSEQUENCEDESCRIPTOR.IP 
				   BYTESININT.IP EXTRACTBYTE.IP BEGINMASTER.IP BEGINPAGE.IP 
				   BEGINPREAMBLE.IP CONCATT.IP CONCAT.IP ENDMASTER.IP ENDPAGE.IP 
				   ENDPREAMBLE.IP FGET.IP FSET.IP GETFRAMEVAR.IP INITIALIZEMASTER.IP 
				   SHOWSTRING.IP \RTIMES2 \RPLUS2 RMINUS CREATERATIONAL 
				   RATIONALTOINTEGER))))



(* Literal interface)

(DECLARE: DONTCOPY 



(* Change (or remove) when IP-82 exists on printers)


(DECLARE: EVAL@COMPILE 

(RPAQQ ENCODING IP-82)

(CONSTANTS (ENCODING (QUOTE IP-82)))
)
)



(* Rational operations and useful constants)

(DEFINEQ

(\RTIMES2
  [LAMBDA (R1 R2)                                            (* rmk: "21-JUL-82 17:51")
                                                             (* Rational multiply)
    (COND
      [(FIXP R1)
	(COND
	  ((FIXP R2)
	    (ITIMES R1 R2))
	  (T [COND
	       ((FLOATP R2)
		 (SETQ R2 (MAKERATIONAL R2]
	     (COND
	       ((IEQP R1 (fetch DENOMINATOR of R2))
		 (fetch NUMERATOR of R2))
	       (T (create RATIONAL
			  NUMERATOR ←(ITIMES R1 (fetch NUMERATOR of R2))
			  DENOMINATOR ←(fetch DENOMINATOR of R2]
      (T [COND
	   ((FLOATP R1)
	     (SETQ R1 (MAKERATIONAL R1]
	 (COND
	   [(FIXP R2)
	     (COND
	       ((IEQP R2 (fetch DENOMINATOR of R1))
		 (fetch NUMERATOR of R1))
	       (T (create RATIONAL
			  NUMERATOR ←(TIMES R2 (fetch NUMERATOR of R1))
			  DENOMINATOR ←(fetch DENOMINATOR of R1]
	   ((IEQP (fetch NUMERATOR of R1)
		  (fetch DENOMINATOR of R2))
	     (create RATIONAL
		     NUMERATOR ←(fetch NUMERATOR of R2)
		     DENOMINATOR ←(fetch DENOMINATOR of R1)))
	   ((IEQP (fetch DENOMINATOR of R1)
		  (fetch NUMERATOR of R2))
	     (create RATIONAL
		     NUMERATOR ←(fetch NUMERATOR of R1)
		     DENOMINATOR ←(fetch DENOMINATOR of R2)))
	   (T (create RATIONAL
		      NUMERATOR ←(ITIMES (fetch NUMERATOR of R1)
					 (fetch NUMERATOR of R2))
		      DENOMINATOR ←(ITIMES (fetch DENOMINATOR of R1)
					   (fetch DENOMINATOR of R2])

(\RPLUS2
  [LAMBDA (R1 R2)                                            (* rmk: "21-JUL-82 17:57")
                                                             (* Rational multiply)
    (COND
      [(FIXP R1)
	(COND
	  ((FIXP R2)
	    (IPLUS R1 R2))
	  (T [COND
	       ((FLOATP R2)
		 (SETQ R2 (MAKERATIONAL R2]
	     (create RATIONAL
		     NUMERATOR ←(IPLUS (fetch NUMERATOR of R2)
				       (ITIMES R1 (fetch DENOMINATOR of R2)))
		     DENOMINATOR ←(fetch DENOMINATOR of R2]
      (T [COND
	   ((FLOATP R1)
	     (SETQ R1 (MAKERATIONAL R1]
	 (COND
	   ((FIXP R2)
	     (create RATIONAL
		     NUMERATOR ←(IPLUS (fetch NUMERATOR of R1)
				       (ITIMES R2 (fetch DENOMINATOR of R1)))
		     DENOMINATOR ←(fetch DENOMINATOR of R1)))
	   ((IEQP (fetch DENOMINATOR of R1)
		  (fetch DENOMINATOR of R2))
	     (create RATIONAL
		     NUMERATOR ←(IPLUS (fetch NUMERATOR of R1)
				       (fetch NUMERATOR of R2))
		     DENOMINATOR ←(fetch DENOMINATOR of R2)))
	   (T (create RATIONAL
		      NUMERATOR ←(IPLUS (ITIMES (fetch DENOMINATOR of R1)
						(fetch NUMERATOR of R2))
					(ITIMES (fetch NUMERATOR of R1)
						(fetch DENOMINATOR of R2)))
		      DENOMINATOR ←(ITIMES (fetch DENOMINATOR of R1)
					   (fetch DENOMINATOR of R2])

(RMINUS
  [LAMBDA (X)                                                (* lmm " 2-AUG-82 22:06")
    (COND
      ((NUMBERP X)
	(MINUS X))
      (T (create RATIONAL
		 NUMERATOR ←(MINUS (fetch NUMERATOR of X))
		 DENOMINATOR ←(fetch DENOMINATOR of X])

(CREATERATIONAL
  [LAMBDA (NUMERATOR DENOMINATOR)                            (* rmk: "11-JUN-83 21:18")
                                                             (* Creates a normalized rational)
    (COND
      ((ZEROP DENOMINATOR)
	(CONS NUMERATOR DENOMINATOR))
      (T [COND
	   ((ILESSP DENOMINATOR 0)
	     (SETQ NUMERATOR (IMINUS NUMERATOR))
	     (SETQ DENOMINATOR (IMINUS DENOMINATOR]
	 (while (AND (EVENP NUMERATOR)
		     (EVENP DENOMINATOR))
	    do (SETQ NUMERATOR (RSH NUMERATOR 1))            (* Denominator is always positive)
	       (SETQ DENOMINATOR (LRSH DENOMINATOR 1)))
	 (CONS NUMERATOR DENOMINATOR])

(RATIONALTOINTEGER
  [LAMBDA (RAT)                                              (* lmm " 2-AUG-82 14:13")
    (FIXR (FQUOTIENT (fetch NUMERATOR of RAT)
		     (fetch DENOMINATOR of RAT])
)
(DECLARE: DONTCOPY 

(RPAQQ RATIONALS (METERSPERRAVENSPOT MICASPERSCREENPOINT SCREENPOINTSPERMICA (MICASPERINCH 2540)
				     (MICASPERPOINT (QUOTE (635 . 18)))
				     (POINTSPERINCH 72)
				     (POINTSPERMICA (QUOTE (18 . 635)))
				     (POINTSPERMETER (QUOTE (360000 . 127)))
				     (METERSPERPOINT (QUOTE (127 . 360000)))
				     (MICASPERMETER 100000)
				     (METERSPERMICA (QUOTE (1 . 100000)))
				     (RATZERO (QUOTE (0 . 1)))
				     (RATONE (QUOTE (1 . 1)))
				     (RAVENSPOTSPERINCH 300)
				     (MICASPERRAVENSPOT (QUOTE (127 . 15)))
				     (RAVENSPOTSPERMICA (QUOTE (15 . 127)))
				     ONEHALF))
(DECLARE: EVAL@COMPILE 

(RPAQQ METERSPERRAVENSPOT (1 . 11811))

(RPAQQ MICASPERSCREENPOINT (2540 . 80))

(RPAQQ SCREENPOINTSPERMICA (80 . 2540))

(RPAQQ MICASPERINCH 2540)

(RPAQQ MICASPERPOINT (635 . 18))

(RPAQQ POINTSPERINCH 72)

(RPAQQ POINTSPERMICA (18 . 635))

(RPAQQ POINTSPERMETER (360000 . 127))

(RPAQQ METERSPERPOINT (127 . 360000))

(RPAQQ MICASPERMETER 100000)

(RPAQQ METERSPERMICA (1 . 100000))

(RPAQQ RATZERO (0 . 1))

(RPAQQ RATONE (1 . 1))

(RPAQQ RAVENSPOTSPERINCH 300)

(RPAQQ MICASPERRAVENSPOT (127 . 15))

(RPAQQ RAVENSPOTSPERMICA (15 . 127))

(RPAQQ ONEHALF (1 . 2))

(CONSTANTS METERSPERRAVENSPOT MICASPERSCREENPOINT SCREENPOINTSPERMICA (MICASPERINCH 2540)
	   (MICASPERPOINT (QUOTE (635 . 18)))
	   (POINTSPERINCH 72)
	   (POINTSPERMICA (QUOTE (18 . 635)))
	   (POINTSPERMETER (QUOTE (360000 . 127)))
	   (METERSPERPOINT (QUOTE (127 . 360000)))
	   (MICASPERMETER 100000)
	   (METERSPERMICA (QUOTE (1 . 100000)))
	   (RATZERO (QUOTE (0 . 1)))
	   (RATONE (QUOTE (1 . 1)))
	   (RAVENSPOTSPERINCH 300)
	   (MICASPERRAVENSPOT (QUOTE (127 . 15)))
	   (RAVENSPOTSPERMICA (QUOTE (15 . 127)))
	   ONEHALF)
)
)
[DECLARE: EVAL@COMPILE 

(RECORD RATIONAL (NUMERATOR . DENOMINATOR)
		 (TYPE? LISTP)
		 (CREATE (CREATERATIONAL NUMERATOR DENOMINATOR)))
]
(DEFINEQ

(APPENDBYTE.IP
  [LAMBDA (STREAM BYTE)                                      (* rmk: "21-JUN-82 23:30")
    (\BOUT STREAM BYTE])

(APPENDIDENTIFIER.IP
  [LAMBDA (STREAM STRING)                                    (* rmk: "13-JUL-82 01:12")
    (APPENDSEQUENCEDESCRIPTOR.IP STREAM SEQIDENTIFIER (NCHARS STRING))
    (IP.PRIN3 STRING STREAM])

(APPENDINT.IP
  [LAMBDA (STREAM NUM LENGTH)                                (* rmk: "22-JUN-82 00:02")
    (for I from (SUB1 LENGTH) to 0 by -1 do (APPENDBYTE.IP STREAM (EXTRACTBYTE.IP NUM I])

(APPENDINTEGER.IP
  [LAMBDA (STREAM N)                                         (* edited: "30-MAY-83 23:33")
    (COND
      ((AND (ILEQ -4000 N)
	    (ILEQ N 28767))
	(APPENDINT.IP STREAM (IPLUS N 4000)
		      2))
      (T (PROG ((LEN (BYTESININT.IP N)))
	       (APPENDSEQUENCEDESCRIPTOR.IP STREAM SEQINTEGER LEN)
	       (APPENDINT.IP STREAM N LEN])

(APPENDLARGEVECTOR.IP
  [LAMBDA (STREAM ARRAY)                                     (* rmk: "25-JUN-82 22:26")

          (* Appends a large vector stored as an Interlisp array. NUMELEMENTS is not an argument, since we assume that the 
	  caller can pass a SUBARRAY if he so intends.)


    (PROG (INTSIZE (ASIZE (ARRAYSIZE ARRAY))
		   (AORIG (ARRAYORIG ARRAY)))
          [SETQ INTSIZE (for I from AORIG to (SUB1 (IPLUS ASIZE AORIG))
			   largest (BYTESININT.IP (ELT ARRAY I]
          (APPENDSEQUENCEDESCRIPTOR.IP STREAM SEQLARGEVECTOR (ADD1 (ITIMES ASIZE INTSIZE)))
          (for I from AORIG to (SUB1 (IPLUS ASIZE AORIG)) do (APPENDINT.IP STREAM (ELT ARRAY I)
									   INTSIZE])

(APPENDLISPSTRING.IP
  [LAMBDA (STREAM STRING)                                    (* rmk: "13-JUL-82 01:13")

          (* Appends a Lisp string. This is not the APPENDSTRING procedure of the Interpress82 standard, which takes a 
	  vector and encodes elements greater than 255 using the NS encoding (with 255 as an escape). However, an NS vector 
	  can be encoded into a Lisp string by a separate function.)


    (APPENDSEQUENCEDESCRIPTOR.IP STREAM SEQSTRING (NCHARS STRING))
    (IP.PRIN3 STRING STREAM])

(APPENDNUMBER.IP
  [LAMBDA (STREAM R)                                         (* rmk: "25-JUN-82 22:00")
    (COND
      ((FIXP R)
	(APPENDINTEGER.IP STREAM R))
      ((type? RATIONAL R)
	(APPENDRATIONAL.IP STREAM (fetch NUMERATOR of R)
			   (fetch DENOMINATOR of R)))
      (T (PROG ((RAT (MAKERATIONAL R)))
	       (APPENDRATIONAL.IP STREAM (fetch NUMERATOR of RAT)
				  (fetch DENOMINATOR of RAT])

(APPENDOP.IP
  [LAMBDA (STREAM OP)                                        (* rmk: "22-JUN-82 01:28")
    (COND
      ((OR (ILESSP OP 0)
	   (IGREATERP OP 8191))
	(ERROR "Invalid Interpress operator code:" OP)))
    (COND
      ((ILEQ OP 31)
	(APPENDBYTE.IP STREAM (LOGOR SHORTOP OP)))
      (T (APPENDBYTE.IP STREAM (LOGOR LONGOP (FOLDLO OP 256)))
	 (APPENDBYTE.IP STREAM (MOD OP 256])

(APPENDRATIONAL.IP
  [LAMBDA (STREAM N D)                                      (* rmk: "20-JUL-82 23:45")
    (PROG [(I (IMAX (BYTESININT.IP N)
		    (BYTESININT.IP D]
          (APPENDSEQUENCEDESCRIPTOR.IP STREAM SEQRATIONAL (UNFOLD I 2))
          (APPENDINT.IP STREAM N I)
          (APPENDINT.IP STREAM D I])

(APPENDSEQUENCEDESCRIPTOR.IP
  [LAMBDA (STREAM TYPE LENGTH)                               (* edited: "30-MAY-83 23:19")
    (COND
      ((OR (ILESSP TYPE 0)
	   (IGREATERP TYPE 31))
	(ERROR "Invalid Interpress type" TYPE)))
    (COND
      ([OR (ILESSP LENGTH 0)
	   (IGREATERP LENGTH (CONSTANT (SUB1 (EXPT 2 24]
	(ERROR "Interpress sequence length too long" LENGTH)))
    (COND
      ((ILESSP LENGTH 256)                                   (* Short sequence, with one byte of length)
	(APPENDBYTE.IP STREAM (LOGOR SHORTSEQUENCE TYPE))
	(APPENDBYTE.IP STREAM LENGTH))
      (T                                                     (* Long sequence, with 3 bytes of length)
	 (APPENDBYTE.IP STREAM (LOGOR LONGSEQUENCE TYPE))
	 (APPENDINT.IP STREAM LENGTH 3])

(BYTESININT.IP
  [LAMBDA (N)                                               (* rmk: "20-OCT-82 17:28")
    (FOLDHI (ADD1 (INTEGERLENGTH N))
	    BITSPERBYTE])

(EXTRACTBYTE.IP
  [LAMBDA (N BYTE)                                           (* rmk: "19-APR-83 17:17")
    (IMOD (LRSH N (UNFOLD BYTE BITSPERBYTE))
	  256])
)



(* Operator interface)

(DEFINEQ

(BEGINMASTER.IP
  [LAMBDA (IPSTREAM)                                         (* rmk: " 7-JUL-82 00:03")
    (APPENDOP.IP IPSTREAM BEGIN])

(BEGINPAGE.IP
  [LAMBDA (IPSTREAM)                                         (* rmk: "13-JUL-82 17:38")
    (UNINTERRUPTABLY
        (APPENDOP.IP IPSTREAM BEGINPAGE)
	(replace IPPAGESTATE of (fetch IPDATA of IPSTREAM) with (QUOTE PAGE)))])

(BEGINPREAMBLE.IP
  [LAMBDA (IPSTREAM)                                         (* rmk: "13-JUL-82 17:39")
    (APPENDOP.IP IPSTREAM BEGINPREAMBLE)
    (replace IPPAGESTATE of (fetch IPDATA of IPSTREAM) with (QUOTE PREAMBLE])

(CONCATT.IP
  [LAMBDA (IPSTREAM)                                         (* rmk: " 7-JUL-82 00:08")
    (APPENDOP.IP IPSTREAM CONCATT])

(CONCAT.IP
  [LAMBDA (IPSTREAM)                                         (* rmk: " 7-JUN-83 17:41")
    (APPENDOP.IP IPSTREAM CONCAT])

(DRAWLINE.IP
  [LAMBDA (IPSTREAM X1 Y1 X2 Y2 WIDTH ENDSHAPE)              (* rmk: "23-JUL-82 15:09")
    (MOVETO.IP IPSTREAM X1 Y1)
    (LINETO.IP IPSTREAM X2 Y2)
    (MASKSTROKE.IP IPSTREAM WIDTH ENDSHAPE])

(DRAWTRAJECTORY.IP
  [LAMBDA (IPSTREAM POINTS WIDTH ENDSHAPE)                   (* rmk: "23-JUL-82 15:08")
    (TRAJECTORY.IP IPSTREAM POINTS)
    (MASKSTROKE.IP IPSTREAM WIDTH ENDSHAPE])

(ENDMASTER.IP
  [LAMBDA (IPSTREAM)                                         (* rmk: " 7-JUL-82 00:05")
    (APPENDOP.IP IPSTREAM END])

(ENDPAGE.IP
  [LAMBDA (IPSTREAM)                                         (* rmk: "13-JUL-82 17:36")
    (SHOW.IP IPSTREAM)
    (UNINTERRUPTABLY
        (APPENDOP.IP IPSTREAM ENDPAGE)
	(replace IPPAGESTATE of (fetch IPDATA of IPSTREAM) with NIL))])

(ENDPREAMBLE.IP
  [LAMBDA (IPSTREAM)                                         (* rmk: "13-JUL-82 17:39")
    (UNINTERRUPTABLY
        (APPENDOP.IP IPSTREAM ENDPREAMBLE)
	(replace IPPAGESTATE of (fetch IPDATA of IPSTREAM) with NIL))])

(FGET.IP
  [LAMBDA (IPSTREAM FINDEX)                                  (* rmk: " 7-JUL-82 00:09")
    (APPENDNUMBER.IP IPSTREAM FINDEX)
    (APPENDOP.IP IPSTREAM FGET])

(FILLTRAJECTORY.IP
  [LAMBDA (IPSTREAM POINTS)                                  (* rmk: "23-JUL-82 15:18")
    (TRAJECTORY.IP IPSTREAM POINTS)
    (APPENDOP.IP IPSTREAM MAKEOUTLINE)
    (APPENDINTEGER.IP IPSTREAM 1)
    (APPENDOP.IP IPSTREAM MASKFILL])

(FSET.IP
  [LAMBDA (IPSTREAM FINDEX)                                  (* rmk: " 7-JUL-82 00:08")
    (APPENDNUMBER.IP IPSTREAM FINDEX)
    (APPENDOP.IP IPSTREAM FSET])

(GETFRAMEVAR.IP
  [LAMBDA (IPSTREAM)                                         (* rmk: "21-JUL-82 16:45")
    (add (fetch IPNEXTFRAMEVAR of (fetch IPDATA of IPSTREAM))
	 1])

(INITIALIZEMASTER.IP
  [LAMBDA (IPSTREAM)                                         (* rmk: "13-JUL-82 01:12")
    (IP.PRIN3 ENCODINGSTRING IPSTREAM])

(LINETO.IP
  [LAMBDA (IPSTREAM X Y)                                     (* rmk: "21-JUL-82 14:02")
    (APPENDNUMBER.IP IPSTREAM X)
    (APPENDNUMBER.IP IPSTREAM Y)
    (APPENDOP.IP IPSTREAM LINETO])

(MOVETO.IP
  [LAMBDA (IPSTREAM X Y)                                     (* rmk: "23-JUL-82 15:02")
    (APPENDNUMBER.IP IPSTREAM X)
    (APPENDNUMBER.IP IPSTREAM Y)
    (APPENDOP.IP IPSTREAM MOVETO])

(ROTATE.IP
  [LAMBDA (IPSTREAM S)                                       (* rmk: " 6-JUN-83 18:02")
    (APPENDNUMBER.IP IPSTREAM S)
    (APPENDOP.IP IPSTREAM ROTATE])

(SCALE.IP
  [LAMBDA (IPSTREAM S)                                      (* rmk: "20-JUL-82 23:44")
    (APPENDNUMBER.IP IPSTREAM S)
    (APPENDOP.IP IPSTREAM SCALE])

(SCALE2.IP
  [LAMBDA (IPSTREAM X Y)                                     (* lmm "10-JUN-83 15:28")
    (APPENDNUMBER.IP IPSTREAM X)
    (APPENDNUMBER.IP IPSTREAM Y)
    (APPENDOP.IP IPSTREAM SCALE2])

(SETFONT.IP
  [LAMBDA (IPSTREAM FONTNUM)                                 (* edited: " 1-AUG-82 05:31")
    (APPENDNUMBER.IP IPSTREAM FONTNUM)
    (APPENDOP.IP IPSTREAM SETFONT)
    (PROG ((IPDATA (fetch IPDATA of IPSTREAM)))
          (replace IPFONTNUMBER of IPDATA with FONTNUM)
          (replace IPFONT of IPDATA with (COND
					   ((EQ FONTNUM 99)
                                                             (* bitmap font)
					     NIL)
					   (T (ELT (fetch IPFONTARRAY of IPDATA)
						   FONTNUM])

(SETXREL.IP
  [LAMBDA (IPSTREAM X)                                       (* edited: "30-MAY-83 23:20")
    (APPENDNUMBER.IP IPSTREAM X)
    (APPENDOP.IP IPSTREAM SETXREL)
    (change (fetch IPXPOS of (fetch IPDATA of IPSTREAM))
	    (\RPLUS2 X DATUM])

(SETXY.IP
  [LAMBDA (IPSTREAM X Y)                                     (* rmk: " 7-JUL-82 00:47")
    (APPENDNUMBER.IP IPSTREAM X)
    (APPENDNUMBER.IP IPSTREAM Y)
    (APPENDOP.IP IPSTREAM SETXY)
    (replace IPXPOS of (fetch IPDATA of IPSTREAM) with X)
    (replace IPYPOS of (fetch IPDATA of IPSTREAM) with Y])

(SETXYREL.IP
  [LAMBDA (IPSTREAM X Y)                                     (* edited: " 1-AUG-82 05:04")
    (APPENDNUMBER.IP IPSTREAM X)
    (APPENDNUMBER.IP IPSTREAM Y)
    (APPENDOP.IP IPSTREAM SETXYREL)
    (change (fetch IPXPOS of (fetch IPDATA of IPSTREAM))
	    (\RPLUS2 DATUM X))
    (change (fetch IPYPOS of (fetch IPDATA of IPSTREAM))
	    (\RPLUS2 DATUM Y])

(SETYREL.IP
  [LAMBDA (IPSTREAM Y)                                       (* rmk: " 7-JUL-82 00:12")
    (APPENDNUMBER.IP IPSTREAM Y)
    (APPENDOP.IP IPSTREAM SETYREL)
    (add (fetch IPYPOS of (fetch IPDATA of IPSTREAM))
	 Y])

(SHOW.IP
  [LAMBDA (IPSTREAM)                                         (* edited: "30-MAY-83 23:21")
                                                             (* Shows a string buffered away in SHOWSTREAM)
    (PROG [LEN (SHOWSTREAM (fetch IPSHOWSTREAM of (fetch IPDATA of IPSTREAM]
          (SETQ LEN (\GETFILEPTR SHOWSTREAM))
          (COND
	    ((IGREATERP LEN 0)
	      (APPENDSEQUENCEDESCRIPTOR.IP IPSTREAM SEQSTRING LEN)
	      (COPYBYTES SHOWSTREAM IPSTREAM 0 LEN)
	      (APPENDOP.IP IPSTREAM SHOW)
	      (\SETFILEPTR SHOWSTREAM 0])

(SHOWSTRING.IP
  [LAMBDA (IPSTREAM STRING)                                  (* rmk: " 7-JUL-82 00:10")
                                                             (* Shows a Lisp string--actually, any Lisp object cause 
							     of Lisp's implicit coercions.)
    (APPENDLISPSTRING.IP IPSTREAM STRING)
    (APPENDOP.IP IPSTREAM SHOW])

(TRAJECTORY.IP
  [LAMBDA (IPSTREAM POINTS)                                  (* rmk: "23-JUL-82 15:08")
    (MOVETO.IP IPSTREAM (fetch XCOORD of (CAR POINTS))
	       (fetch YCOORD of (CADR POINTS)))
    (for P in (CDR POINTS) do (LINETO.IP IPSTREAM (fetch XCOORD of P)
					 (fetch YCOORD of P])

(TRANSLATE.IP
  [LAMBDA (IPSTREAM X Y)                                     (* rmk: "21-JUL-82 13:23")
    (APPENDNUMBER.IP IPSTREAM X)
    (APPENDNUMBER.IP IPSTREAM Y)
    (APPENDOP.IP IPSTREAM TRANSLATE])

(TRANS.IP
  [LAMBDA (IPSTREAM)                                         (* rmk: "11-JUN-83 22:20")
                                                             (* This translates the origin to the current position.)
    (APPENDOP.IP IPSTREAM TRANS])
)



(* Graphics)

(DEFINEQ

(MASKSTROKE.IP
  [LAMBDA (IPSTREAM WIDTH ENDSHAPE)                          (* edited: "30-MAY-83 23:21")
    (APPENDNUMBER.IP IPSTREAM (OR WIDTH MICASPERPOINT))
    (APPENDINTEGER.IP IPSTREAM STROKEWIDTH)
    (APPENDOP.IP IPSTREAM ISET)
    (APPENDNUMBER.IP IPSTREAM (OR ENDSHAPE ROUND))
    (APPENDINTEGER.IP IPSTREAM STROKEEND)
    (APPENDOP.IP IPSTREAM ISET)
    (APPENDOP.IP IPSTREAM MASKSTROKE])

(STARTTRAJECTORY.IP
  [LAMBDA (IPSTREAM STARTX STARTY WIDTH SHAPE)               (* edited: "30-MAY-83 23:22")
    (APPENDNUMBER.IP IPSTREAM WIDTH)
    (APPENDINTEGER.IP IPSTREAM STROKEWIDTH)
    (APPENDOP.IP IPSTREAM ISET)
    (APPENDNUMBER.IP IPSTREAM SHAPE)
    (APPENDINTEGER.IP IPSTREAM STROKEEND)
    (APPENDOP.IP IPSTREAM ISET)
    (MOVETO.IP IPSTREAM STARTX STARTY])

(TRAJECTORYSEGMENT.IP
  [LAMBDA (IPSTREAM X Y)                                     (* rmk: "21-JUL-82 14:02")
    (APPENDNUMBER.IP IPSTREAM X)
    (APPENDNUMBER.IP IPSTREAM Y)
    (APPENDOP.IP IPSTREAM LINETO])
)



(* User interface)

(DEFINEQ

(CLOSEIPSTREAM
  [LAMBDA (IPSTREAM)                                         (* rmk: "27-JUL-83 19:48")
    (SELECTQ (fetch IPPAGESTATE of (fetch IPDATA of IPSTREAM))
	     (PAGE (ENDPAGE.IP IPSTREAM))
	     (PREAMBLE (ENDPREAMBLE.IP IPSTREAM))
	     NIL)
    (ENDMASTER.IP IPSTREAM])

(FONTNAME.IP
  [LAMBDA (FONTDESC)                                         (* rmk: " 3-JUN-83 16:23")
    (PROG (FACE NAME)
          [COND
	    ((EQ (QUOTE BOLD)
		 (FONTPROP FONTDESC (QUOTE WEIGHT)))
	      (SETQ FACE (QUOTE -Bold]
          [COND
	    ((EQ (QUOTE ITALIC)
		 (FONTPROP FONTDESC (QUOTE SLOPE)))
	      (SETQ FACE (QUOTE -Italic]
          [SETQ NAME (SELECTQ (FONTPROP FONTDESC (QUOTE FAMILY))
			      (TIMESROMAN (QUOTE Classic))
			      (HELVETICA (QUOTE Modern))
			      (LOGO (QUOTE Logotypes))
			      (GACHA (QUOTE Gacha))
			      (FONTPROP FONTDESC (QUOTE FAMILY]
          [COND
	    (FACE (SETQ NAME (PACK* NAME FACE]
          (RETURN (APPEND (QUOTE (XEROX XC82-0-0))
			  (CONS NAME])

(FONTTEMPLATE.IP
  [LAMBDA (IPSTREAM FONTNUM FONTNAME POINTSIZE)              (* edited: "30-MAY-83 23:23")
                                                             (* Fonts go into frame variables 1 thru ..., so we don't
							     have to adjust the font-codes coming from makepress.)
    (for N from 0 as ID in FONTNAME do (APPENDIDENTIFIER.IP IPSTREAM ID)
       finally (APPENDINTEGER.IP IPSTREAM N)
	       (APPENDOP.IP IPSTREAM MAKEVEC))
    (APPENDOP.IP IPSTREAM FINDFONT)
    (SCALE.IP IPSTREAM (\RTIMES2 MICASPERPOINT POINTSIZE))
    (APPENDOP.IP IPSTREAM MODIFYFONT)
    (FSET.IP IPSTREAM FONTNUM])

(HEADINGOP.IP
  [LAMBDA (IPSTREAM HEADING HEADINGFONTNUMBER)               (* rmk: "21-JUL-82 16:45")
                                                             (* Stores the HEADINGOP operator as frame-variable 0 in 
							     the preamble.)
    (PROG ((IPDATA (fetch IPDATA of IPSTREAM)))
          (APPENDOP.IP IPSTREAM MAKESIMPLECO)
          (APPENDOP.IP IPSTREAM {)
          (COND
	    (HEADING [SETXY.IP IPSTREAM (fetch IPLEFT of IPDATA)
			       (IDIFFERENCE (fetch IPTOP of IPDATA)
					    (FONTPROP (ELT (fetch IPFONTARRAY of IPDATA)
							   HEADINGFONTNUMBER)
						      (QUOTE ASCENT]
		     (SETFONT.IP IPSTREAM HEADINGFONTNUMBER)
		     (SHOWSTRING.IP IPSTREAM HEADING)
		     (SETXREL.IP IPSTREAM MICASPERINCH)      (* Skip an inch before page number)
		     (SHOWSTRING.IP IPSTREAM "Page ")
		     (APPENDOP.IP IPSTREAM SHOW)             (* Show the page number argument 
							     (from stack))
		     (NEWLINE.IP IPSTREAM HEADINGFONTNUMBER)
                                                             (* Skip 2 lines)
		     (NEWLINE.IP IPSTREAM HEADINGFONTNUMBER)))
          (APPENDOP.IP IPSTREAM })
          (FSET.IP IPSTREAM (replace IPHEADINGOPVAR of IPDATA with (GETFRAMEVAR.IP IPSTREAM])

(INTERPRESS.OUTCHARFN
  [LAMBDA (IPSTREAM CHARCODE)                                (* lmm "14-JUN-83 03:46")
    (SELCHARQ CHARCODE
	      (EOL (NEWLINE.IP IPSTREAM)
		   (replace (STREAM XPOSITION) of IPSTREAM with 0))
	      [LF (SHOW.IP IPSTREAM)                         (* Currently doesn't bother to check for page overflow.
							     Sigh.)
		  (PROGN (DECLARE (GLOBALVARS PRESSLINELEAD))
			 (SETYREL.IP IPSTREAM (IMINUS (IPLUS PRESSLINELEAD
							     (FONTPROP (fetch IPFONT
									  of (fetch IPDATA
										of IPSTREAM))
								       (QUOTE HEIGHT]
	      (↑L (replace (STREAM XPOSITION) of IPSTREAM with 0)
		  (NEWPAGE.IP IPSTREAM))
	      (↑                                             (* not in IP font)
		 (IPBOUTCHARCODE IPSTREAM 255Q))
	      (←                                             (* not in IP font)
		 (IPBOUTCHARCODE IPSTREAM 254Q))
	      (IPBOUTCHARCODE IPSTREAM CHARCODE])

(MAKEINTERPRESS
  [LAMBDA (FILE IPFILE FONTS HEADING TABS)                   (* rmk: "27-JUL-83 19:50")
    (DECLARE (GLOBALVARS PRESSTABSTOPS))
    (GLOBALRESOURCE
      \IPSHOWSTREAM
      (RESETLST (PROG (INSTRM IN MTABS IPSTREAM)
		      [RESETSAVE (SETQ IN (OPENFILE FILE (QUOTE INPUT)
						    (QUOTE OLD)
						    8
						    (PROGN (QUOTE ((SEQUENTIAL T)))
                                                             (* NIL until sequential streams handle EOS properly)
							   NIL)))
				 (QUOTE (PROGN (CLOSEF? OLDVALUE]
		      [RESETSAVE (SETQ IPSTREAM (OPENIPSTREAM
				     (OR IPFILE (PACKFILENAME (QUOTE EXTENSION)
							      (QUOTE IP)
							      (QUOTE BODY)
							      IN))
				     NIL
				     [AND (NEQ HEADING T)
					  (OR HEADING (CONCAT IN "     " (GETFILEINFO IN
										      (QUOTE 
										     CREATIONDATE]
				     FONTS \IPSHOWSTREAM))
				 (QUOTE (AND RESETSTATE (DELFILE (CLOSEF? OLDVALUE]
		      (SETQ INSTRM (\GETOFD IN (QUOTE INPUT)))
		      (replace (STREAM ENDOFSTREAMOP) of INSTRM with (FUNCTION NILL))
		      (bind C FC [MAXFONT ←(ARRAYSIZE (fetch IPFONTARRAY
							 of (fetch IPDATA of IPSTREAM]
			 while (SETQ C (\BIN INSTRM))
			 do (SELCHARQ C
				      [↑F                    (* Font shift)
					  (SHOW.IP IPSTREAM)
					  (SELCHARQ (SETQ FC (\BIN INSTRM))
						    [↑T      (* tab to absolute pos.)
							(COND
							  [(SETQ FC (\BIN INSTRM))
							    [OR MTABS (SETQ MTABS
								  (for TAB in (OR TABS PRESSTABSTOPS)
								     collect (millsToMicas TAB]
							    (SETQ FC (OR (CAR (NTH MTABS FC))
									 (ERROR 
								  "Undefined absolute tab number"
										FC)))
							    (SETXY.IP IPSTREAM FC
								      (fetch IPYPOS
									 of (fetch IPDATA
									       of IPSTREAM]
							  (T (\BOUT \IPSHOWSTREAM (CHARCODE ↑F))
							     (\BOUT \IPSHOWSTREAM (CHARCODE ↑T]
						    (NIL (\BOUT \IPSHOWSTREAM (CHARCODE ↑F))
                                                             (* EOF after ↑F)
							 )
						    (COND
						      ((AND (IGEQ MAXFONT FC)
							    (NEQ FC 0))
							(SETFONT.IP IPSTREAM FC))
						      (T (\BOUT \IPSHOWSTREAM (CHARCODE ↑F))
							 (\BOUT \IPSHOWSTREAM FC]
				      (CR (NEWLINE.IP IPSTREAM))
				      (↑L (NEWPAGE.IP IPSTREAM))
				      (TAB (SETXYREL.IP IPSTREAM
							(UNFOLD (CHARWIDTH (CHARCODE SPACE)
									   (fetch IPFONT
									      of (fetch IPDATA
										    of IPSTREAM)))
								8)
							0))
				      (↑                     (* not in IP font)
					 (\BOUT \IPSHOWSTREAM 173))
				      (←                     (* not in IP font)
					 (\BOUT \IPSHOWSTREAM 172))
				      (\BOUT \IPSHOWSTREAM C)))
		      (RETURN (LIST (CLOSEF IN)
				    (CLOSEF IPSTREAM])

(NEWLINE.IP
  [LAMBDA (IPSTREAM FONTNUMBER)                              (* rmk: "21-JUL-82 13:26")
                                                             (* Doesn't check for page overflow--wait until something
							     is actually shown. Uses height of FONTNUMBER 
							     (or current IPFONT) to determine vertical spacing)
    (DECLARE (GLOBALVARS PRESSLINELEAD))
    (SHOW.IP IPSTREAM)
    (PROG (NEWYPOS (IPDATA (fetch IPDATA of IPSTREAM)))
          [SETQ NEWYPOS (IDIFFERENCE (fetch IPYPOS of IPDATA)
				     (IPLUS PRESSLINELEAD
					    (FONTPROP (COND
							(FONTNUMBER (ELT (fetch IPFONTARRAY
									    of IPDATA)
									 FONTNUMBER))
							(T (fetch IPFONT of IPDATA)))
						      (QUOTE HEIGHT]
          (COND
	    ((ILESSP NEWYPOS (fetch IPBOTTOM of IPDATA))
	      (NEWPAGE.IP IPSTREAM))
	    (T (SETXY.IP IPSTREAM (fetch IPLEFT of IPDATA)
			 NEWYPOS])

(NEWPAGE.IP
  [LAMBDA (IPSTREAM)                                         (* edited: "30-MAY-83 23:25")
    (SELECTQ (fetch IPPAGESTATE of (fetch IPDATA of IPSTREAM))
	     (PAGE (ENDPAGE.IP IPSTREAM))
	     (PREAMBLE (ENDPREAMBLE.IP IPSTREAM))
	     NIL)
    (BEGINPAGE.IP IPSTREAM)
    (PROG (CFONT CFONTNUMBER (IPDATA (fetch IPDATA of IPSTREAM)))
          (COND
	    ((EQ ENCODING (QUOTE IP-82))
	      (SCALE.IP IPSTREAM METERSPERMICA)              (* Establish mica page coordinate system)
	      (CONCATT.IP IPSTREAM)))
          (TRANSLATE.IP IPSTREAM (fetch (REGION LEFT) of (fetch IPPAGEREGION of IPDATA))
			(fetch (REGION BOTTOM) of (fetch IPPAGEREGION of IPDATA)))
          (CONCATT.IP IPSTREAM)
          (SETQ CFONT (fetch IPFONT of IPDATA))
          (SETQ CFONTNUMBER (fetch IPFONTNUMBER of IPDATA))
          [COND
	    [(fetch IPHEADING of IPDATA)
	      (SETFONT.IP IPSTREAM 1)                        (* Set up heading font)
	      (APPENDLISPSTRING.IP IPSTREAM (add (fetch IPPAGENUM of IPDATA)
						 1))
	      (SELECTQ ENCODING
		       (FULLIP-82 (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)
					(IDIFFERENCE (fetch IPTOP of IPDATA)
						     (FONTPROP (ELT (fetch IPFONTARRAY of IPDATA)
								    1)
							       (QUOTE ASCENT]
			      (SETFONT.IP IPSTREAM 1)
			      (SHOWSTRING.IP IPSTREAM (fetch IPHEADING of IPDATA))
			      (SETXREL.IP IPSTREAM MICASPERINCH)
                                                             (* Skip an inch before page number)
			      (SHOWSTRING.IP IPSTREAM "Page ")
			      (APPENDOP.IP IPSTREAM SHOW)    (* Show the page number argument 
							     (from stack))
			      (NEWLINE.IP IPSTREAM 1)        (* Skip 2 lines)
			      (NEWLINE.IP IPSTREAM 1))
		       (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)
			 (IDIFFERENCE (fetch IPTOP of IPDATA)
				      (FONTPROP CFONT (QUOTE ASCENT]
                                                             (* Now we set the imagers font to our 
							     (previous) current font, to override the preamble and 
							     heading)
          (SETFONT.IP IPSTREAM CFONTNUMBER])

(NEWPAGE?.IP
  [LAMBDA (IPSTREAM)                                         (* rmk: "21-JUL-82 13:24")
                                                             (* Are we about to overflow the page?)
    (COND
      ((ILESSP (fetch IPYPOS of (fetch IPDATA of IPSTREAM))
	       (fetch IPBOTTOM of (fetch IPDATA of IPSTREAM)))
	(NEWPAGE.IP IPSTREAM])

(OPENIPSTREAM
  [LAMBDA (IPFILE REGION HEADING PREAMBLEFONTS SHOWSTREAM)
                                                            (* rmk: "18-JUL-83 22:50")

          (* Opens an interpress stream, to which user can do OUTCHAR to. PREAMBLEFONTS is a list of fonts to be set up in the
	  preamble.)


    (DECLARE (GLOBALVARS DEFAULTPAGEREGION \IPIMAGEOPS))
    (PROG [[IPSTREAM (OPENSTREAM IPFILE (QUOTE OUTPUT)
				 (QUOTE NEW)
				 8
				 (QUOTE ((TYPE BINARY]
	   (IPDATA (create INTERPRESSDATA
			   IPPAGEREGION ←(OR REGION DEFAULTPAGEREGION)
			   IPSHOWSTREAM ←(COND
			     (SHOWSTREAM (\SETFILEPTR SHOWSTREAM 0)
					 SHOWSTREAM)
			     (T (\OPENFILE (QUOTE {NODIRCORE})
					   (QUOTE BOTH)
					   (QUOTE OLD/NEW]
          (replace (STREAM OUTCHARFN) of IPSTREAM with (FUNCTION INTERPRESS.OUTCHARFN))
          (replace (IPSTREAM IMAGEOPS) of IPSTREAM with \IPIMAGEOPS)
          (replace (IPSTREAM IPDATA) of IPSTREAM with IPDATA)
          (INITIALIZEMASTER.IP IPSTREAM)
          (BEGINMASTER.IP IPSTREAM)
          (BEGINPREAMBLE.IP IPSTREAM)
          (SETUPFONTS.IP IPSTREAM PREAMBLEFONTS)            (* Heading must be done after fonts, so that headingop 
							    can be assigned a proper framevar)
          (COND
	    (HEADING (replace IPHEADING of IPDATA with HEADING)
		     (SELECTQ ENCODING
			      (FULLIP-82 (HEADINGOP.IP IPSTREAM HEADING 1))
			      NIL)))
          (ENDPREAMBLE.IP IPSTREAM)
          (NEWPAGE.IP IPSTREAM)
          (RETURN IPSTREAM])

(SETUPFONTS.IP
  [LAMBDA (IPSTREAM FONTS)                                   (* edited: "30-MAY-83 23:32")
    (PROG [(FA (FONTMAPARRAY FONTS (QUOTE PRESS]             (* Should really call for INTERPRESS fonts, not PRESS 
							     fonts.)
          (replace IPFONTARRAY of (fetch IPDATA of IPSTREAM) with FA)
          [for FONTNUM FONT from 1 to (ARRAYSIZE FA)
	     do (SETQ FONT (ELT FA FONTNUM))
		(FONTTEMPLATE.IP IPSTREAM FONTNUM (FONTNAME.IP FONT)
				 (FONTPROP FONT (QUOTE SIZE]
          (replace IPNEXTFRAMEVAR of (fetch IPDATA of IPSTREAM) with (ADD1 (ARRAYSIZE FA])

(SHOWBITMAP.IP
  [LAMBDA (IPSTREAM BITMAP REGION SCALE ROTATION)            (* lmm "14-JUN-83 02:21")
                                                             (* Puts out bit map with lower-left corner at current 
							     position. If given, REGION is a clipping region on the 
							     bitmap.)
    (SHOW.IP IPSTREAM)
    (APPENDOP.IP IPSTREAM DOSAVESIMPLEBODY)
    (APPENDOP.IP IPSTREAM {)
    (TRANS.IP IPSTREAM)                                      (* Translate to the current position)
    [COND
      (REGION                                                (* can't handle regions simply.
							     Just copy for now.)
	      (SETQ BITMAP (PROG [(BM (BITMAPCREATE (fetch WIDTH of REGION)
						    (fetch HEIGHT of REGION]
			         (with REGION REGION (BITBLT BITMAP LEFT BOTTOM BM NIL NIL WIDTH 
							     HEIGHT))
			         (RETURN BM]
    (PROG (NBYTES (XPIXELS (fetch BITMAPWIDTH of BITMAP))
		  (YPIXELS (fetch BITMAPHEIGHT of BITMAP))
		  (RW (fetch BITMAPRASTERWIDTH of BITMAP)))
          (APPENDNUMBER.IP IPSTREAM YPIXELS)                 (* For the master, this is the number of pixels in the 
							     slow direction)
          (APPENDNUMBER.IP IPSTREAM XPIXELS)                 (* Number of pixels in the master's fast direction)
          (APPENDINTEGER.IP IPSTREAM 1)                      (* Reserved for future expansion)
          (APPENDINTEGER.IP IPSTREAM 1)
          (APPENDINTEGER.IP IPSTREAM 1)
          (SELECTQ (IMOD (OR ROTATION 0)
			 360)
		   (0 (ROTATE.IP IPSTREAM -90)
		      (TRANSLATE.IP IPSTREAM 0 YPIXELS)
		      (CONCAT.IP IPSTREAM))
		   (90                                       (* need nop)
		       (TRANSLATE.IP IPSTREAM 0 0))
		   (180 (ROTATE.IP IPSTREAM 90)
			(TRANSLATE.IP IPSTREAM XPIXELS YPIXELS)
			(CONCAT.IP IPSTREAM))
		   (270 (ROTATE.IP IPSTREAM 180)
			(TRANSLATE.IP IPSTREAM XPIXELS 0)
			(CONCAT.IP IPSTREAM))
		   (ERROR ROTATION "rotation by other than multiples of 90 degrees not implemented"))
          [SCALE.IP IPSTREAM (COND
		      [SCALE (\RTIMES2 SCALE (CONSTANT (\RTIMES2 4 MICASPERRAVENSPOT]
		      (T (CONSTANT (\RTIMES2 4 MICASPERRAVENSPOT]
                                                             (* Go to unit of 4 raven spots ~= 1 screen point)
          (CONCAT.IP IPSTREAM)
          (SETQ NBYTES (ITIMES (UNFOLD (fetch (BITMAP BITMAPRASTERWIDTH) of BITMAP)
				       BYTESPERWORD)
			       YPIXELS))
          (APPENDSEQUENCEDESCRIPTOR.IP IPSTREAM SEQPACKEDPIXELVECTOR (IPLUS 4 NBYTES))
          (APPENDINT.IP IPSTREAM 1 2)
          (APPENDINT.IP IPSTREAM XPIXELS 2)
          (\BOUTS IPSTREAM (fetch (BITMAP BITMAPBASE) of BITMAP)
		  0 NBYTES)
          (APPENDOP.IP IPSTREAM MAKEPIXELARRAY)
          (APPENDOP.IP IPSTREAM MASKPIXEL))
    (APPENDOP.IP IPSTREAM }])
)
(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 

(PUTPROPS IPBOUTCHARCODE MACRO [LAMBDA (IPSTREAM CHARCODE)
				 (PROGN (\BOUT (fetch IPSHOWSTREAM of (fetch IPDATA of IPSTREAM))
					       CHARCODE)
					(add (fetch (STREAM XPOSITION) of IPSTREAM)
					     1])

(PUTPROPS SHOWBITMAP1.IP MACRO [LAMBDA (CODE)                (* rmk: "21-JUL-82 15:45")
				 (COND
				   ((ZEROP CODE)
				     (add SPACE 1))
				   (T (COND
					((IGREATERP SPACE 0)
					  (SHOW.IP IPSTREAM)
					  (SETXREL.IP IPSTREAM (ITIMES 8 SPACE))
					  (SETQ SPACE 0)))
				      (\BOUT SHOWSTREAM (COND
					       ((EQ CODE 255)
						 0)
					       (T CODE])
)
)
(DEFINEQ

(\INTERPRESSINIT
  [LAMBDA NIL                                               (* rmk: "18-JUL-83 22:48")
    (DECLARE (GLOBALVARS \IPIMAGEOPS))
    (SETQ \IPIMAGEOPS (create IMAGEOPS
			      IMAGETYPE ←(QUOTE INTERPRESS)
			      IMCLOSEFN ←(FUNCTION CLOSEIPSTREAM])
)
(DECLARE: DONTEVAL@LOAD DOCOPY 
(\INTERPRESSINIT)
)
(DEFINEQ

(SCALEREGION
  [LAMBDA (SCALE REGION)                                     (* rmk: "21-JUL-82 13:06")
                                                             (* Scales a region)
    (create REGION
	    LEFT ←(FIX (FTIMES SCALE (fetch (REGION LEFT) of REGION)))
	    BOTTOM ←(FIX (FTIMES SCALE (fetch (REGION BOTTOM) of REGION)))
	    WIDTH ←(FIX (FTIMES SCALE (fetch (REGION WIDTH) of REGION)))
	    HEIGHT ←(FIX (FTIMES SCALE (fetch (REGION HEIGHT) of REGION])
)
(DECLARE: DONTEVAL@LOAD DOCOPY 

(RPAQ? DEFAULTPAGEREGION (SCALEREGION 2540 (create REGION LEFT ← 1.1 BOTTOM ← .75 HEIGHT ←
						   (FDIFFERENCE 10.5 .75)
						   WIDTH ← (FDIFFERENCE 7.5 1.1))))
)

(RPAQQ \IPSHOWSTREAM NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \IPSHOWSTREAM)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY 
[PUTDEF (QUOTE \IPSHOWSTREAM)
	(QUOTE GLOBALRESOURCES)
	(QUOTE (\OPENFILE (QUOTE {NODIRCORE})
			  (QUOTE BOTH)
			  (QUOTE OLD/NEW]
)



(* Interpress encoding values)

(DECLARE: DONTCOPY 

(RPAQQ NONPRIMS ((BEGIN 102)
		 (END 103)
		 ({ 106)
		 (} 107)))
(DECLARE: EVAL@COMPILE 

(RPAQQ BEGIN 102)

(RPAQQ END 103)

(RPAQQ { 106)

(RPAQQ } 107)

(CONSTANTS (BEGIN 102)
	   (END 103)
	   ({ 106)
	   (} 107))
)


(RPAQQ SEQUENCETYPES ((SEQCOMMENT 6)
		      (SEQCOMPRESSPIXELVECTOR 10)
		      (SEQCONTINUED 7)
		      (SEQIDENTIFIER 5)
		      (SEQINSERTFILE 11)
		      (SEQINTEGER 2)
		      (SEQLARGEVECTOR 8)
		      (SEQPACKEDPIXELVECTOR 9)
		      (SEQRATIONAL 4)
		      (SEQSTRING 1)))
(DECLARE: EVAL@COMPILE 

(RPAQQ SEQCOMMENT 6)

(RPAQQ SEQCOMPRESSPIXELVECTOR 10)

(RPAQQ SEQCONTINUED 7)

(RPAQQ SEQIDENTIFIER 5)

(RPAQQ SEQINSERTFILE 11)

(RPAQQ SEQINTEGER 2)

(RPAQQ SEQLARGEVECTOR 8)

(RPAQQ SEQPACKEDPIXELVECTOR 9)

(RPAQQ SEQRATIONAL 4)

(RPAQQ SEQSTRING 1)

(CONSTANTS (SEQCOMMENT 6)
	   (SEQCOMPRESSPIXELVECTOR 10)
	   (SEQCONTINUED 7)
	   (SEQIDENTIFIER 5)
	   (SEQINSERTFILE 11)
	   (SEQINTEGER 2)
	   (SEQLARGEVECTOR 8)
	   (SEQPACKEDPIXELVECTOR 9)
	   (SEQRATIONAL 4)
	   (SEQSTRING 1))
)


(RPAQQ TYPES ((COLOR 7)
	      (IDENTIFIER 2)
	      (NUMBER 1)
	      (OPERATOR 4)
	      (OUTLINE 9)
	      (PIXELARRAY 6)
	      (TRAJECTORY 8)
	      (TRANSFORMATION 5)
	      (VECTOR 3)))
(DECLARE: EVAL@COMPILE 

(RPAQQ COLOR 7)

(RPAQQ IDENTIFIER 2)

(RPAQQ NUMBER 1)

(RPAQQ OPERATOR 4)

(RPAQQ OUTLINE 9)

(RPAQQ PIXELARRAY 6)

(RPAQQ TRAJECTORY 8)

(RPAQQ TRANSFORMATION 5)

(RPAQQ VECTOR 3)

(CONSTANTS (COLOR 7)
	   (IDENTIFIER 2)
	   (NUMBER 1)
	   (OPERATOR 4)
	   (OUTLINE 9)
	   (PIXELARRAY 6)
	   (TRAJECTORY 8)
	   (TRANSFORMATION 5)
	   (VECTOR 3))
)


(RPAQQ OPERATORS ((ABS 200)
		  (ADD 201)
		  (AND 202)
		  (CEILING 203)
		  (CONCAT 165)
		  (CONCATT 168)
		  (COPY 183)
		  (CORRECT 110)
		  (CORRECTMASK 156)
		  (CORRECTSPACE 157)
		  (COUNT 188)
		  (DIV 204)
		  (DO 231)
		  (DOSAVE 232)
		  (DOSAVEALL 233)
		  (DOSAVESIMPLEBODY 120)
		  (DUP 181)
		  (EQ 205)
		  (EXCH 185)
		  (FGET 20)
		  (FINDDECOMPRESSOR 149)
		  (FINDFONT 147)
		  (FLOOR 206)
		  (FSET 21)
		  (GE 207)
		  (GETCP 159)
		  (GT 208)
		  (IF 239)
		  (IFCOPY 240)
		  (IFELSE 241)
		  (IGET 18)
		  (ISET 19)
		  (LINETO 23)
		  (LINETOX 14)
		  (LINETOY 15)
		  (MAKEGRAY 425)
		  (MAKEOUTLINE 417)
		  (MAKESAMPLEDBLACK 426)
		  (MAKESIMPLECO 114)
		  (MAKEPIXELARRAY 450)
		  (MAKEVEC 283)
		  (MAKEVECLU 282)
		  (MARK 186)
		  (MASKFILL 409)
		  (MASKPIXEL 452)
		  (MASKRECTANGLE 410)
		  (MASKSTROKE 24)
		  (MASKUNDERLINE 414)
		  (MOD 209)
		  (MODIFYFONT 148)
		  (MOVE 169)
		  (MOVETO 25)
		  (MUL 210)
		  (NEG 211)
		  (NOP 1)
		  (NOT 212)
		  (OR 213)
		  (POP 180)
		  (ROLL 184)
		  (ROTATE 163)
		  (SCALE 164)
		  (SCALE2 166)
		  (SETCORRECTMEASURE 154)
		  (SETCORRECTTOLERANCE 155)
		  (SETFONT 151)
		  (SETGRAY 424)
		  (SETXREL 12)
		  (SETXY 10)
		  (SETXYREL 11)
		  (SETYREL 13)
		  (SHOW 22)
		  (SHOWANDXREL 146)
		  (SPACE 16)
		  (STARTUNDERLINE 413)
		  (SUB 214)
		  (TRANS 170)
		  (TRANSLATE 162)
		  (TRUNC 215)
		  (TYPE 220)
		  (UNMARK 187)
		  (UNMARK0 192)))
(DECLARE: EVAL@COMPILE 

(RPAQQ ABS 200)

(RPAQQ ADD 201)

(RPAQQ AND 202)

(RPAQQ CEILING 203)

(RPAQQ CONCAT 165)

(RPAQQ CONCATT 168)

(RPAQQ COPY 183)

(RPAQQ CORRECT 110)

(RPAQQ CORRECTMASK 156)

(RPAQQ CORRECTSPACE 157)

(RPAQQ COUNT 188)

(RPAQQ DIV 204)

(RPAQQ DO 231)

(RPAQQ DOSAVE 232)

(RPAQQ DOSAVEALL 233)

(RPAQQ DOSAVESIMPLEBODY 120)

(RPAQQ DUP 181)

(RPAQQ EQ 205)

(RPAQQ EXCH 185)

(RPAQQ FGET 20)

(RPAQQ FINDDECOMPRESSOR 149)

(RPAQQ FINDFONT 147)

(RPAQQ FLOOR 206)

(RPAQQ FSET 21)

(RPAQQ GE 207)

(RPAQQ GETCP 159)

(RPAQQ GT 208)

(RPAQQ IF 239)

(RPAQQ IFCOPY 240)

(RPAQQ IFELSE 241)

(RPAQQ IGET 18)

(RPAQQ ISET 19)

(RPAQQ LINETO 23)

(RPAQQ LINETOX 14)

(RPAQQ LINETOY 15)

(RPAQQ MAKEGRAY 425)

(RPAQQ MAKEOUTLINE 417)

(RPAQQ MAKESAMPLEDBLACK 426)

(RPAQQ MAKESIMPLECO 114)

(RPAQQ MAKEPIXELARRAY 450)

(RPAQQ MAKEVEC 283)

(RPAQQ MAKEVECLU 282)

(RPAQQ MARK 186)

(RPAQQ MASKFILL 409)

(RPAQQ MASKPIXEL 452)

(RPAQQ MASKRECTANGLE 410)

(RPAQQ MASKSTROKE 24)

(RPAQQ MASKUNDERLINE 414)

(RPAQQ MOD 209)

(RPAQQ MODIFYFONT 148)

(RPAQQ MOVE 169)

(RPAQQ MOVETO 25)

(RPAQQ MUL 210)

(RPAQQ NEG 211)

(RPAQQ NOP 1)

(RPAQQ NOT 212)

(RPAQQ OR 213)

(RPAQQ POP 180)

(RPAQQ ROLL 184)

(RPAQQ ROTATE 163)

(RPAQQ SCALE 164)

(RPAQQ SCALE2 166)

(RPAQQ SETCORRECTMEASURE 154)

(RPAQQ SETCORRECTTOLERANCE 155)

(RPAQQ SETFONT 151)

(RPAQQ SETGRAY 424)

(RPAQQ SETXREL 12)

(RPAQQ SETXY 10)

(RPAQQ SETXYREL 11)

(RPAQQ SETYREL 13)

(RPAQQ SHOW 22)

(RPAQQ SHOWANDXREL 146)

(RPAQQ SPACE 16)

(RPAQQ STARTUNDERLINE 413)

(RPAQQ SUB 214)

(RPAQQ TRANS 170)

(RPAQQ TRANSLATE 162)

(RPAQQ TRUNC 215)

(RPAQQ TYPE 220)

(RPAQQ UNMARK 187)

(RPAQQ UNMARK0 192)

(CONSTANTS (ABS 200)
	   (ADD 201)
	   (AND 202)
	   (CEILING 203)
	   (CONCAT 165)
	   (CONCATT 168)
	   (COPY 183)
	   (CORRECT 110)
	   (CORRECTMASK 156)
	   (CORRECTSPACE 157)
	   (COUNT 188)
	   (DIV 204)
	   (DO 231)
	   (DOSAVE 232)
	   (DOSAVEALL 233)
	   (DOSAVESIMPLEBODY 120)
	   (DUP 181)
	   (EQ 205)
	   (EXCH 185)
	   (FGET 20)
	   (FINDDECOMPRESSOR 149)
	   (FINDFONT 147)
	   (FLOOR 206)
	   (FSET 21)
	   (GE 207)
	   (GETCP 159)
	   (GT 208)
	   (IF 239)
	   (IFCOPY 240)
	   (IFELSE 241)
	   (IGET 18)
	   (ISET 19)
	   (LINETO 23)
	   (LINETOX 14)
	   (LINETOY 15)
	   (MAKEGRAY 425)
	   (MAKEOUTLINE 417)
	   (MAKESAMPLEDBLACK 426)
	   (MAKESIMPLECO 114)
	   (MAKEPIXELARRAY 450)
	   (MAKEVEC 283)
	   (MAKEVECLU 282)
	   (MARK 186)
	   (MASKFILL 409)
	   (MASKPIXEL 452)
	   (MASKRECTANGLE 410)
	   (MASKSTROKE 24)
	   (MASKUNDERLINE 414)
	   (MOD 209)
	   (MODIFYFONT 148)
	   (MOVE 169)
	   (MOVETO 25)
	   (MUL 210)
	   (NEG 211)
	   (NOP 1)
	   (NOT 212)
	   (OR 213)
	   (POP 180)
	   (ROLL 184)
	   (ROTATE 163)
	   (SCALE 164)
	   (SCALE2 166)
	   (SETCORRECTMEASURE 154)
	   (SETCORRECTTOLERANCE 155)
	   (SETFONT 151)
	   (SETGRAY 424)
	   (SETXREL 12)
	   (SETXY 10)
	   (SETXYREL 11)
	   (SETYREL 13)
	   (SHOW 22)
	   (SHOWANDXREL 146)
	   (SPACE 16)
	   (STARTUNDERLINE 413)
	   (SUB 214)
	   (TRANS 170)
	   (TRANSLATE 162)
	   (TRUNC 215)
	   (TYPE 220)
	   (UNMARK 187)
	   (UNMARK0 192))
)


(RPAQQ TOKENFORMATS ((SHORTOP 128)
		     (LONGOP 160)
		     (SHORTNUMBER 0)
		     (SHORTSEQUENCE 192)
		     (LONGSEQUENCE 224)))
(DECLARE: EVAL@COMPILE 

(RPAQQ SHORTOP 128)

(RPAQQ LONGOP 160)

(RPAQQ SHORTNUMBER 0)

(RPAQQ SHORTSEQUENCE 192)

(RPAQQ LONGSEQUENCE 224)

(CONSTANTS (SHORTOP 128)
	   (LONGOP 160)
	   (SHORTNUMBER 0)
	   (SHORTSEQUENCE 192)
	   (LONGSEQUENCE 224))
)


(RPAQQ IMAGERVARIABLES ((DCSCPX 0)
			(DCSCPY 1)
			(CORRECTMX 2)
			(CORRECTMY 3)
			(CURRENTTRANS 4)
			(PRIORITYIMPORTANT 5)
			(MEDIUMXSIZE 6)
			(MEDIUMYSIZE 7)
			(FIELDXMIN 8)
			(FIELDYMIN 9)
			(FIELDXMAX 10)
			(FIELDYMAX 11)
			(SHOWVEC 12)
			(COLOR 13)
			(NOIMAGE 14)
			(STROKEWIDTH 15)
			(STROKEEND 16)
			(UNDERLINESTART 17)
			(AMPLIFYSPACE 18)
			(CORRECTPASS 19)
			(CORRECTSHRINK 20)
			(CORRECTTX 21)
			(CORRECTTY 22)))
(DECLARE: EVAL@COMPILE 

(RPAQQ DCSCPX 0)

(RPAQQ DCSCPY 1)

(RPAQQ CORRECTMX 2)

(RPAQQ CORRECTMY 3)

(RPAQQ CURRENTTRANS 4)

(RPAQQ PRIORITYIMPORTANT 5)

(RPAQQ MEDIUMXSIZE 6)

(RPAQQ MEDIUMYSIZE 7)

(RPAQQ FIELDXMIN 8)

(RPAQQ FIELDYMIN 9)

(RPAQQ FIELDXMAX 10)

(RPAQQ FIELDYMAX 11)

(RPAQQ SHOWVEC 12)

(RPAQQ COLOR 13)

(RPAQQ NOIMAGE 14)

(RPAQQ STROKEWIDTH 15)

(RPAQQ STROKEEND 16)

(RPAQQ UNDERLINESTART 17)

(RPAQQ AMPLIFYSPACE 18)

(RPAQQ CORRECTPASS 19)

(RPAQQ CORRECTSHRINK 20)

(RPAQQ CORRECTTX 21)

(RPAQQ CORRECTTY 22)

(CONSTANTS (DCSCPX 0)
	   (DCSCPY 1)
	   (CORRECTMX 2)
	   (CORRECTMY 3)
	   (CURRENTTRANS 4)
	   (PRIORITYIMPORTANT 5)
	   (MEDIUMXSIZE 6)
	   (MEDIUMYSIZE 7)
	   (FIELDXMIN 8)
	   (FIELDYMIN 9)
	   (FIELDXMAX 10)
	   (FIELDYMAX 11)
	   (SHOWVEC 12)
	   (COLOR 13)
	   (NOIMAGE 14)
	   (STROKEWIDTH 15)
	   (STROKEEND 16)
	   (UNDERLINESTART 17)
	   (AMPLIFYSPACE 18)
	   (CORRECTPASS 19)
	   (CORRECTSHRINK 20)
	   (CORRECTTX 21)
	   (CORRECTTY 22))
)


(RPAQQ STROKEENDS ((SQUARE 0)
		   (BUTT 1)
		   (ROUND 2)))
(DECLARE: EVAL@COMPILE 

(RPAQQ SQUARE 0)

(RPAQQ BUTT 1)

(RPAQQ ROUND 2)

(CONSTANTS (SQUARE 0)
	   (BUTT 1)
	   (ROUND 2))
)


(RPAQQ IP82CONSTANTS ((BEGINPREAMBLE {)
		      (ENDPREAMBLE })
		      (BEGINPAGE {)
		      (ENDPAGE })
		      (ENCODINGSTRING "Interpress/Xerox/1.0 ")))
(DECLARE: EVAL@COMPILE 

(RPAQ BEGINPREAMBLE {)

(RPAQ ENDPREAMBLE })

(RPAQ BEGINPAGE {)

(RPAQ ENDPAGE })

(RPAQ ENCODINGSTRING "Interpress/Xerox/1.0 ")

(CONSTANTS (BEGINPREAMBLE {)
	   (ENDPREAMBLE })
	   (BEGINPAGE {)
	   (ENDPAGE })
	   (ENCODINGSTRING "Interpress/Xerox/1.0 "))
)
)
(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 

(PUTPROPS APPENDBYTE.IP DMACRO (= . \BOUT))

(PUTPROPS APPENDOP.IP MACRO [OPENLAMBDA (STREAM OP)
					(COND
					  ((CONSTANT (OR (ILESSP OP 0)
							 (IGREATERP OP 8191)))
					    (ERROR "Invalid Interpress operator code:" OP)))
					(COND
					  ((CONSTANT (ILEQ OP 31))
					    (APPENDBYTE.IP STREAM (LOGOR SHORTOP OP)))
					  (T (APPENDBYTE.IP STREAM (LOGOR LONGOP (FOLDLO OP 256)))
					     (APPENDBYTE.IP STREAM (MOD OP 256])
)

[DECLARE: EVAL@COMPILE 

(RECORD IPSTREAM STREAM (SUBRECORD STREAM)
			[ACCESSFNS ((IPDATA (fetch (STREAM IMAGEDATA) of DATUM)
					    (replace (STREAM IMAGEDATA) of DATUM with NEWVALUE))
				    (SHOWSTREAM (fetch (IPSTREAM IPDATA) of DATUM)
						(replace (IPSTREAM IPDATA) of DATUM with NEWVALUE]
			(TYPE? (type? INTERPRESSDATA of (fetch (STREAM IMAGEDATA) of DATUM))))

(DATATYPE INTERPRESSDATA (IPHEADING IPXPOS IPYPOS IPFONT IPFONTNUMBER IPFONTARRAY IPPAGEFONTS 
				    IPWIDTHSCACHE IPCOLOR IPLINEFEED IPPAGESTATE IPOUTSTREAM 
				    IPSHOWSTREAM XIPPAGEREGION (IPWIDTH WORD)
				    (IPHEIGHT WORD)
				    (IPPAGENUM WORD)
				    (IPNEXTFRAMEVAR BYTE)
				    (IPHEADINGOPVAR BYTE))
			 IPXPOS ← 0 IPYPOS ← 0 IPFONTNUMBER ← 1 IPNEXTFRAMEVAR ← 0 
                                                             (* We assume that the origin is translated to the 
							     bottom-left of the page region)
			 [ACCESSFNS ((IPLEFT (PROGN 0))
				     (IPBOTTOM (PROGN 0))
				     (IPRIGHT (fetch (INTERPRESSDATA IPWIDTH) of DATUM))
				     (IPTOP (fetch (INTERPRESSDATA IPHEIGHT) of DATUM))
				     (IPPAGEREGION (fetch (INTERPRESSDATA XIPPAGEREGION)
						      of DATUM)
						   (PROGN (replace (INTERPRESSDATA XIPPAGEREGION)
							     of DATUM with NEWVALUE)
							  (replace (INTERPRESSDATA IPWIDTH)
							     of DATUM with (fetch (REGION WIDTH)
									      of NEWVALUE))
							  (replace (INTERPRESSDATA IPHEIGHT)
							     of DATUM with (fetch (REGION HEIGHT)
									      of NEWVALUE])
]
(/DECLAREDATATYPE (QUOTE INTERPRESSDATA)
		  (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
				  POINTER POINTER POINTER POINTER POINTER WORD WORD WORD BYTE BYTE)))
)
(/DECLAREDATATYPE (QUOTE INTERPRESSDATA)
		  (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
				  POINTER POINTER POINTER POINTER POINTER WORD WORD WORD BYTE BYTE)))
(DEFINEQ

(IP.LISTFILES1
  [LAMBDA (FILE COPIES HOST HEADING #SIDES)                  (* ecc "22-JUN-83 14:12")
    (PROG (IPFILE (FULLFILENAME (FINDFILE FILE)))
          (RESETLST [RESETSAVE NIL (LIST (FUNCTION DELFILE)
					 (CADR (SETQ IPFILE (MAKEINTERPRESS FULLFILENAME
									    (QUOTE {CORE}TEMP.IP)
									    NIL HEADING]
		    (NSPRINT HOST (CADR IPFILE)
			     (CAR IPFILE)
			     (GETFILEINFO (CAR IPFILE)
					  (QUOTE ICREATIONDATE))
			     NIL NIL COPIES NIL NIL NIL (EQ (OR #SIDES EMPRESS#SIDES)
							    2)))
          (RETURN FULLFILENAME])
)
(DEFINEQ

(INTERPRESSBITMAP
  [LAMBDA (OUTPUTFILE BITMAP SCALEFACTOR REGION ROTATION TITLE)
                                                             (* edited: " 1-AUG-83 22:50")
    (OR BITMAP (SETQ BITMAP (SCREENBITMAP)))
    (PROG [[IPSTREAM (OPENIPSTREAM (OR OUTPUTFILE (QUOTE {CORE}IPBITMAP.SCRATCH]
	   [W (COND
		(REGION (fetch (REGION WIDTH) of REGION))
		(T (fetch BITMAPWIDTH of BITMAP]
	   (H (COND
		(REGION (fetch (REGION HEIGHT) of REGION))
		(T (fetch BITMAPHEIGHT of BITMAP]
          (COND
	    (TITLE (IP.PRINTCENTERED TITLE IPSTREAM)
		   (SHOW.IP IPSTREAM)))                      (* Try to center around within the pageframe margins)
          [COND
	    (SCALEFACTOR (SETQ W (\RTIMES2 W SCALEFACTOR))
			 (SETQ H (\RTIMES2 H SCALEFACTOR]
          (SELECTQ (SETQ ROTATION (IMOD (OR ROTATION DEFAULT.INTERPRESS.BITMAP.ROTATION)
					360))
		   (0 (SETQ W (\RTIMES2 -1 W))
		      (SETQ H (\RTIMES2 -1 H)))
		   [270 (SETQ W (PROG1 H (SETQ H (\RTIMES2 -1 W]
		   (180)
		   [90 (SETQ H (PROG1 (\RTIMES2 -1 W)
				      (SETQ W (\RTIMES2 -1 H]
		   (ERROR ROTATION "rotation by other than multiples of 90 degrees not implemented"))
          [SETXY.IP IPSTREAM [\RPLUS2 (\RTIMES2 MICASPERINCH 3)
				      (\RTIMES2 W (CONSTANT (\RTIMES2 MICASPERPOINT ONEHALF]
		    (\RPLUS2 (\RTIMES2 MICASPERINCH 4.75)
			     (\RTIMES2 H (CONSTANT (\RTIMES2 MICASPERPOINT ONEHALF]
          (SHOWBITMAP.IP IPSTREAM BITMAP REGION SCALEFACTOR ROTATION)
          (RETURN (CLOSEF IPSTREAM])

(IP.SCALEFACTOR
  [LAMBDA (X Y)                                              (* lmm "14-JUN-83 03:25")

          (* this function is called when we hardcopy a bitmap which is X by Y pixels, and returns the scale factor which 
	  will cause it to fit on a page. This code assumes us paper (8.5 x 11) dimensions and a 1 inch margin, and that the
	  default scale factor of (1) is approximately screen resolution, i.e., 80 points per inch)


    (PROG [(RATIO (MIN (FQUOTIENT (RATIONALTOINTEGER (\RTIMES2 POINTSPERINCH 9.5))
				  X)
		       (FQUOTIENT (RATIONALTOINTEGER (\RTIMES2 7.5 POINTSPERINCH))
				  Y]
          (RETURN (COND
		    ((GEQ RATIO 1)
		      1)
		    ((GEQ RATIO .5)
		      .5)
		    ((GEQ RATIO .25)
		      .25)
		    (T RATIO])

(IP.PRIN3
  [LAMBDA (X STREAM)                                         (* rmk: "13-JUL-82 01:10")

          (* Puts out the characters in X on the Interpress stream. Used in place of PRIN3, cause PRIN3 cause the OUTCHARFN 
	  and therefore does a SHOW, which is not what we intend.)


    (for C instring (MKSTRING X) do (\BOUT STREAM C])

(IP.PRINTCENTERED
  [LAMBDA (STRING IPSTREAM)                                  (* lmm " 2-AUG-82 22:34")
    [SETXREL.IP IPSTREAM (IDIFFERENCE (TIMES 4 MICASPERINCH)
				      (STRINGWIDTH STRING (ELT (fetch IPFONTARRAY
								  of (fetch IPDATA of IPSTREAM))
							       (fetch IPFONTNUMBER
								  of (fetch IPDATA of IPSTREAM]
    (PRIN1 STRING IPSTREAM])
)

(ADDTOVAR PRINTERMODES (INTERPRESS (PRINTER.BITMAPFILE . INTERPRESSBITMAP)
				   ((MOVD (QUOTE IP.LISTFILES1)
					  (QUOTE LISTFILES1)))
				   (PRINTINGHOSTFORM . NS.DEFAULT.PRINTER)
				   (PRINTER.SENDTOPRINTER . IP.SENDTOPRINTER)
				   (PRINTER.BITMAPSCALE . IP.SCALEFACTOR)
				   (TEditHcpyMode . INTERPRESS)))

(RPAQQ DEFAULT.INTERPRESS.BITMAP.ROTATION 90)

(ADDTOVAR LITATOM.HIT.LIST APPENDBYTE.IP APPENDIDENTIFYER.IP APPENDINT.IP APPENDINTEGER.IP 
					 APPENDLARGEVECTOR.IP APPENDLISPSTRING.IP APPENDNUMBER.IP 
					 APPENDOP.IP APPENDRATIONAL.IP APPENDSEQUENCEDESCRIPTOR.IP 
					 BYTESININT.IP EXTRACTBYTE.IP BEGINMASTER.IP BEGINPAGE.IP 
					 BEGINPREAMBLE.IP CONCATT.IP CONCAT.IP ENDMASTER.IP 
					 ENDPAGE.IP ENDPREAMBLE.IP FGET.IP FSET.IP GETFRAMEVAR.IP 
					 INITIALIZEMASTER.IP SHOWSTRING.IP \RTIMES2 \RPLUS2 RMINUS 
					 CREATERATIONAL RATIONALTOINTEGER)
(PUTPROPS INTERPRESS COPYRIGHT ("Xerox Corporation" 1983))
STOP