(FILECREATED "13-Mar-85 18:21:17" {ERIS}<LISPCORE>SOURCES>INTERPRESS.;127 103391 

      changes to:  (FNS \IPCURVE2)

      previous date: "12-Mar-85 15:20:47" {ERIS}<LISPCORE>SOURCES>INTERPRESS.;125)


(* Copyright (c) 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT INTERPRESSCOMS)

(RPAQQ INTERPRESSCOMS [(* "Literal interface")
	[DECLARE: DONTCOPY (* "Change or remove when full IP-82 exists on printers")
		  (CONSTANTS (ENCODING (QUOTE IP-82]
	(INITVARS (CHARACTERCODEVERSION (QUOTE XC1-1-1))
		  (INTERPRESSVERSION "2.1"))
	[COMS (DECLARE: DONTCOPY (CONSTANTS * RATIONALS)
			(* "MICASPERINCH is used by HARDCOPY")
			(EXPORT (CONSTANTS (MICASPERINCH 2540]
	(FNS APPENDBYTE.IP APPENDIDENTIFIER.IP APPENDINT.IP APPENDINTEGER.IP APPENDLARGEVECTOR.IP 
	     APPENDNUMBER.IP APPENDOP.IP APPENDRATIONAL.IP APPENDSEQUENCEDESCRIPTOR.IP BYTESININT.IP 
	     EXTRACTBYTE.IP)
	(* "Operator interface")
	(FNS BEGINMASTER.IP BEGINPAGE.IP BEGINPREAMBLE.IP CONCAT.IP CONCATT.IP ENDMASTER.IP 
	     ENDPAGE.IP ENDPREAMBLE.IP FGET.IP FILLTRAJECTORY.IP FSET.IP GETFRAMEVAR.IP 
	     INITIALIZEMASTER.IP ISET.IP LINETO.IP MASKSTROKE.IP MOVETO.IP ROTATE.IP SCALE.IP 
	     SCALE2.IP SETFONT.IP SETSPACE.IP SETXREL.IP SETX.IP SETXY.IP SETXYREL.IP SETY.IP 
	     SETYREL.IP SHOW.IP TRAJECTORY.IP TRANS.IP TRANSLATE.IP)
	(* DIG interface)
	(FNS DEFINEFONT.IP FONTNAME.IP HEADINGOP.IP INTERPRESS.BITMAPSCALE INTERPRESS.OUTCHARFN 
	     INTERPRESSFILEP MAKEINTERPRESS NEWLINE.IP NEWPAGE.IP NEWPAGE?.IP OPENIPSTREAM 
	     SETUPFONTS.IP SHOWBITMAP.IP SHOWBITMAP1.IP SHOWSHADE.IP \BITBLT.IP \SCALEDBITBLT.IP 
	     \BLTSHADE.IP \CHARWIDTH.IP \CLOSEIPSTREAM \DRAWCIRCLE.IP \DRAWCURVE.IP \IPCURVE2 
	     \DRAWELLIPSE.IP \DRAWLINE.IP \DSPBOTTOMMARGIN.IP \DSPFONT.IP \DSPLEFTMARGIN.IP 
	     \DSPLINEFEED.IP \DSPRIGHTMARGIN.IP \DSPSPACEFACTOR.IP \DSPTOPMARGIN.IP \DSPXPOSITION.IP 
	     \DSPYPOSITION.IP \FIXLINELENGTH.IP \MOVETO.IP \SETBRUSH.IP \STRINGWIDTH.IP 
	     \DSPCLIPPINGREGION.IP)
	(FNS \INTERPRESSINIT)
	(FNS SCALEREGION)
	[DECLARE: DONTEVAL@LOAD DOCOPY (INITVARS (DEFAULTPAGEREGION (SCALEREGION 2540
										 (CREATEREGION
										   1.1 .75
										   (FDIFFERENCE
										     7.5 1.1)
										   (FDIFFERENCE
										     10.5 .75]
	(* "Interpress encoding values")
	(DECLARE: DONTCOPY (CONSTANTS MAXSEGSPERTRAJECTORY)
		  (CONSTANTS * NONPRIMS)
		  (CONSTANTS * SEQUENCETYPES)
		  (CONSTANTS * IPTYPES)
		  (CONSTANTS * OPERATORS)
		  (CONSTANTS * TOKENFORMATS)
		  (CONSTANTS * IMAGERVARIABLES)
		  (CONSTANTS * STROKEENDS)
		  (CONSTANTS * IP82CONSTANTS))
	(DECLARE: DONTCOPY (MACROS APPENDBYTE.IP APPENDOP.IP .IPFONTNAME.)
		  (RECORDS IPSTREAM INTERPRESSDATA))
	(INITRECORDS IPSTREAM INTERPRESSDATA)
	(FNS INTERPRESSBITMAP)
	(ALISTS (IMAGESTREAMTYPES INTERPRESS))
	[ADDVARS [PRINTERTYPES ((INTERPRESS 8044)
				(CANPRINT (INTERPRESS))
				(STATUS NSPRINTER.STATUS)
				(PROPERTIES NSPRINTER.PROPERTIES)
				(SEND NSPRINT)
				(BITMAPSCALE INTERPRESS.BITMAPSCALE)
				(BITMAPFILE (INTERPRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION 
							      TITLE]
		 (PRINTFILETYPES (INTERPRESS (TEST INTERPRESSFILEP)
					     (EXTENSION (IP IPR INTERPRESS))
					     (CONVERSION (TEXT MAKEINTERPRESS TEDIT
							       (LAMBDA (FILE PFILE)
								       (SETQ FILE (OPENTEXTSTREAM
									       FILE))
								       (TEDIT.FORMAT.HARDCOPY
									 FILE PFILE T NIL NIL NIL
									 (QUOTE INTERPRESS))
								       (CLOSEF? FILE)
								       PFILE]
	(INITVARS (DEFAULT.INTERPRESS.BITMAP.ROTATION 90))
	(ALISTS (SYSTEMINITVARS INTERPRESSFONTDIRECTORIES))
	(INITVARS (INTERPRESSFONTDIRECTORIES (QUOTE {ERIS}<LISP>FONTS>)))
	(COMS (* "NS Character Encoding")
	      (FNS NSMAP \COERCEASCIITONSFONT \CREATEINTERPRESSFONT \SEARCHINTERPRESSFONTS)
	      (INITVARS (ASCIITONSTRANSLATIONS))
	      (* "Catch the GACHA10 and any BI coercions to MODERN")
	      (ADDVARS (ASCIITONSTRANSLATIONS (TIMESROMAN NIL CLASSIC)
					      (GACHA NIL TERMINAL)
					      (HELVETICA)
					      (CLASSIC)
					      (GACHA)
					      (TIMESROMAN)
					      (LOGO NIL LOGOTYPES)
					      (HIPPO HIPPOTONSARRAY CLASSIC)
					      (CYRILLIC CYRILLICTONSARRAY CLASSIC)
					      (SYMBOL \SYMBOLTONSARRAY MODERN)))
	      (UGLYVARS \SYMBOLTONSARRAY HIPPOTONSARRAY CYRILLICTONSARRAY))
	(DECLARE: DONTEVAL@LOAD DOCOPY (P (\INTERPRESSINIT])



(* "Literal interface")

(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 

(RPAQQ ENCODING IP-82)

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

(RPAQ? CHARACTERCODEVERSION (QUOTE XC1-1-1))

(RPAQ? INTERPRESSVERSION "2.1")
(DECLARE: DONTCOPY 

(RPAQQ RATIONALS (METERSPERRAVENSPOT MICASPERSCREENPOINT SCREENPOINTSPERMICA
				     (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 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 (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)
)

(* FOLLOWING DEFINITIONS EXPORTED)


(DECLARE: EVAL@COMPILE 

(RPAQQ MICASPERINCH 2540)

(CONSTANTS (MICASPERINCH 2540))
)


(* END EXPORTED DEFINITIONS)

)
(DEFINEQ

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

(APPENDIDENTIFIER.IP
  [LAMBDA (STREAM STRING)                                    (* jds "14-Mar-84 10:42")
                                                             (* Put an identifier into the IP file.
							     NB that the characters in the identifier are ASCII, NOT
							     NS CHARACTERS!!!!)
    (APPENDSEQUENCEDESCRIPTOR.IP STREAM SEQIDENTIFIER (NCHARS STRING))
    (for C instring (MKSTRING STRING) do (\BOUT STREAM C])

(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])

(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)                                         (* jds " 4-Dec-84 17:58")
    (APPENDOP.IP IPSTREAM BEGINMASTER])

(BEGINPAGE.IP
  [LAMBDA (IPSTREAM)                                         (* rmk: "22-SEP-83 22:29")
    (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])

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

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

(ENDMASTER.IP
  [LAMBDA (IPSTREAM)                                         (* jds " 4-Dec-84 17:58")
                                                             (* Put out the token to end the master)
    (APPENDOP.IP IPSTREAM ENDMASTER])

(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: "22-SEP-83 22:03")
    (PROG ((IPDATA (fetch IPDATA of IPSTREAM)))
          (replace IPPREAMBLEFONTS of IPDATA with (DREVERSE (fetch IPPAGEFONTS of IPDATA)))
                                                             (* Reverse on tenuous assumption that first fonts are 
							     more frequent)
          (replace IPPREAMBLENEXTFRAMEVAR of IPDATA with (fetch IPNEXTFRAMEVAR of IPDATA))
          (UNINTERRUPTABLY
              (APPENDOP.IP IPSTREAM ENDPREAMBLE)
	      (replace IPPAGESTATE of IPDATA 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: "18-AUG-83 17:50")
    (PROG [(FV (fetch IPNEXTFRAMEVAR of (fetch IPDATA of IPSTREAM]
          (replace IPNEXTFRAMEVAR of (fetch IPDATA of IPSTREAM) with (ADD1 FV))
          (RETURN FV])

(INITIALIZEMASTER.IP
  [LAMBDA (IPSTREAM)                                         (* jds "10-Jan-85 15:48")
    [for I from 1 do (\BOUT IPSTREAM (OR (NTHCHARCODE NOVERSIONENCODINGSTRING I)
					 (RETURN]
    [for I from 1 do (\BOUT IPSTREAM (OR (NTHCHARCODE INTERPRESSVERSION I)
					 (RETURN]
    (\BOUT IPSTREAM (CHARCODE SPACE])

(ISET.IP
  [LAMBDA (IPSTREAM IVAR)                                    (* rmk: "18-Oct-84 12:52")
                                                             (* Sets the imager variable IVAR to the top of stack)
    (APPENDINTEGER.IP IPSTREAM IVAR)
    (APPENDOP.IP IPSTREAM ISET])

(LINETO.IP
  [LAMBDA (IPSTREAM X Y)                                     (* rmk: "19-Oct-84 08:50")
    (APPENDNUMBER.IP IPSTREAM (COND
		       ((FLOATP X)
			 (FIXR X))
		       (T X)))
    (APPENDNUMBER.IP IPSTREAM (COND
		       ((FLOATP Y)
			 (FIXR Y))
		       (T Y)))
    (APPENDOP.IP IPSTREAM LINETO])

(MASKSTROKE.IP
  [LAMBDA (IPSTREAM)                                         (* rmk: "14-Jun-84 16:00")
    (APPENDOP.IP IPSTREAM MASKSTROKE])

(MOVETO.IP
  [LAMBDA (IPSTREAM X Y)                                     (* rmk: "19-Oct-84 08:49")
    (APPENDNUMBER.IP IPSTREAM (COND
		       ((FLOATP X)
			 (FIXR X))
		       (T X)))
    (APPENDNUMBER.IP IPSTREAM (COND
		       ((FLOATP Y)
			 (FIXR Y))
		       (T 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: "15-Jun-84 12:21")
    (APPENDNUMBER.IP IPSTREAM S)
    (APPENDOP.IP IPSTREAM SCALE.OP])

(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)                                 (* rmk: "20-AUG-83 14:03")
    (APPENDNUMBER.IP IPSTREAM FONTNUM)
    (APPENDOP.IP IPSTREAM SETFONT)
    (PROG ((IPDATA (fetch IPDATA of IPSTREAM)))
          (replace IPFONT of IPDATA with (for X in (fetch IPPAGEFONTS of IPDATA)
					    when (EQ FONTNUM (CDR X)) do (RETURN (CAR X))
					    finally (ERROR "Undefined font number"])

(SETSPACE.IP
  [LAMBDA (IPSTREAM SPACEWIDTH)                              (* rmk: "11-Dec-83 21:12")
    (APPENDNUMBER.IP IPSTREAM SPACEWIDTH)
    (APPENDOP.IP IPSTREAM SPACE])

(SETXREL.IP
  [LAMBDA (IPSTREAM DX)                                      (* jds " 5-Oct-84 10:35")
                                                             (* Move by DX in the X direction)
    (APPENDNUMBER.IP IPSTREAM DX)
    (APPENDOP.IP IPSTREAM SETXREL)
    (change (fetch IPXPOS of (fetch IPDATA of IPSTREAM))
	    (\RPLUS2 DX DATUM))
    (replace IPCORRECTSTARTX of (fetch IPDATA of IPSTREAM) with (fetch IPXPOS
								   of (fetch IPDATA of IPSTREAM])

(SETX.IP
  [LAMBDA (IPSTREAM X)                                       (* rmk: "19-Oct-84 08:54")
                                                             (* Move to X, without changing Y.)
    (COND
      ((NUMBERP X)
	[APPENDINTEGER.IP IPSTREAM (IDIFFERENCE (COND
						  ((FLOATP X)
						    (SETQ X (FIXR X)))
						  (T X))
						(fetch IPXPOS of (fetch IPDATA of IPSTREAM]
	(APPENDOP.IP IPSTREAM SETXREL))
      (T (APPENDNUMBER.IP IPSTREAM X)                        (* If not a fixp, let the rational/floating 
							     substraction be done by the printer)
	 (APPENDNUMBER.IP IPSTREAM (fetch IPYPOS of (fetch IPDATA of IPSTREAM)))
	 (APPENDOP.IP IPSTREAM SETXY)))
    (replace IPXPOS of (fetch IPDATA of IPSTREAM) with X)
    (replace IPCORRECTSTARTX of (fetch IPDATA of IPSTREAM) with X])

(SETXY.IP
  [LAMBDA (IPSTREAM X Y)                                     (* rmk: "19-Oct-84 08:50")
                                                             (* Move to (X,Y) on the page.)
    (APPENDNUMBER.IP IPSTREAM (COND
		       ((FLOATP X)
			 (SETQ X (FIXR X)))
		       (T X)))
    (APPENDNUMBER.IP IPSTREAM (COND
		       ((FLOATP Y)
			 (SETQ Y (FIXR Y)))
		       (T Y)))
    (APPENDOP.IP IPSTREAM SETXY)
    (replace IPXPOS of (fetch IPDATA of IPSTREAM) with X)
    (replace IPCORRECTSTARTX of (fetch IPDATA of IPSTREAM) with X)
                                                             (* Remember our last location, so we can CORRECT 
							     character widths.)
    (replace IPYPOS of (fetch IPDATA of IPSTREAM) with Y])

(SETXYREL.IP
  [LAMBDA (IPSTREAM DX DY)                                   (* rmk: " 8-Oct-84 14:22")
                                                             (* Move by (DX,DY) on the page.)
    (APPENDNUMBER.IP IPSTREAM DX)
    (APPENDNUMBER.IP IPSTREAM DY)
    (APPENDOP.IP IPSTREAM SETXYREL)
    (change (fetch IPXPOS of (fetch IPDATA of IPSTREAM))
	    (\RPLUS2 DATUM DX))
    (change (fetch IPYPOS of (fetch IPDATA of IPSTREAM))
	    (\RPLUS2 DATUM DY))                              (* Remember the new X location so we can CORRECT 
							     character widths)
    (replace IPCORRECTSTARTX of (fetch IPDATA of IPSTREAM) with (fetch IPXPOS
								   of (fetch IPDATA of IPSTREAM])

(SETY.IP
  [LAMBDA (IPSTREAM Y)                                       (* rmk: "19-Oct-84 08:54")
    (COND
      ((NUMBERP Y)
	[APPENDINTEGER.IP IPSTREAM (IDIFFERENCE (COND
						  ((FLOATP Y)
						    (SETQ Y (FIXR Y)))
						  (T Y))
						(fetch IPYPOS of (fetch IPDATA of IPSTREAM]
	(APPENDOP.IP IPSTREAM SETYREL))
      (T (APPENDNUMBER.IP IPSTREAM (fetch IPXPOS of (fetch IPDATA of IPSTREAM)))
                                                             (* If not a fixp, let the rational/floating 
							     substraction be done by the printer)
	 (APPENDNUMBER.IP IPSTREAM Y)
	 (APPENDOP.IP IPSTREAM SETXY)))
    (replace IPYPOS of (fetch IPDATA of IPSTREAM) with 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)                                         (* JonL " 4-Jan-85 16:10")
                                                             (* Shows a string buffered away in SHOWSTREAM)
    (PROG (LEN SHOWSTREAM (IPDATA (ffetch IPDATA of IPSTREAM)))
          (SETQ SHOWSTREAM (ffetch IPSHOWSTREAM of IPDATA))
          (SETQ LEN (\GETFILEPTR SHOWSTREAM))
          (COND
	    ((IGREATERP LEN 0)                               (* Only bother if there ARE characters to put out.)
	      [APPENDNUMBER.IP IPSTREAM (\RPLUS2 (ffetch IPXPOS of IPDATA)
						 (\RMINUS (ffetch IPCORRECTSTARTX of IPDATA]
                                                             (* Set up the measures for the CORRECT op, so the 
							     characters come out the right width)
	      (APPENDINTEGER.IP IPSTREAM 0)
	      (APPENDOP.IP IPSTREAM SETCORRECTMEASURE)
	      (APPENDOP.IP IPSTREAM CORRECT)
	      (APPENDOP.IP IPSTREAM {)                       (* Put the SHOW inside a block, so the CORRECT will 
							     affect it.)
	      (APPENDSEQUENCEDESCRIPTOR.IP IPSTREAM SEQSTRING LEN)
	      (COPYBYTES SHOWSTREAM IPSTREAM 0 LEN)
	      (APPENDOP.IP IPSTREAM SHOW)
	      (APPENDOP.IP IPSTREAM })                       (* End of the block affected by the CORRECT)
	      (\SETFILEPTR SHOWSTREAM 0)                     (* Clear out the holding stream for characters)
	      (freplace IPCORRECTSTARTX of IPDATA with (ffetch IPXPOS of IPDATA))
                                                             (* And notice out new real location for future 
							     CORRECTs.)
	      (freplace NSCHARSET of IPDATA with 0])

(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])

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

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



(* DIG interface)

(DEFINEQ

(DEFINEFONT.IP
  [LAMBDA (IPSTREAM FONT)                                    (* rmk: "19-Oct-84 11:13")
    (PROG (FRAMEVAR (IPDATA (fetch IPDATA of IPSTREAM)))
          (for N from 0 as ID in (FONTNAME.IP FONT) do (APPENDIDENTIFIER.IP IPSTREAM ID)
	     finally (APPENDINTEGER.IP IPSTREAM N)
		     (APPENDOP.IP IPSTREAM MAKEVEC))
          (APPENDOP.IP IPSTREAM FINDFONT)
          [SCALE.IP IPSTREAM (\RTIMES2 MICASPERPOINT (FONTPROP FONT (QUOTE DEVICESIZE]
          (APPENDOP.IP IPSTREAM MODIFYFONT)
          (SETQ FRAMEVAR (GETFRAMEVAR.IP IPSTREAM))
          (FSET.IP IPSTREAM FRAMEVAR)
          (RETURN (CAR (push (fetch IPPAGEFONTS of IPDATA)
			     (CONS FONT FRAMEVAR])

(FONTNAME.IP
  [LAMBDA (FONTDESC)                                         (* rmk: "22-Dec-84 11:42")
                                                             (* Convert a Lisp font name to the proper NS font name)
    (PROG (FACE NAME)
          [COND
	    ((EQ (QUOTE ITALIC)
		 (FONTPROP FONTDESC (QUOTE DEVICESLOPE)))
	      (SETQ FACE (QUOTE (-Italic]
          [COND
	    ((EQ (QUOTE BOLD)
		 (FONTPROP FONTDESC (QUOTE DEVICEWEIGHT)))
	      (push FACE (QUOTE -Bold]
          (SETQ NAME (FONTPROP FONTDESC (QUOTE DEVICEFAMILY)))
          [COND
	    (FACE (SETQ NAME (PACK (CONS NAME FACE]
          (RETURN (LIST (QUOTE XEROX)
			CHARACTERCODEVERSION NAME])

(HEADINGOP.IP
  [LAMBDA (IPSTREAM HEADING)                                 (* rmk: " 5-Oct-84 08:47")
                                                             (* 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 (fetch IPHEADINGFONT of IPDATA)
						      (QUOTE ASCENT]
		     (SETFONT.IP IPSTREAM HEADINGFONTNUMBER)
		     (PRIN3 HEADING IPSTREAM)
		     (SHOW.IP IPSTREAM)
		     (RELMOVETO MICASPERINCH 0 IPSTREAM)     (* Skip an inch before page number)
		     (PRIN3 "Page " IPSTREAM)                (* Show the page number argument 
							     (from stack))
		     (TERPRI IPSTREAM)                       (* Skip 2 lines--have to pick up the linefeed from the 
							     heading font)
		     (TERPRI IPSTREAM)))
          (APPENDOP.IP IPSTREAM })
          (FSET.IP IPSTREAM (replace IPHEADINGOPVAR of IPDATA with (GETFRAMEVAR.IP IPSTREAM])

(INTERPRESS.BITMAPSCALE
  [LAMBDA (WIDTH HEIGHT)                                     (* lmm " 3-OCT-83 21:31")
    (PROG [(RATIO (MIN (FQUOTIENT (TIMES POINTSPERINCH 9.5)
				  WIDTH)
		       (FQUOTIENT (TIMES POINTSPERINCH 7.5)
				  HEIGHT]
          (RETURN (COND
		    ((GEQ RATIO 1)
		      1)
		    ((GEQ RATIO .5)
		      .5)
		    ((GEQ RATIO .25)
		      .25)
		    (T RATIO])

(INTERPRESS.OUTCHARFN
  [LAMBDA (IPSTREAM CHARCODE)                                (* rmk: " 3-Dec-84 11:10")
    (PROG (NSCODE (IPDATA (ffetch IPDATA of IPSTREAM)))
          (SETQ NSCODE (\GETBASE (ffetch NSTRANSTABLE of IPDATA)
				 CHARCODE))                  (* Select on NSCODE, since ↑L etc might be graphic in 
							     some ascii fonts)
          (SELCHARQ NSCODE
		    (EOL (NEWLINE.IP IPSTREAM))
		    [LF (\DSPXPOSITION.IP IPSTREAM (PROG1 (\DSPXPOSITION.IP IPSTREAM)
							  (NEWLINE.IP IPSTREAM]
		    (↑L (NEWPAGE.IP IPSTREAM))
		    (PROGN [add (ffetch IPXPOS of IPDATA)
				(COND
				  ((EQ NSCODE (CHARCODE SPACE))
				    (ffetch IPSPACEWIDTH of IPDATA))
				  (T (\FGETWIDTH (ffetch IPWIDTHSCACHE of IPDATA)
						 CHARCODE]   (* Assume the widths for the untranslated code 
							     correspond to the translated character)
			   [COND
			     ((NEQ (\CHARSET NSCODE)
				   (ffetch NSCHARSET of IPDATA))
			       (\BOUT (ffetch IPSHOWSTREAM of IPDATA)
				      NSCHARSETSHIFT)        (* Switch character set)
			       (\BOUT (ffetch IPSHOWSTREAM of IPDATA)
				      (\CHARSET NSCODE))
			       (freplace NSCHARSET of IPDATA with (\CHARSET NSCODE]
			   (\BOUT (ffetch IPSHOWSTREAM of IPDATA)
				  (\CHAR8CODE NSCODE])

(INTERPRESSFILEP
  [LAMBDA (FILE NOOPEN)                                      (* jds "18-Feb-85 09:41")
                                                             (* Returns fullname of FILE if it looks like an 
							     Interpress file)
    (OR (EQ (GETFILEINFO FILE (QUOTE FILETYPE))
	    FILETYPE.INTERPRESS)
	(RESETLST (PROG (STRM)
		        [COND
			  ((SETQ STRM (\GETSTREAM FILE (QUOTE INPUT)
						  T))
			    (OR (RANDACCESSP STRM)
				(RETURN))
			    (RESETSAVE NIL (LIST (QUOTE SETFILEPTR)
						 STRM
						 (GETFILEPTR STRM)))
			    (SETFILEPTR STRM 0))
			  (NOOPEN (RETURN))
			  (T (RESETSAVE (SETQ STRM (OPENSTREAM FILE (QUOTE INPUT)
							       (QUOTE OLD)
							       8))
					(QUOTE (PROGN (CLOSEF? OLDVALUE]
		        (RETURN (for I from 1 to (CONSTANT (NCHARS NOVERSIONENCODINGSTRING))
				   when (OR (EOFP STRM)
					    (NEQ (NTHCHARCODE NOVERSIONENCODINGSTRING I)
						 (BIN STRM)))
				   do (RETURN NIL) finally (RETURN (FULLNAME STRM])

(MAKEINTERPRESS
  [LAMBDA (FILE IPFILE FONTS HEADING TABS)                   (* rmk: "15-Sep-84 02:33")
    (TEXTTOIMAGEFILE FILE IPFILE (QUOTE INTERPRESS)
		     FONTS HEADING TABS])

(NEWLINE.IP
  [LAMBDA (IPSTREAM)                                         (* rmk: " 4-Oct-84 09:21")
                                                             (* Doesn't check for page overflow--wait until 
							     something is actually shown.)
    (SHOW.IP IPSTREAM)
    (PROG (NEWYPOS (IPDATA (ffetch IPDATA of IPSTREAM)))
          (SETQ NEWYPOS (IPLUS (ffetch IPYPOS of IPDATA)
			       (ffetch IPLINEFEED of IPDATA)))
          (COND
	    ((ILESSP NEWYPOS (fetch IPBOTTOM of IPDATA))
	      (NEWPAGE.IP IPSTREAM))
	    (T (SETXY.IP IPSTREAM (ffetch IPLEFT of IPDATA)
			 NEWYPOS])

(NEWPAGE.IP
  [LAMBDA (IPSTREAM)                                         (* rmk: "18-Oct-84 17:41")
    (PROG (CFONT HFONT (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
	    [(fetch IPHEADING of IPDATA)
	      (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)
					(IDIFFERENCE (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)
			 (IDIFFERENCE (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 0)                      (* Set up so that CORRECTs have to be exact.)
          (APPENDINTEGER.IP IPSTREAM 0)
          (APPENDOP.IP IPSTREAM SETCORRECTTOLERANCE)
          (if (NOT (EQP 1 (ffetch IPSPACEFACTOR of IPDATA)))
	      then                                           (* Imager variables revert to initial values)
		   (APPENDNUMBER.IP IPSTREAM (ffetch IPSPACEFACTOR of IPDATA))
		   (ISET.IP IPSTREAM AMPLIFYSPACE))
          (\DSPFONT.IP IPSTREAM CFONT])

(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 OPTIONS)                                   (* jds "21-Feb-85 16:44")

          (* Opens an interpress stream, to which user can do OUTCHAR to. The FONTS option can be a list of fonts to be set up
	  in the preamble. Headings will be printed in the first font in that list. If that list is NIL, then the stream is 
	  initialized with the INTERPRESS DEFAULTFONT)


    (DECLARE (GLOBALVARS DEFAULTPAGEREGION \IPIMAGEOPS \NOIMAGEOPS))
    (PROG [OPT IPDATA (IPSTREAM (OPENSTREAM IPFILE (QUOTE OUTPUT)
					    (QUOTE NEW)
					    NIL
					    (QUOTE ((TYPE INTERPRESS]
          [SETQ IPDATA (create INTERPRESSDATA
			       IPPAGEREGION ←(COND
				 ([type? REGION (SETQ OPT (LISTGET OPTIONS (QUOTE REGION]
				   OPT)
				 (T DEFAULTPAGEREGION))
			       IPSHOWSTREAM ←(PROG1 (\OPENFILE (QUOTE {NODIRCORE})
							       (QUOTE BOTH)
							       (QUOTE OLD/NEW))
                                                             (* Make sure the fileptr of the following is zero 
							     (GETRESOURCE \IPSHOWSTREAM) 
							     (and free this in CLOSEIPSTREAM))
						    )
			       IPDOCNAME ←(LISTGET OPTIONS (QUOTE DOCUMENT.NAME]
          (COND
	    ((OR (NEQ \NOIMAGEOPS (fetch (IPSTREAM IMAGEOPS) of IPSTREAM))
		 (NEQ 0 (GETEOFPTR IPSTREAM)))
	      (ERROR "can't convert existing file to Interpress" (FULLNAME IPSTREAM))
                                                             (* GETEOFPTR might bomb on some streams)
	      ))
          (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)
          (COND
	    ((SETQ OPT (LISTGET OPTIONS (QUOTE HEADING)))
	      (replace IPHEADING of IPDATA with OPT)
	      (SELECTQ ENCODING
		       (FULLIP-82 (HEADINGOP.IP IPSTREAM OPT))
		       (GETFRAMEVAR.IP IPSTREAM)))
	    (T (GETFRAMEVAR.IP IPSTREAM)))

          (* Allocate framevar 0, for heading op if there is one, otherwise for nothing. This means that the fonts will be in 
	  framevars that correspond to their position in PREAMBLEFONTS. MAKEINTERPRESS relies on this.)


          (SETUPFONTS.IP IPSTREAM (LISTGET OPTIONS (QUOTE FONTS)))
          (NEWPAGE.IP IPSTREAM)                              (* NEWPAGE automatically closes the preamble)
          (RETURN IPSTREAM])

(SETUPFONTS.IP
  [LAMBDA (IPSTREAM FONTS)                                   (* rmk: "15-Sep-84 02:16")

          (* Sets up preamble fonts, and sets heading font. Leaves IPFONT as NIL. This means that \DSPFONT.IP of the heading 
	  font will establish that as the current font when the preamble is closed and the first page opens.
	  NIL. Note that the preamble can't set the font imager variable.)


    (for F (IPDATA ←(fetch IPDATA of IPSTREAM)) inside (OR FONTS DEFAULTFONT)
       do (SETQ F (FONTCREATE F NIL NIL NIL (QUOTE INTERPRESS)))
	  (DEFINEFONT.IP IPSTREAM F)
	  (COND
	    (IPDATA                                          (* Take first font as heading font, and make it look 
							     like old current font on first NEWPAGE)
		    (replace IPFONT of IPDATA with F)
		    (replace IPHEADINGFONT of IPDATA with F)
		    (SETQ IPDATA NIL])

(SHOWBITMAP.IP
  [LAMBDA (IPSTREAM BITMAP REGION SCALE ROTATION)            (* jds "18-Feb-85 09:39")
                                                             (* Puts out bit map with lower-left corner at current 
							     position. If given, REGION is a clipping region on the 
							     bitmap.)
    (SHOW.IP IPSTREAM)
    (PROG (XPIXELS YPIXELS XBYTES)
          [COND
	    (REGION [SETQ REGION (INTERSECTREGIONS REGION
						   (create REGION
							   LEFT ← 0
							   BOTTOM ← 0
							   WIDTH ←(fetch BITMAPWIDTH of BITMAP)
							   HEIGHT ←(fetch BITMAPHEIGHT of BITMAP]
		    (SETQ XPIXELS (fetch WIDTH of REGION))
		    (SETQ YPIXELS (fetch HEIGHT of REGION)))
	    (T (SETQ XPIXELS (fetch BITMAPWIDTH of BITMAP))
	       (SETQ YPIXELS (fetch BITMAPHEIGHT of BITMAP]
          (SETQ XBYTES (CEIL (FOLDHI XPIXELS BITSPERBYTE)
			     BYTESPERCELL))                  (* Lines must be padded to multiples of 32bits 
							     (cells))
          (COND
	    ((IGREATERP XBYTES MAXLONGSEQUENCEBYTES)         (* We should really start breaking it up in the X 
							     direction as well)
	      (ERROR "Bitmap line too long for Interpress printing")))
          (SETQ SCALE (COND
	      (SCALE (\RTIMES2 SCALE MICASPERPOINT))
	      (T MICASPERPOINT))                             (* Go to unit of 4 raven spots ~= 1 screen point)
	    )
          (bind LEFT (NEXTROW ← 0)
		(BOTTOM ← 0)
		(HEIGHT ← YPIXELS)
		(MAXYPIXELSPERCHUNK ←(IQUOTIENT MAXLONGSEQUENCEBYTES XBYTES))
	     while (IGREATERP YPIXELS 0) first [COND
						 (REGION     (* We're displaying a subsection of the bitmap.
							     Set up the fields that let SHOWBITMAP1.IP pick bits 
							     from the right place)
							 (SETQ LEFT (fetch LEFT of REGION))
							 (SETQ BOTTOM (fetch BOTTOM of REGION]
	     do                                              (* The bitmap is put out in chunks, from top to bottom 
							     -- corresponding to the order that the bits appear in 
							     memory.)
		(SHOWBITMAP1.IP IPSTREAM BITMAP LEFT NEXTROW XPIXELS (IMIN YPIXELS MAXYPIXELSPERCHUNK)
				SCALE ROTATION HEIGHT XBYTES BOTTOM)
		(SETQ YPIXELS (IDIFFERENCE YPIXELS MAXYPIXELSPERCHUNK))
		(SETQ NEXTROW (IPLUS NEXTROW MAXYPIXELSPERCHUNK)) 

          (* This is the next row of the bitmap (counting from the top of the region to be displayed) to go to the file.)

])

(SHOWBITMAP1.IP
  [LAMBDA (IPSTREAM BITMAP LEFT FIRSTROW XPIXELS YPIXELS SCALEFACTOR ROTATION HEIGHT XBYTES 
		    REGIONBOTTOM)                            (* jds "18-Feb-85 09:39")
                                                             (* Move a segment of bitmap to an INTERPRESS file.)
                                                             (* FIRSTROW is the row count -- STARTING FROM THE TOP 
							     OF THE BITMAP AS ZERO -- for the first row to be 
							     displayed.)

          (* By the time we get here, XBYTES should have been raised to the next multiple of 32-bits-worth, since that's the 
	  required width of packed pixel vectors.)


    (PROG [(TOTALBYTES (ITIMES XBYTES YPIXELS))
	   (SCRATCHBM (BITMAPCREATE (CEIL XPIXELS BITSPERCELL)
				    1))
	   (BMBASE (\ADDBASE (fetch (BITMAP BITMAPBASE) of BITMAP)
			     (ITIMES (IDIFFERENCE (IPLUS HEIGHT (OR REGIONBOTTOM 0))
						  (IPLUS FIRSTROW YPIXELS))
				     (fetch (BITMAP BITMAPRASTERWIDTH) of BITMAP]
          (APPENDOP.IP IPSTREAM DOSAVESIMPLEBODY)
          (APPENDOP.IP IPSTREAM {)                           (* Start the SIMPLEBODY for displaying this part of the
							     bitmap.)
          (TRANS.IP IPSTREAM)                                (* Translate to the current position)
          (APPENDNUMBER.IP IPSTREAM YPIXELS)                 (* For the master, this is the number of pixels in the 
							     slow direction)
          (APPENDNUMBER.IP IPSTREAM (CEIL XPIXELS BITSPERCELL))
                                                             (* 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                                        (* Bitmaps are really shown on their sides, hanging 
							     from the upper left corner (I think--JDS))
		      (ROTATE.IP IPSTREAM -90)
		      (TRANSLATE.IP IPSTREAM 0 (IDIFFERENCE HEIGHT FIRSTROW))

          (* Push this segment up to its "true" height -- i.e., The first segment gets pushed up all the way 
	  (since it's the top of the bitmap), the next segment gets pushed up HEIGHT-#ofRowsIn1stSeg (to account for the first
	  segment), and so on.)


		      (CONCAT.IP IPSTREAM))
		   (90                                       (* need nop)
		       (TRANSLATE.IP IPSTREAM (IDIFFERENCE HEIGHT (IPLUS FIRSTROW YPIXELS))
				     0)

          (* Push this segment up to its "true" bottom -- i.e., The first segment gets pushed up to 
	  bitmapHeight-HeightOfSegment (since it's the top of the bitmap), the next segment gets pushed up 
	  HEIGHT-RowsIn1stSeg-RowsThisSeg (to account for the first segment), and so on.)


		       )
		   (180                                      (* The translation for this hasn't been tested yet.
							     It may well be the inverse of the rotation-0 
							     correction)
			(ROTATE.IP IPSTREAM 90)
			(TRANSLATE.IP IPSTREAM XPIXELS 0)
			(CONCAT.IP IPSTREAM))
		   (270                                      (* The translation for this hasn't been tested yet.
							     It may well be the inverse of the rotation-90 
							     correction)
			(ROTATE.IP IPSTREAM 180)
			(TRANSLATE.IP IPSTREAM 0 XPIXELS)
			(CONCAT.IP IPSTREAM))
		   (ERROR ROTATION "rotation by other than multiples of 90 degrees not implemented"))
          (SCALE.IP IPSTREAM SCALEFACTOR)                    (* Scale the bitmap to its final size)
          (CONCAT.IP IPSTREAM)
          (APPENDSEQUENCEDESCRIPTOR.IP IPSTREAM SEQPACKEDPIXELVECTOR (IPLUS 4 TOTALBYTES))
          (APPENDINT.IP IPSTREAM 1 2)
          (APPENDINT.IP IPSTREAM (CEIL XPIXELS BITSPERCELL)
			2)

          (* * Now put put the bitmap -- each line must be a 32-bit multiple long)


          (for Y (XWORDS ←(FOLDHI XBYTES BYTESPERWORD)) from 1 to YPIXELS
	     do (BITBLT BITMAP (OR LEFT 0)
			(IDIFFERENCE (IPLUS (OR REGIONBOTTOM 0)
					    FIRSTROW YPIXELS)
				     Y)
			SCRATCHBM 0 0 XPIXELS 1 (QUOTE INPUT)
			(QUOTE REPLACE))
		(\BOUTS IPSTREAM (fetch (BITMAP BITMAPBASE) of SCRATCHBM)
			0
			(CEIL XBYTES BYTESPERCELL)))
          (APPENDOP.IP IPSTREAM MAKEPIXELARRAY)
          (APPENDOP.IP IPSTREAM MASKPIXEL)
          (APPENDOP.IP IPSTREAM }])

(SHOWSHADE.IP
  [LAMBDA (IPSTREAM SHADE REGION OPERATION)                  (* hdj "10-Jan-85 18:26")
                                                             (* Puts out bit map with lower-left corner at current 
							     position. If given, REGION is a clipping region on the 
							     bitmap.)
    (SHOW.IP IPSTREAM)
    (PROG ((SCRATCHBM (BITMAPCREATE 32 32))
	   BMBASE)
          (SETQ BMBASE (fetch (BITMAP BITMAPBASE) of SCRATCHBM))
          (BITBLT NIL 0 0 SCRATCHBM 0 0 32 32 (QUOTE TEXTURE)
		  (QUOTE REPLACE)
		  SHADE)                                     (* Move the shade into the scratch bitmap, so we can 
							     tell Interpress about it)
                                                             (* WE NEED A PIXEL ARRAY THAT'S 32 WIDE, TO MAKE IP 
							     WORK)
          (APPENDOP.IP IPSTREAM DOSAVESIMPLEBODY)
          (APPENDOP.IP IPSTREAM {)                           (* Start the SIMPLEBODY for displaying this part of the
							     bitmap.)
          (APPENDNUMBER.IP IPSTREAM 32)                      (* For the master, this is the number of pixels in the 
							     slow direction)
          (APPENDNUMBER.IP IPSTREAM BITSPERCELL)             (* Number of pixels in the master's fast direction)
          (APPENDINTEGER.IP IPSTREAM 1)                      (* Samples per pixel)
          (APPENDINTEGER.IP IPSTREAM 1)                      (* Max sample value)
          (APPENDINTEGER.IP IPSTREAM 1)                      (* "Interleaved" samples)
          (SCALE.IP IPSTREAM 1)                              (* THE SHADE IS IN PRINTER POINTS PER PIXEL)
          (APPENDSEQUENCEDESCRIPTOR.IP IPSTREAM SEQPACKEDPIXELVECTOR (IPLUS 4 (ITIMES BYTESPERCELL 32)
									    ))
          (APPENDINT.IP IPSTREAM 1 2)
          (APPENDINT.IP IPSTREAM BITSPERCELL 2)

          (* * Now put put the bitmap -- each line must be a 32-bit multiple long)


          (\BOUTS IPSTREAM (fetch (BITMAP BITMAPBASE) of SCRATCHBM)
		  0
		  (ITIMES BYTESPERCELL 32))                  (* PUT OUT THE BITS)
          (APPENDOP.IP IPSTREAM MAKEPIXELARRAY)              (* MAKE THE PIXEL ARRAY)
          (SCALE.IP IPSTREAM 1)
          (APPENDINTEGER.IP IPSTREAM (SELECTQ OPERATION
					      (REPLACE       (* The "white" bits are opaque)
						       0)
					      (PAINT         (* The "white" bits are clear)
						     1)
					      1))
          (APPENDOP.IP IPSTREAM MAKESAMPLEDBLACK)
          (ISET.IP IPSTREAM COLOR.IMVAR)                     (* "1 TRAJECTORY")
          (APPENDINTEGER.IP IPSTREAM (fetch LEFT of REGION))
          (APPENDINTEGER.IP IPSTREAM (fetch BOTTOM of REGION))
          (APPENDINTEGER.IP IPSTREAM (fetch WIDTH of REGION))
          (APPENDINTEGER.IP IPSTREAM (fetch HEIGHT of REGION))
          (APPENDOP.IP IPSTREAM MASKRECTANGLE)
          (APPENDOP.IP IPSTREAM }])

(\BITBLT.IP
  [LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM DESTINATION DESTINATIONLEFT DESTINATIONBOTTOM WIDTH 
			HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT 
			CLIPPEDSOURCEBOTTOM)                 (* hdj " 5-Dec-84 18:40")
    (LET* ((OLDX (\DSPXPOSITION.IP DESTINATION))
       (OLDY (\DSPYPOSITION.IP DESTINATION))
       (DESTINATIONLEFT (OR DESTINATIONLEFT OLDX))
       (DESTINATIONBOTTOM (OR DESTINATIONBOTTOM OLDY)))
      (\MOVETO.IP DESTINATION DESTINATIONLEFT DESTINATIONBOTTOM)
      (SHOWBITMAP.IP DESTINATION SOURCEBITMAP (COND
		       (CLIPPINGREGION (INTERSECTREGIONS CLIPPINGREGION (CREATEREGION 
										CLIPPEDSOURCELEFT 
									      CLIPPEDSOURCEBOTTOM 
										      WIDTH HEIGHT)))
		       (T (CREATEREGION CLIPPEDSOURCELEFT CLIPPEDSOURCEBOTTOM WIDTH HEIGHT)))
		     1)
      (\MOVETO.IP DESTINATION OLDX OLDY))
    T])

(\SCALEDBITBLT.IP
  [LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM DESTINATION DESTINATIONLEFT DESTINATIONBOTTOM WIDTH 
			HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT 
			CLIPPEDSOURCEBOTTOM SCALE)           (* hdj "14-Feb-85 14:33")
    (LET* ((OLDX (\DSPXPOSITION.IP DESTINATION))
       (OLDY (\DSPYPOSITION.IP DESTINATION))
       (DESTINATIONLEFT (OR DESTINATIONLEFT OLDX))
       (DESTINATIONBOTTOM (OR DESTINATIONBOTTOM OLDY)))
      (\MOVETO.IP DESTINATION DESTINATIONLEFT DESTINATIONBOTTOM)
      (SHOWBITMAP.IP DESTINATION SOURCEBITMAP (COND
		       (CLIPPINGREGION (INTERSECTREGIONS CLIPPINGREGION (CREATEREGION 
										CLIPPEDSOURCELEFT 
									      CLIPPEDSOURCEBOTTOM 
										      WIDTH HEIGHT)))
		       (T (CREATEREGION CLIPPEDSOURCELEFT CLIPPEDSOURCEBOTTOM WIDTH HEIGHT)))
		     SCALE)
      (\MOVETO.IP DESTINATION OLDX OLDY))
    T])

(\BLTSHADE.IP
  [LAMBDA (TEXTURE STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT OPERATION CLIPPINGREGION)
                                                             (* hdj "12-Mar-85 12:36")
    (LET* ((REGION (CREATEREGION DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT))
       (DESTREGION (if CLIPPINGREGION
		       then (INTERSECTREGIONS REGION CLIPPINGREGION)
		     else REGION)))

          (* * (SHOWSHADE.IP STREAM TEXTURE DESTREGION OPERATION))

                                                             (* until 8044s can print scaled textures without 
							     crashing)
      (\BLTSHADE.GENERICPRINTER TEXTURE STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT 
				OPERATION CLIPPINGREGION MicasPerPoint])

(\CHARWIDTH.IP
  [LAMBDA (STREAM CHARCODE)                                  (* rmk: "18-Oct-84 12:25")
                                                             (* Gets the width of CHARCODE in an Interpress STREAM, 
							     observing spacefactor)
    (COND
      ((EQ CHARCODE (CHARCODE SPACE))
	(ffetch IPSPACEWIDTH of (ffetch IMAGEDATA of STREAM)))
      (T (\FGETWIDTH (ffetch IPWIDTHSCACHE of (ffetch IMAGEDATA of STREAM))
		     (LOGAND CHARCODE \CHARMASK])

(\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])

(\DRAWCIRCLE.IP
  [LAMBDA (STREAM CENTERX CENTERY RADIUS BRUSH DASHING)      (* rmk: "27-Sep-84 17:23")
    (PROG [(R2RAD (FIXR (FTIMES RADIUS (CONSTANT (FQUOTIENT (SQRT 2)
							    2]
          (DRAWCURVE (LIST (CREATEPOSITION (IPLUS CENTERX RADIUS)
					   CENTERY)
			   (CREATEPOSITION (IPLUS CENTERX R2RAD)
					   (IPLUS CENTERY R2RAD))
			   (CREATEPOSITION CENTERX (IPLUS CENTERY RADIUS))
			   (CREATEPOSITION (IDIFFERENCE CENTERX R2RAD)
					   (IPLUS CENTERY R2RAD))
			   (CREATEPOSITION (IDIFFERENCE CENTERX RADIUS)
					   CENTERY)
			   (CREATEPOSITION (IDIFFERENCE CENTERX R2RAD)
					   (IDIFFERENCE CENTERY R2RAD))
			   (CREATEPOSITION CENTERX (IDIFFERENCE CENTERY RADIUS))
			   (CREATEPOSITION (IPLUS CENTERX R2RAD)
					   (IDIFFERENCE CENTERY R2RAD)))
		     T BRUSH DASHING STREAM))
    (MOVETO CENTERX CENTERY STREAM])

(\DRAWCURVE.IP
  [LAMBDA (IPSTREAM KNOTS CLOSED BRUSH DASHING)              (* rmk: "20-Nov-84 10:55")
                                                             (* draws a spline curve with a given brush--except that
							     dashing is currently ignored, and the curve is done 
							     with straight lines.)
    [COND
      ((LISTP KNOTS)
	(SHOW.IP IPSTREAM)
	(PROG [K (DASHLST (AND DASHING (OR (AND (LISTP DASHING)
						(EVERY DASHING (FUNCTION FIXP))
						DASHING)
					   (\ILLEGAL.ARG DASHING]
                                                             (* The above makes sure that DASHING is a list of 
							     numbers.)
	      [OR (CDR KNOTS)
		  (SETQ KNOTS (LIST (CAR KNOTS)
				    (CAR KNOTS]              (* The funny case of a single knot)
	      (COND
		((AND (NULL DASHING)
		      (EQ 2 (LENGTH KNOTS)))                 (* There were only two knots, and no dashing.)
		  (OR (type? POSITION (SETQ K (CAR KNOTS)))
		      (ERROR "bad knot" K))
		  (MOVETO.IP IPSTREAM (fetch XCOORD of K)
			     (fetch YCOORD of K))
		  (OR (type? POSITION (SETQ K (CADR KNOTS)))
		      (ERROR "bad knot" K))
		  (LINETO.IP IPSTREAM (fetch XCOORD of K)
			     (fetch YCOORD of K))
		  (\SETBRUSH.IP IPSTREAM BRUSH)
		  (MASKSTROKE.IP IPSTREAM))
		(T                                           (* Otherwise, use the full-strength curve drawer.)
		   (\IPCURVE2 IPSTREAM (PARAMETRICSPLINE KNOTS CLOSED)
			      DASHING BRUSH)                 (* This already leaves the current position at the 
							     endpoint of the curve.)
		   ))
	      (SETQ K (CAR (LAST KNOTS)))
	      (SETXY.IP IPSTREAM (fetch XCOORD of K)
			(fetch YCOORD of K]
    IPSTREAM])

(\IPCURVE2
  [LAMBDA (IPSTREAM SPLINE DASHING BRUSH)                    (* hdj "13-Mar-85 18:08")
                                                             (* Given a spline curve and a font, draw the lines to 
							     IPSTREAM)
    (PROG ((XPOLY (create POLYNOMIAL))
	   (X'POLY (create POLYNOMIAL))
	   (YPOLY (create POLYNOMIAL))
	   (Y'POLY (create POLYNOMIAL))
	   (X (fetch (SPLINE SPLINEX) of SPLINE))
	   (Y (fetch (SPLINE SPLINEY) of SPLINE))
	   (X'(fetch (SPLINE SPLINEDX) of SPLINE))
	   (Y'(fetch (SPLINE SPLINEDY) of SPLINE))
	   (X''(fetch (SPLINE SPLINEDDX) of SPLINE))
	   (Y''(fetch (SPLINE SPLINEDDY) of SPLINE))
	   (X'''(fetch (SPLINE SPLINEDDDX) of SPLINE))
	   (Y'''(fetch (SPLINE SPLINEDDDY) of SPLINE))
	   (#KNOTS (fetch #KNOTS of SPLINE))
	   (X0 (ELT (fetch (SPLINE SPLINEX) of SPLINE)
		    1))
	   (Y0 (ELT (fetch (SPLINE SPLINEY) of SPLINE)
		    1))
	   IX IY DX DY XT YT X'T Y'T NEWXT NEWYT XDIFF YDIFF XWALLDT YWALLDT DUPLICATEKNOT EXTRANEOUS 
	   TT NEWT DELTA DASHON DASHLST DASHCNT IPDATA SEG#)
          (SETQ DASHON T)                                    (* These are initialized outside the prog-bindings 
							     cause the compiler can't hack so many initialized 
							     variables)
          (SETQ DASHLST DASHING)
          (SETQ DASHCNT (CAR DASHING))
          (SETQ SEG# 0)
          (SETQ IPDATA (fetch IMAGEDATA of IPSTREAM))
          (MOVETO.IP IPSTREAM X0 Y0)
          (replace IPXPOS of IPDATA with X0)
          (replace IPYPOS of IPDATA with Y0)
          (SETQ TT 0.0)
          (SETQ DELTA 128)
          (SETQ IX (FIXR X0))
          (SETQ IY (FIXR Y0))
          [for KNOT# from 1 to (SUB1 #KNOTS)
	     do (LOADPOLY XPOLY X'POLY (ELT X''' KNOT#)
			  (ELT X'' KNOT#)
			  (ELT X' KNOT#)
			  (ELT X KNOT#))
		(LOADPOLY YPOLY Y'POLY (ELT Y''' KNOT#)
			  (ELT Y'' KNOT#)
			  (ELT Y' KNOT#)
			  (ELT Y KNOT#))
		(SETQ XT (POLYEVAL TT XPOLY 3))              (* XT ← X (t) --Evaluate the next point)
		(SETQ YT (POLYEVAL TT YPOLY 3))              (* YT ← Y (t))
		(COND
		  [(NOT (IEQP KNOT# (SUB1 #KNOTS)))          (* This isn't the last knot.
							     Check to see if the next knot in line is a duplicated 
							     knot.)
		    (SETQ DUPLICATEKNOT (AND (EQP (ELT X (ADD1 KNOT#))
						  (ELT X (IPLUS KNOT# 2)))
					     (EQP (ELT Y (ADD1 KNOT#))
						  (ELT Y (IPLUS KNOT# 2]
		  (T (SETQ DUPLICATEKNOT NIL)))
		[until (GEQ TT 1.0)
		   do (SETQ X'T (POLYEVAL TT X'POLY 2))      (* X'T ← X' (t))
		      (SETQ Y'T (POLYEVAL TT Y'POLY 2))      (* Y'T ← Y' (t))
		      (COND
			((EQP X'T 0.0)
			  (SETQ X'T .0005)))
		      (COND
			((EQP Y'T 0.0)
			  (SETQ Y'T .0005)))
		      [COND
			((FGTP X'T 0.0)
			  (SETQ DX DELTA))
			(T (SETQ DX (IMINUS DELTA]
		      [COND
			((FGTP Y'T 0.0)
			  (SETQ DY DELTA))
			(T (SETQ DY (IMINUS DELTA]
		      (SETQ XWALLDT (FQUOTIENT (FDIFFERENCE (IPLUS IX DX)
							    XT)
					       X'T))
		      (SETQ YWALLDT (FQUOTIENT (FDIFFERENCE (IPLUS IY DY)
							    YT)
					       Y'T))
		      [COND
			((FLESSP XWALLDT YWALLDT)
			  (SETQ NEWT (FPLUS TT XWALLDT))
			  (SETQ DY (IDIFFERENCE (FIXR (FPLUS YT (FTIMES XWALLDT Y'T)))
						IY)))
			(T (SETQ NEWT (FPLUS TT YWALLDT))
			   (SETQ DX (IDIFFERENCE (FIXR (FPLUS XT (FTIMES YWALLDT X'T)))
						 IX]
		      (COND
			([AND (FGTP NEWT 1.0)
			      (OR DUPLICATEKNOT (EQ KNOT# (SUB1 #KNOTS]
			  (SETQ NEWT 1.0)))
		      (SETQ NEWXT (POLYEVAL NEWT XPOLY 3)) 
                                                             (* New XT ← X (new t))
		      (SETQ NEWYT (POLYEVAL NEWT YPOLY 3)) 
                                                             (* New YT ← Y (new t))
		      (SETQ XDIFF (ABS (FDIFFERENCE (IPLUS IX DX)
						    NEWXT)))
		      (SETQ YDIFF (ABS (FDIFFERENCE (IPLUS IY DY)
						    NEWYT)))
		      (COND
			((AND (IGREATERP DELTA 1)
			      (OR (FGTP XDIFF 1.0)
				  (FGTP YDIFF 1.0)))
			  (SETQ DELTA (LRSH DELTA 1)))
			(T (if (IGREATERP (add SEG# 1)
					  MAXSEGSPERTRAJECTORY)
			       then (\SETBRUSH.IP IPSTREAM BRUSH)
				    (MASKSTROKE.IP IPSTREAM)
				    (SETQ SEG# 0)
				    (MOVETO.IP IPSTREAM (fetch IPXPOS of IPDATA)
					       (fetch IPYPOS of IPDATA)))
			   (LINETO.IP IPSTREAM (add (fetch IPXPOS of IPDATA)
						    DX)
				      (add (fetch IPYPOS of IPDATA)
					   DY))
			   (SETQ IX (IPLUS IX DX))
			   (SETQ IY (IPLUS IY DY))
			   (SETQ TT NEWT)
			   (SETQ XT NEWXT)
			   (SETQ YT NEWYT)
			   (COND
			     ((AND (ILESSP DELTA 128)
				   (OR (FLESSP XDIFF .5)
				       (FLESSP YDIFF .5)))
			       (SETQ DELTA (LLSH DELTA 1]
		(SETQ TT (FDIFFERENCE TT 1.0)) 

          (* Having moved past a knot, back the value of the parameter TT back down. However, don't set it to 0.0--let's try 
	  to keep the line going from where it got to in passing the last knot.)


		(COND
		  (DUPLICATEKNOT 

          (* This next knot is a duplicate. Skip over it, and start from the following knot. This will avoid odd problems 
	  trying to go nowhere while obeying the constraints of X' and Y' at that knot--since it's a duplicate, X' and Y' are 
	  discontinuous there.)


				 (add KNOT# 1]
          (\SETBRUSH.IP IPSTREAM BRUSH)
          (MASKSTROKE.IP IPSTREAM])

(\DRAWELLIPSE.IP
  [LAMBDA (PRSTREAM CENTERX CENTERY SEMIMINORRADIUS SEMIMAJORRADIUS ORIENTATION BRUSH DASHING)
                                                             (* rmk: "23-Aug-84 12:00")
    (PROG [(SINOR (COND
		    (ORIENTATION (SIN ORIENTATION))
		    (T 0.0)))
	   (COSOR (COND
		    (ORIENTATION (COS ORIENTATION))
		    (T 1.0]
          (\DRAWCURVE.IP PRSTREAM [LIST (CREATEPOSITION (PLUS CENTERX (FTIMES COSOR SEMIMAJORRADIUS))
							(PLUS CENTERY (FTIMES SINOR SEMIMAJORRADIUS)))
					(CREATEPOSITION (DIFFERENCE CENTERX (FTIMES SINOR 
										  SEMIMINORRADIUS))
							(PLUS CENTERY (FTIMES COSOR SEMIMINORRADIUS)))
					(CREATEPOSITION (DIFFERENCE CENTERX (FTIMES COSOR 
										  SEMIMAJORRADIUS))
							(DIFFERENCE CENTERY (FTIMES SINOR 
										  SEMIMAJORRADIUS)))
					(CREATEPOSITION (PLUS CENTERX (FTIMES SINOR SEMIMINORRADIUS))
							(DIFFERENCE CENTERY (FTIMES COSOR 
										  SEMIMINORRADIUS]
			 T BRUSH DASHING)
          (MOVETO CENTERX CENTERY PRSTREAM])

(\DRAWLINE.IP
  [LAMBDA (IPSTREAM X1 Y1 X2 Y2 WIDTH OPERATION COLOR)       (* rmk: "15-Aug-84 18:36")
                                                             (* A temporary interface function until we resolve the 
							     color/endshape/operation conflicts in the D.I.G.
							     argument structure. Arguments are assumed to be in 
							     micas.)
    (SHOW.IP IPSTREAM)
    (MOVETO.IP IPSTREAM X1 Y1)
    (LINETO.IP IPSTREAM X2 Y2)
    (\SETBRUSH.IP IPSTREAM (LIST (QUOTE BUTT)
				 WIDTH))
    (MASKSTROKE.IP IPSTREAM)
    (SETXY.IP IPSTREAM X2 Y2])

(\DSPBOTTOMMARGIN.IP
  [LAMBDA (IPSTREAM YPOSITION)                               (* rmk: "26-Jun-84 14:01")
    (PROG1 (fetch IPBOTTOM of (fetch IMAGEDATA of IPSTREAM))
	   (COND
	     (YPOSITION (replace IPBOTTOM of (fetch IMAGEDATA of IPSTREAM) with YPOSITION])

(\DSPFONT.IP
  [LAMBDA (IPSTREAM FONT)                                    (* rmk: "18-Oct-84 12:08")
                                                             (* Change fonts (or return the current font) for an IP 
							     stream)
    (PROG (OLDFONT FRAMEVAR (IPDATA (ffetch IMAGEDATA of IPSTREAM)))
          (SETQ OLDFONT (ffetch IPFONT of IPDATA))
          (AND (NULL FONT)
	       (RETURN OLDFONT))
          (SHOW.IP IPSTREAM)                                 (* ALWAYS do the show, so that font changes force 
							     recomputation of the exact position in the printer.)
          (COND
	    ([EQ OLDFONT (SETQ FONT (OR (\GETFONTDESC FONT (QUOTE INTERPRESS))
					(FONTCOPY OLDFONT FONT]
                                                             (* There was no change, or he was only asking for the 
							     old font. Just return it.)
	      (RETURN OLDFONT)))
          [SETQ FRAMEVAR (CDR (OR (ASSOC FONT (ffetch IPPAGEFONTS of IPDATA))
				  (DEFINEFONT.IP IPSTREAM FONT]
                                                             (* Get the font number to go in the file)
          (APPENDINTEGER.IP IPSTREAM FRAMEVAR)
          (APPENDOP.IP IPSTREAM SETFONT)
          (freplace IPFONT of IPDATA with FONT)              (* Remember the new font)
          (freplace IPWIDTHSCACHE of IPDATA with (ffetch (ARRAYP BASE) of (ffetch \SFWidths
									     of FONT)))
          [freplace IPSPACEWIDTH of IPDATA with (FIXR (TIMES (ffetch IPSPACEFACTOR of IPDATA)
							     (\FGETWIDTH (ffetch IPWIDTHSCACHE
									    of IPDATA)
									 (CHARCODE SPACE]
                                                             (* Set the linefeed distance to be one point more than 
							     the font height)
          [freplace IPLINEFEED of IPDATA with (IDIFFERENCE (CONSTANT (IMINUS (IQUOTIENT MICASPERINCH 
										    POINTSPERINCH)))
							   (FONTPROP FONT (QUOTE HEIGHT]
          (freplace NSTRANSTABLE of IPDATA with (ffetch OTHERDEVICEFONTPROPS of FONT))
          (\FIXLINELENGTH.IP IPSTREAM)
          (RETURN OLDFONT])

(\DSPLEFTMARGIN.IP
  [LAMBDA (IPSTREAM XPOSITION)                               (* rmk: " 4-Oct-84 10:34")
    (PROG1 (ffetch IPLEFT of (ffetch IMAGEDATA of IPSTREAM))
	   (COND
	     (XPOSITION (freplace IPLEFT of (ffetch IMAGEDATA of IPSTREAM) with XPOSITION)
			(\FIXLINELENGTH.IP IPSTREAM])

(\DSPLINEFEED.IP
  [LAMBDA (IPSTREAM DELTAY)                                  (* rmk: " 4-Oct-84 09:26")
                                                             (* sets the amount that a line feed increases the y 
							     coordinate by.)
    (PROG ((IPDATA (ffetch IMAGEDATA of IPSTREAM)))
          (RETURN (PROG1 (ffetch IPLINEFEED of IPDATA)
			 (AND DELTAY (COND
				((NUMBERP DELTAY)
				  (freplace IPLINEFEED of IPDATA with DELTAY))
				(T (\ILLEGAL.ARG DELTAY])

(\DSPRIGHTMARGIN.IP
  [LAMBDA (IPSTREAM XPOSITION)                               (* rmk: " 4-Oct-84 10:33")
    (PROG1 (ffetch IPRIGHT of (ffetch IMAGEDATA of IPSTREAM))
	   (COND
	     (XPOSITION (freplace IPRIGHT of (ffetch IMAGEDATA of IPSTREAM) with XPOSITION)
			(\FIXLINELENGTH.IP IPSTREAM])

(\DSPSPACEFACTOR.IP
  [LAMBDA (STREAM FACTOR)                                    (* rmk: "18-Oct-84 12:54")
    (PROG ((IPDATA (ffetch IMAGEDATA of STREAM)))
          (RETURN (PROG1 (ffetch IPSPACEFACTOR of IPDATA)
			 (COND
			   (FACTOR [freplace IPSPACEWIDTH of IPDATA
				      with (FIXR (TIMES FACTOR (\FGETWIDTH (ffetch IPWIDTHSCACHE
									      of IPDATA)
									   (CHARCODE SPACE]
                                                             (* Doing the multiply first will insure that FACTOR is 
							     a number)
				   (freplace IPSPACEFACTOR of IPDATA with FACTOR)
				   (SHOW.IP STREAM)
				   (APPENDNUMBER.IP STREAM FACTOR)
				   (ISET.IP STREAM AMPLIFYSPACE])

(\DSPTOPMARGIN.IP
  [LAMBDA (IPSTREAM YPOSITION)                               (* rmk: "26-Jun-84 14:01")
    (PROG1 (fetch IPTOP of (fetch IMAGEDATA of IPSTREAM))
	   (COND
	     (YPOSITION (replace IPTOP of (fetch IMAGEDATA of IPSTREAM) with YPOSITION])

(\DSPXPOSITION.IP
  [LAMBDA (IPSTREAM XPOSITION)                               (* rmk: "16-Oct-84 12:30")
    (PROG1 (fetch IPXPOS of (fetch IPDATA of IPSTREAM))
	   (COND
	     (XPOSITION (SHOW.IP IPSTREAM)                   (* (SETX.IP IPSTREAM XPOSITION))

          (* Until our view of the printer's position is accurate, we can't rely on what we think the Xposition is, hence must
	  be sure not to do a SETXREL.)


			(SETXY.IP IPSTREAM XPOSITION (fetch IPYPOS of (fetch IPDATA of IPSTREAM])

(\DSPYPOSITION.IP
  [LAMBDA (IPSTREAM YPOSITION)                               (* rmk: "18-Jun-84 14:14")
    (PROG1 (fetch IPYPOS of (fetch IPDATA of IPSTREAM))
	   (COND
	     (YPOSITION (SHOW.IP IPSTREAM)
			(SETY.IP IPSTREAM YPOSITION])

(\FIXLINELENGTH.IP
  [LAMBDA (IPSTREAM)                                         (* rmk: "27-Nov-84 18:32")

          (* IPSTREAM is known to be a stream of type interpress. Called by RIGHTMARGIN LEFTMARGIN and \SFFIXFONT to update 
	  the LINELENGTH field in the stream. also called when the stream is created.)


    (PROG (LLEN (IPDATA (ffetch IMAGEDATA of IPSTREAM)))
          (freplace (STREAM LINELENGTH) of IPSTREAM
	     with (COND
		    ((IGREATERP [SETQ LLEN (IQUOTIENT (IDIFFERENCE (ffetch IPRIGHT of IPDATA)
								   (ffetch IPLEFT of IPDATA))
						      (ffetch FONTAVGCHARWIDTH
							 of (ffetch IPFONT of IPDATA]
				1)
		      LLEN)
		    (T 10])

(\MOVETO.IP
  [LAMBDA (IPSTREAM X Y)                                     (* rmk: "17-Sep-84 18:51")
    (SHOW.IP IPSTREAM)
    (SETXY.IP IPSTREAM X Y])

(\SETBRUSH.IP
  [LAMBDA (IPSTREAM BRUSH)                                   (* rmk: "19-Oct-84 16:34")
                                                             (* Sets the stroke shape parameters.)
    (PROG (WIDTH SHAPE)
          [COND
	    ((LISTP BRUSH)
	      (SETQ SHAPE (CAR BRUSH))
	      (SETQ WIDTH (OR (CAR (LISTP (CDR BRUSH)))
			      1)))
	    (T (SETQ SHAPE (QUOTE ROUND))
	       (SETQ WIDTH (OR BRUSH 1]
          (APPENDNUMBER.IP IPSTREAM WIDTH)
          (ISET.IP IPSTREAM STROKEWIDTH)
          (APPENDNUMBER.IP IPSTREAM (SELECTQ SHAPE
					     (ROUND ROUND)
					     (SQUARE SQUARE)
					     (BUTT BUTT)
					     ROUND))
          (ISET.IP IPSTREAM STROKEEND])

(\STRINGWIDTH.IP
  [LAMBDA (STREAM STRING RDTBL)                              (* rmk: "18-Oct-84 12:21")
                                                             (* Returns the width of STRING in the interpress 
							     STREAM, observing spacefactor)
    (\STRINGWIDTH.GENERIC STRING (ffetch IPWIDTHSCACHE of (ffetch IMAGEDATA of STREAM))
			  RDTBL
			  (ffetch IPSPACEWIDTH of (ffetch IMAGEDATA of STREAM])

(\DSPCLIPPINGREGION.IP
  [LAMBDA (STREAM REGION)                                    (* hdj "21-Feb-85 11:14")
    (LET ((IPDATA (fetch (STREAM IMAGEDATA) of STREAM)))
      (PROG1 (fetch (INTERPRESSDATA IPPAGEREGION) of IPDATA)
	     (AND REGION (UNINTERRUPTABLY
                             (replace (INTERPRESSDATA IPPAGEREGION) of IPDATA with REGION))])
)
(DEFINEQ

(\INTERPRESSINIT
  [LAMBDA NIL                                                (* hdj "11-Mar-85 18:31")
    (DECLARE (GLOBALVARS \IPIMAGEOPS \ASCIITONS \ASCIITOSTAR HIPPOTONS))
    (SETQ \IPIMAGEOPS (create IMAGEOPS
			      IMAGETYPE ←(QUOTE INTERPRESS)
			      IMCLOSEFN ←(FUNCTION \CLOSEIPSTREAM)
			      IMXPOSITION ←(FUNCTION \DSPXPOSITION.IP)
			      IMYPOSITION ←(FUNCTION \DSPYPOSITION.IP)
			      IMFONT ←(FUNCTION \DSPFONT.IP)
			      IMLEFTMARGIN ←(FUNCTION \DSPLEFTMARGIN.IP)
			      IMRIGHTMARGIN ←(FUNCTION \DSPRIGHTMARGIN.IP)
			      IMLINEFEED ←(FUNCTION \DSPLINEFEED.IP)
			      IMDRAWLINE ←(FUNCTION \DRAWLINE.IP)
			      IMDRAWCURVE ←(FUNCTION \DRAWCURVE.IP)
			      IMDRAWCIRCLE ←(FUNCTION \DRAWCIRCLE.IP)
			      IMDRAWELLIPSE ←(FUNCTION \DRAWELLIPSE.IP)
			      IMFILLCIRCLE ←[FUNCTION (LAMBDA (STREAM)
				  (\UNIMPIMAGEOP STREAM (QUOTE FILLCIRCLE]
			      IMBLTSHADE ←(FUNCTION \BLTSHADE.IP)
			      IMBITBLT ←(FUNCTION \BITBLT.IP)
			      IMMOVETO ←(FUNCTION \MOVETO.IP)
			      IMSCALE ←[FUNCTION (LAMBDA NIL
				  (CONSTANT (FQUOTIENT MICASPERINCH POINTSPERINCH]
			      IMTERPRI ←(FUNCTION NEWLINE.IP)
			      IMBOTTOMMARGIN ←(FUNCTION \DSPBOTTOMMARGIN.IP)
			      IMTOPMARGIN ←(FUNCTION \DSPTOPMARGIN.IP)
			      IMFONTCREATE ←(QUOTE INTERPRESS)
			      IMNEWPAGE ←(FUNCTION NEWPAGE.IP)
			      IMSPACEFACTOR ←(FUNCTION \DSPSPACEFACTOR.IP)
			      IMSTRINGWIDTH ←(FUNCTION \STRINGWIDTH.IP)
			      IMCHARWIDTH ←(FUNCTION \CHARWIDTH.IP)
			      IMSCALEDBITBLT ←(FUNCTION \SCALEDBITBLT.IP)
			      IMCLIPPINGREGION ←(FUNCTION \DSPCLIPPINGREGION.IP)))

          (* * Translation table for standard ascii to NS)


    [SETQ \ASCIITONS (NSMAP NIL (QUOTE ((↑ 0 173)
					 (← 0 172)
					 ($ 0 164)
					 (- 33 62)
					 (↑N 0 197)
					 (↑S 239 37)
					 (↑V 239 36)
					 (↑X 0 45)
					 (↑O 239 45)
					 (↑\ 239 44)
					 (↑Y 239 46)
					 (↑D 0 200)
					 (↑G 0 169)
					 (↑H 0 161)
					 (↑B 0 191)
					 (96 0 185)
					 (#↑%[ 239 36)
					 (#↑\ 239 37)
					 (#7 239 102]        (* Map from ASCII to printer character code 
							     (XC1-1-1 NS Encoding standard))
    [SETQ \ASCIITOSTAR (NSMAP NIL (QUOTE ((↑ 0 173)
					   (← 0 172)
					   ($ 0 164)
					   (↑N 0 197)
					   (↑S 239 37)
					   (↑V 239 36)
					   (↑X 0 45)
					   (↑O 239 45)
					   (↑\ 239 44)
					   (↑Y 239 46)
					   (↑D 0 200)
					   (↑G 0 169)
					   (↑H 0 161)
					   (↑B 0 191)
					   (96 0 185)
					   (#↑%[ 239 36)
					   (#↑\ 239 37)
					   (#7 239 102]

          (* Map from ASCII to wedged OSD screen & .WD file character coding (alleged to be XC2-x-x, soon to come). The 
	  difference is that "-" maps to itself for width purposes.)

                                                             (* Last 4 are backquote, hyphen instead of minus sign, 
							     en dash, em dash, bullet)
    NIL])
)
(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 (CREATEREGION 1.1 .75 (FDIFFERENCE 7.5 1.1)
							 (FDIFFERENCE 10.5 .75))))
)



(* "Interpress encoding values")

(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 

(RPAQQ MAXSEGSPERTRAJECTORY 100)

(CONSTANTS MAXSEGSPERTRAJECTORY)
)


(RPAQQ NONPRIMS ((BEGINMASTER 102)
		 (ENDMASTER 103)
		 (PAGEINSTRUCTIONS 105)
		 ({ 106)
		 (} 107)))
(DECLARE: EVAL@COMPILE 

(RPAQQ BEGINMASTER 102)

(RPAQQ ENDMASTER 103)

(RPAQQ PAGEINSTRUCTIONS 105)

(RPAQQ { 106)

(RPAQQ } 107)

(CONSTANTS (BEGINMASTER 102)
	   (ENDMASTER 103)
	   (PAGEINSTRUCTIONS 105)
	   ({ 106)
	   (} 107))
)


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

(RPAQQ SEQADAPTIVEPIXELVECTOR 12)

(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 (SEQADAPTIVEPIXELVECTOR 12)
	   (SEQCOMMENT 6)
	   (SEQCOMPRESSPIXELVECTOR 10)
	   (SEQCONTINUED 7)
	   (SEQIDENTIFIER 5)
	   (SEQINSERTFILE 11)
	   (SEQINTEGER 2)
	   (SEQLARGEVECTOR 8)
	   (SEQPACKEDPIXELVECTOR 9)
	   (SEQRATIONAL 4)
	   (SEQSTRING 1))
)


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

(RPAQQ COLOR.IPTYPE 7)

(RPAQQ IDENTIFIER.IPTYPE 2)

(RPAQQ NUMBER.IPTYPE 1)

(RPAQQ OPERATOR.IPTYPE 4)

(RPAQQ OUTLINE.IPTYPE 9)

(RPAQQ PIXELARRAY.IPTYPE 6)

(RPAQQ TRAJECTORY.IPTYPE 8)

(RPAQQ TRANSFORMATION.IPTYPE 5)

(RPAQQ VECTOR.IPTYPE 3)

(CONSTANTS (COLOR.IPTYPE 7)
	   (IDENTIFIER.IPTYPE 2)
	   (NUMBER.IPTYPE 1)
	   (OPERATOR.IPTYPE 4)
	   (OUTLINE.IPTYPE 9)
	   (PIXELARRAY.IPTYPE 6)
	   (TRAJECTORY.IPTYPE 8)
	   (TRANSFORMATION.IPTYPE 5)
	   (VECTOR.IPTYPE 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)
		  (ERROR.IPOP 600)
		  (EXCH 185)
		  (FGET 20)
		  (FINDCOLOR 423)
		  (FINDCOLORMODELOPERATOR 422)
		  (FINDCOLOROPERATOR 421)
		  (FINDDECOMPRESSOR 149)
		  (FINDFONT 147)
		  (FLOOR 206)
		  (FSET 21)
		  (GE 207)
		  (GETCP 159)
		  (GETPROP 287)
		  (GT 208)
		  (IF 239)
		  (IFCOPY 240)
		  (IFELSE 241)
		  (IGET 18)
		  (ISET 19)
		  (LINETO 23)
		  (LINETOX 14)
		  (LINETOY 15)
		  (MAKEGRAY 425)
		  (MAKEOUTLINE 417)
		  (MAKEPIXELARRAY 450)
		  (MAKESAMPLEDBLACK 426)
		  (MAKESAMPLEDCOLOR 427)
		  (MAKESIMPLECO 114)
		  (MAKEPIXELARRAY 450)
		  (MAKEVEC 283)
		  (MAKEVECLU 282)
		  (MARK 186)
		  (MASKFILL 409)
		  (MASKPIXEL 452)
		  (MASKRECTANGLE 410)
		  (MASKSTROKE 24)
		  (MASKTRAPEZOIDX 411)
		  (MASKTRAPEZOIDY 412)
		  (MASKUNDERLINE 414)
		  (MASKVECTOR 441)
		  (MERGEPROP 288)
		  (MOD 209)
		  (MODIFYFONT 148)
		  (MOVE 169)
		  (MOVETO 25)
		  (MUL 210)
		  (NEG 211)
		  (NOP 1)
		  (NOT 212)
		  (OR 213)
		  (POP 180)
		  (REM 216)
		  (ROLL 184)
		  (ROTATE 163)
		  (ROUND.IPOP 217)
		  (SCALE.OP 164)
		  (SCALE2 166)
		  (SETCORRECTMEASURE 154)
		  (SETCORRECTTOLERANCE 155)
		  (SETFONT 151)
		  (SETGRAY 424)
		  (SETXREL 12)
		  (SETXY 10)
		  (SETXYREL 11)
		  (SETYREL 13)
		  (SHAPE.IPOP 285)
		  (SHOW 22)
		  (SHOWANDXREL 146)
		  (SPACE 16)
		  (STARTUNDERLINE 413)
		  (SUB 214)
		  (TRANS 170)
		  (TRANSLATE 162)
		  (TRUNC 215)
		  (TYPE.OP 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 ERROR.IPOP 600)

(RPAQQ EXCH 185)

(RPAQQ FGET 20)

(RPAQQ FINDCOLOR 423)

(RPAQQ FINDCOLORMODELOPERATOR 422)

(RPAQQ FINDCOLOROPERATOR 421)

(RPAQQ FINDDECOMPRESSOR 149)

(RPAQQ FINDFONT 147)

(RPAQQ FLOOR 206)

(RPAQQ FSET 21)

(RPAQQ GE 207)

(RPAQQ GETCP 159)

(RPAQQ GETPROP 287)

(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 MAKEPIXELARRAY 450)

(RPAQQ MAKESAMPLEDBLACK 426)

(RPAQQ MAKESAMPLEDCOLOR 427)

(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 MASKTRAPEZOIDX 411)

(RPAQQ MASKTRAPEZOIDY 412)

(RPAQQ MASKUNDERLINE 414)

(RPAQQ MASKVECTOR 441)

(RPAQQ MERGEPROP 288)

(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 REM 216)

(RPAQQ ROLL 184)

(RPAQQ ROTATE 163)

(RPAQQ ROUND.IPOP 217)

(RPAQQ SCALE.OP 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 SHAPE.IPOP 285)

(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.OP 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)
	   (ERROR.IPOP 600)
	   (EXCH 185)
	   (FGET 20)
	   (FINDCOLOR 423)
	   (FINDCOLORMODELOPERATOR 422)
	   (FINDCOLOROPERATOR 421)
	   (FINDDECOMPRESSOR 149)
	   (FINDFONT 147)
	   (FLOOR 206)
	   (FSET 21)
	   (GE 207)
	   (GETCP 159)
	   (GETPROP 287)
	   (GT 208)
	   (IF 239)
	   (IFCOPY 240)
	   (IFELSE 241)
	   (IGET 18)
	   (ISET 19)
	   (LINETO 23)
	   (LINETOX 14)
	   (LINETOY 15)
	   (MAKEGRAY 425)
	   (MAKEOUTLINE 417)
	   (MAKEPIXELARRAY 450)
	   (MAKESAMPLEDBLACK 426)
	   (MAKESAMPLEDCOLOR 427)
	   (MAKESIMPLECO 114)
	   (MAKEPIXELARRAY 450)
	   (MAKEVEC 283)
	   (MAKEVECLU 282)
	   (MARK 186)
	   (MASKFILL 409)
	   (MASKPIXEL 452)
	   (MASKRECTANGLE 410)
	   (MASKSTROKE 24)
	   (MASKTRAPEZOIDX 411)
	   (MASKTRAPEZOIDY 412)
	   (MASKUNDERLINE 414)
	   (MASKVECTOR 441)
	   (MERGEPROP 288)
	   (MOD 209)
	   (MODIFYFONT 148)
	   (MOVE 169)
	   (MOVETO 25)
	   (MUL 210)
	   (NEG 211)
	   (NOP 1)
	   (NOT 212)
	   (OR 213)
	   (POP 180)
	   (REM 216)
	   (ROLL 184)
	   (ROTATE 163)
	   (ROUND.IPOP 217)
	   (SCALE.OP 164)
	   (SCALE2 166)
	   (SETCORRECTMEASURE 154)
	   (SETCORRECTTOLERANCE 155)
	   (SETFONT 151)
	   (SETGRAY 424)
	   (SETXREL 12)
	   (SETXY 10)
	   (SETXYREL 11)
	   (SETYREL 13)
	   (SHAPE.IPOP 285)
	   (SHOW 22)
	   (SHOWANDXREL 146)
	   (SPACE 16)
	   (STARTUNDERLINE 413)
	   (SUB 214)
	   (TRANS 170)
	   (TRANSLATE 162)
	   (TRUNC 215)
	   (TYPE.OP 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.IMVAR 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.IMVAR 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.IMVAR 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 ")
		      (NOVERSIONENCODINGSTRING "Interpress/Xerox/")
		      (MAXLONGSEQUENCEBYTES (SUB1 (EXPT 2 16)))
		      (FILETYPE.INTERPRESS 4361)))
(DECLARE: EVAL@COMPILE 

(RPAQ BEGINPREAMBLE {)

(RPAQ ENDPREAMBLE })

(RPAQ BEGINPAGE {)

(RPAQ ENDPAGE })

(RPAQ ENCODINGSTRING "Interpress/Xerox/1.0 ")

(RPAQ NOVERSIONENCODINGSTRING "Interpress/Xerox/")

(RPAQ MAXLONGSEQUENCEBYTES (SUB1 (EXPT 2 16)))

(RPAQQ FILETYPE.INTERPRESS 4361)

(CONSTANTS (BEGINPREAMBLE {)
	   (ENDPREAMBLE })
	   (BEGINPAGE {)
	   (ENDPAGE })
	   (ENCODINGSTRING "Interpress/Xerox/1.0 ")
	   (NOVERSIONENCODINGSTRING "Interpress/Xerox/")
	   (MAXLONGSEQUENCEBYTES (SUB1 (EXPT 2 16)))
	   (FILETYPE.INTERPRESS 4361))
)
)
(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])

(PUTPROPS .IPFONTNAME. DMACRO ((FAMILY)
			       (SELECTQ FAMILY (TIMESROMAN (QUOTE CLASSIC))
					(HELVETICA (QUOTE MODERN))
					(LOGO (QUOTE LOGOTYPES))
					(GACHA (QUOTE TERMINAL))
					FAMILY)))
)

[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 IPHEADINGFONT IPXPOS IPYPOS IPFONT IPPREAMBLEFONTS IPPAGEFONTS 
				    IPWIDTHSCACHE IPCOLOR IPLINEFEED IPPAGESTATE IPSHOWSTREAM 
				    XIPPAGEREGION IPDOCNAME (IPLEFT WORD)
				    (IPBOTTOM WORD)
				    (IPRIGHT WORD)
				    (IPTOP WORD)
				    (IPPAGENUM WORD)
				    (IPPREAMBLENEXTFRAMEVAR BYTE)
				    (IPNEXTFRAMEVAR BYTE)
				    (IPHEADINGOPVAR BYTE)
				    (NSCHARSET BYTE)
				    (NSTRANSTABLE POINTER)
				    (IPCORRECTSTARTX POINTER 
                                                             (* Used with IPXPOS to compute width for CORRECTing 
							     char strings during SHOW.))
				    (IPSPACEFACTOR POINTER)
				    (IPSPACEWIDTH POINTER    (* cached width of space, taking space factor into 
							     account)))
			 IPXPOS ← 0 IPYPOS ← 0 IPNEXTFRAMEVAR ← 0 IPSPACEFACTOR ← 1
			 [ACCESSFNS ((IPWIDTH (IDIFFERENCE (fetch (INTERPRESSDATA IPRIGHT)
							      of DATUM)
							   (fetch (INTERPRESSDATA IPLEFT)
							      of DATUM)))
				     (IPHEIGHT (IDIFFERENCE (fetch (INTERPRESSDATA IPTOP)
							       of DATUM)
							    (fetch (INTERPRESSDATA IPBOTTOM)
							       of DATUM)))
				     (IPPAGEREGION (fetch (INTERPRESSDATA XIPPAGEREGION)
						      of DATUM)
						   (PROGN (replace (INTERPRESSDATA XIPPAGEREGION)
							     of DATUM with NEWVALUE)
							  (replace (INTERPRESSDATA IPLEFT)
							     of DATUM with (fetch (REGION LEFT)
									      of NEWVALUE))
							  (replace (INTERPRESSDATA IPBOTTOM)
							     of DATUM with (fetch (REGION BOTTOM)
									      of NEWVALUE))
							  (replace (INTERPRESSDATA IPRIGHT)
							     of DATUM
							     with (IPLUS (fetch (REGION LEFT)
									    of NEWVALUE)
									 (fetch (REGION WIDTH)
									    of NEWVALUE)))
							  (replace (INTERPRESSDATA IPTOP)
							     of DATUM
							     with (IPLUS (fetch (REGION BOTTOM)
									    of NEWVALUE)
									 (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 WORD WORD 
				  BYTE BYTE BYTE BYTE POINTER POINTER POINTER POINTER)))
)
(/DECLAREDATATYPE (QUOTE INTERPRESSDATA)
		  (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
				  POINTER POINTER POINTER POINTER POINTER WORD WORD WORD WORD WORD 
				  BYTE BYTE BYTE BYTE POINTER POINTER POINTER POINTER)))
(DEFINEQ

(INTERPRESSBITMAP
  [LAMBDA (OUTPUTFILE BITMAP SCALEFACTOR REGION ROTATION TITLE)
                                                             (* rmk: "22-Oct-84 15:15")
                                                             (* Print a bitmap (usually from the screen) into an IP 
							     file)
    (OR BITMAP (SETQ BITMAP (SCREENBITMAP)))
    (PROG [(IPSTREAM (OPENIMAGESTREAM (OR OUTPUTFILE (QUOTE {CORE}IPBITMAP.SCRATCH))
				      (QUOTE INTERPRESS)))
	   [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 (RELMOVETO (IDIFFERENCE (TIMES 4 MICASPERINCH)
					   (STRINGWIDTH TITLE IPSTREAM))
			      0 IPSTREAM)
		   (PRIN1 TITLE 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"))
          [\MOVETO.IP IPSTREAM [\RPLUS2 (\RTIMES2 MICASPERINCH 4.25)
					(\RTIMES2 W (CONSTANT (\RTIMES2 MICASPERPOINT ONEHALF]
		      (\RPLUS2 (\RTIMES2 MICASPERINCH 5.5)
			       (\RTIMES2 H (CONSTANT (\RTIMES2 MICASPERPOINT ONEHALF]
                                                             (* Position so that the bitmap's image is centered on 
							     the paper)
          (SHOWBITMAP.IP IPSTREAM BITMAP REGION SCALEFACTOR ROTATION)
          (RETURN (CLOSEF IPSTREAM])
)

(ADDTOVAR IMAGESTREAMTYPES (INTERPRESS (OPENSTREAM OPENIPSTREAM)
				       (FONTCREATE \CREATEINTERPRESSFONT)
				       (FONTSAVAILABLE \SEARCHINTERPRESSFONTS)))

(ADDTOVAR PRINTERTYPES ((INTERPRESS 8044)
			(CANPRINT (INTERPRESS))
			(STATUS NSPRINTER.STATUS)
			(PROPERTIES NSPRINTER.PROPERTIES)
			(SEND NSPRINT)
			(BITMAPSCALE INTERPRESS.BITMAPSCALE)
			(BITMAPFILE (INTERPRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE)))
)

(ADDTOVAR PRINTFILETYPES [INTERPRESS (TEST INTERPRESSFILEP)
				     (EXTENSION (IP IPR INTERPRESS))
				     (CONVERSION (TEXT MAKEINTERPRESS TEDIT
						       (LAMBDA (FILE PFILE)
							       (SETQ FILE (OPENTEXTSTREAM FILE))
							       (TEDIT.FORMAT.HARDCOPY FILE PFILE T 
										      NIL NIL NIL
										      (QUOTE 
										       INTERPRESS))
							       (CLOSEF? FILE)
							       PFILE])

(RPAQ? DEFAULT.INTERPRESS.BITMAP.ROTATION 90)

(ADDTOVAR SYSTEMINITVARS (INTERPRESSFONTDIRECTORIES {DSK}))

(RPAQ? INTERPRESSFONTDIRECTORIES (QUOTE {ERIS}<LISP>FONTS>))



(* "NS Character Encoding")

(DEFINEQ

(NSMAP
  [LAMBDA (ZERODEFAULT MAP)                                  (* rmk: " 3-Dec-84 11:15")
    (PROG ((TABLE (ARRAY 256 (QUOTE WORD)
			 0 0)))
          (OR ZERODEFAULT (for I from 0 to 255 do (SETA TABLE I I)))
          [for X in MAP do (SETA TABLE (OR (FIXP (CAR X))
					   (APPLY* (FUNCTION CHARCODE)
						   (CAR X)))
				 (LOGOR (LLSH (CADR X)
					      8)
					(CADDR X]
          (RETURN TABLE])

(\COERCEASCIITONSFONT
  [LAMBDA (ASCIITONSMAPARRAY ASCIITONSFIXARRAY ASCIIFAMILY NSFAMILY SIZE FONTFACE ROTATION DEVICE)
                                                             (* rmk: " 3-Dec-84 11:11")
                                                             (* Produces an ascii font with the proper widths for 
							     the ns-character correspondences defined by 
							     ASCIITONSMAPARRAY)
                                                             (* ASCIITONSFIXARRAY is for temporary problems with 
							     font compatibility between printer and widths/screen.
							     in OS5.0 fonts)
    (PROG (CHARSETDIR [ASCIITONSMAP (fetch (ARRAYP BASE) of (\DTEST (OR ASCIITONSFIXARRAY 
									ASCIITONSMAPARRAY)
								    (QUOTE ARRAYP]
		      (FD (\CREATESTARFONT NSFAMILY SIZE FONTFACE ROTATION DEVICE)))
          (OR FD (RETURN NIL))
          (SETQ CHARSETDIR (CONS (CONS 0 FD)))
          [for I NSCODE CS from 0 to 255 unless (OR (EQ I (SETQ NSCODE (\GETBASE ASCIITONSMAP I)))
						    (ASSOC (SETQ CS (\CHARSET NSCODE))
							   CHARSETDIR))
	     do                                              (* Run thru the translate table looking for non-0 
							     charsets. Add their width info to the directory)
		(push CHARSETDIR (CONS CS
				       (COND
					 ((\CREATESTARFONT NSFAMILY SIZE FONTFACE ROTATION DEVICE CS))
					 (T                  (* There isn't any info for that character.
							     Warn the guy, but continue.)
					    (FRESHLINE PROMPTWINDOW)
					    (printout PROMPTWINDOW 
						     "Warning:  Information about character set "
						      .I3.8 CS " missing from font " ASCIIFAMILY , 
						      SIZE ".")
					    NIL]             (* Return if one of the fonts couldn't be found)
          (bind CHARSETINFO for I NSCODE (WD ←(fetch \SFWidths of FD)) from 0 to 255
	     unless (EQ I (SETQ NSCODE (\GETBASE ASCIITONSMAP I)))
	     when (SETQ CHARSETINFO (CDR (ASSOC (\CHARSET NSCODE)
						CHARSETDIR)))
	     do                                              (* For each non-ASCII character, look for width info in
							     the right NS place. If none, use zero width.)
		(SETA WD I (CHARWIDTH (\CHAR8CODE NSCODE)
				      CHARSETINFO)))
          [replace OTHERDEVICEFONTPROPS of FD with (fetch (ARRAYP BASE) of (\DTEST ASCIITONSMAPARRAY
										   (QUOTE ARRAYP]
          [COND
	    ((NEQ NSFAMILY ASCIIFAMILY)

          (* Update the font deacriptor so it looks like it's really for the family the guy wanted. Also save the info we used
	  to get here.)


	      (replace FONTFAMILY of FD with ASCIIFAMILY)
	      (replace FONTDEVICESPEC of FD with (LIST NSFAMILY SIZE FONTFACE ROTATION DEVICE]
          (RETURN FD])

(\CREATEINTERPRESSFONT
  [LAMBDA (FAMILY SIZE FONTFACE ROTATION DEVICE)             (* mjs "14-Feb-85 19:59")
                                                             (* Creates a font descriptor for an NS font for 
							     hardcopy. Tries first on the assumption that he gave us
							     the NS font name;)
    (DECLARE (GLOBALVARS \ASCIITONS \ASCIITOSTAR ASCIITONSTRANSLATIONS))
    (if (\COERCEASCIITONSFONT \ASCIITONS \ASCIITOSTAR FAMILY FAMILY SIZE FONTFACE ROTATION DEVICE)
      elseif (for TRANSL in ASCIITONSTRANSLATIONS bind NEWFONT
		when (AND (EQ FAMILY (CAR TRANSL))
			  (SETQ NEWFONT (\COERCEASCIITONSFONT (COND
								((NULL (CADR TRANSL))
								  \ASCIITONS)
								((LITATOM (CADR TRANSL))
								  (EVAL (CADR TRANSL)))
								(T (CADR TRANSL)))
							      (COND
								((NULL (CADR TRANSL))
								  \ASCIITOSTAR)
								(T NIL))
							      FAMILY
							      (OR (CADDR TRANSL)
								  (QUOTE MODERN))
							      SIZE FONTFACE ROTATION DEVICE)))
		do (RETURN NEWFONT])

(\SEARCHINTERPRESSFONTS
  [LAMBDA (FAMILY PSIZE FACE ROTATION DEVICE)                (* rrb " 7-Nov-84 15:56")

          (* * returns a list of the form (family size face rotation INTERPRESS) for any font matching the specs.
	  * is used as wildcard.)


    (DECLARE (GLOBALVARS INTERPRESSFONTDIRECTORIES))
    (bind FONTSFOUND THISFONT (FILENAMEPATTERN ←(\FONTFILENAME FAMILY PSIZE FACE (QUOTE WD)))
       for DIR inside INTERPRESSFONTDIRECTORIES
       do [for FONTFILE in (DIRECTORY (PACKFILENAME (QUOTE DIRECTORY)
						    DIR
						    (QUOTE BODY)
						    FILENAMEPATTERN))
	     when [PROGN (SETQ THISFONT (\FONTINFOFROMFILENAME FONTFILE (QUOTE INTERPRESS)))
			 (AND (OR (EQ FAMILY (QUOTE *))
				  (EQ FAMILY (CAR THISFONT)))
			      (OR (EQ PSIZE (QUOTE *))
				  (EQ PSIZE (CADR THISFONT)))
			      (OR (EQ FACE (QUOTE *))
				  (EQUAL FACE (CADDR THISFONT]
	     do                                              (* make sure the file is appropriate e.g. the directory
							     pattern for CLASSIC if SIZE is * will match 
							     CLASSICTHIN10 as well.)
		(OR (MEMBER THISFONT FONTSFOUND)
		    (SETQ FONTSFOUND (CONS THISFONT FONTSFOUND]
       finally (RETURN FONTSFOUND])
)

(RPAQ? ASCIITONSTRANSLATIONS )



(* "Catch the GACHA10 and any BI coercions to MODERN")


(ADDTOVAR ASCIITONSTRANSLATIONS (TIMESROMAN NIL CLASSIC)
				(GACHA NIL TERMINAL)
				(HELVETICA)
				(CLASSIC)
				(GACHA)
				(TIMESROMAN)
				(LOGO NIL LOGOTYPES)
				(HIPPO HIPPOTONSARRAY CLASSIC)
				(CYRILLIC CYRILLICTONSARRAY CLASSIC)
				(SYMBOL \SYMBOLTONSARRAY MODERN))
(READVARS \SYMBOLTONSARRAY HIPPOTONSARRAY CYRILLICTONSARRAY)
({Y256 SMALLPOSP 0 0 0 180 42 0 61287 177 61309 61282 61283 61284 61285 0 184 0 0 61296 61298 61273 
61272 8549 8550 0 0 61054 61305 61275 61274 8546 61299 0 0 0 174 173 175 61266 61250 61251 61303 61261
 61263 0 0 61262 {R4 0} 8551 61258 61259 61281 0 61292 172 61365 61364 61290 61351 {R5 0} 65 66 67 68 
69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 61271 61270 0 61366 61367 61238 
61239 61362 61363 61360 61361 123 125 61234 61235 61052 8514 61243 61242 8740 8742 61308 35 0 61301 {R
4 0} 167 61232 61233 182 64 211 163 164 {R128 0} }  {Y256 SMALLPOSP 0 0 1 2 3 4 5 6 7 8 9 10 11 12 13 
14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 164 37 38 39 40 41 42 43 44 8510 46 
47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 9793 9794 9809 9797 9798 9818 9796 9802 9804 
9728 9805 9806 9807 9808 9810 9811 9803 9813 9814 9816 9817 9728 9821 9819 9820 9801 91 92 93 173 172 
185 9825 9826 9841 9829 9830 9850 9828 9834 9836 9847 9837 9838 9839 9840 9842 9843 9835 9845 9846 
9848 9849 9728 9853 9851 9852 9833 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139
 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 61220 61221 157 158 159 160 161 162 163 
164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 61286 184 185 186 187 188 
189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 
214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 
239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 }  {Y256 SMALLPOSP 0 0 1 2 3 4 5 6
 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 10023 37 38 39 40
 41 10041 43 44 8510 46 47 48 49 10095 51 10071 53 10088 55 10089 57 58 59 171 61 187 63 10047 10017 
10018 10046 10021 10022 10038 10020 10049 10026 10027 10028 10029 10030 10031 10032 10033 10039 10034 
10035 10036 10037 10019 10024 10045 10048 10025 10090 9984 10091 10044 10092 9984 10065 10066 10110 
10069 10070 10086 10068 10097 10074 10075 10076 10077 10078 10079 10080 10081 10087 10082 10083 10084 
10085 10067 10072 10093 10096 10073 10042 9984 10043 10040 9984 128 129 130 131 132 133 134 135 136 
137 138 139 140 141 142 10094 144 145 146 147 148 149 150 151 152 153 154 61220 61221 157 158 159 160 
161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 61286 184 185 
186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 
211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 
236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 })
(DECLARE: DONTEVAL@LOAD DOCOPY 
(\INTERPRESSINIT)
)
(PUTPROPS INTERPRESS COPYRIGHT ("Xerox Corporation" 1983 1984 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (6533 11080 (APPENDBYTE.IP 6543 . 6682) (APPENDIDENTIFIER.IP 6684 . 7168) (APPENDINT.IP 
7170 . 7401) (APPENDINTEGER.IP 7403 . 7804) (APPENDLARGEVECTOR.IP 7806 . 8601) (APPENDNUMBER.IP 8603
 . 9077) (APPENDOP.IP 9079 . 9520) (APPENDRATIONAL.IP 9522 . 9871) (APPENDSEQUENCEDESCRIPTOR.IP 9873
 . 10727) (BYTESININT.IP 10729 . 10903) (EXTRACTBYTE.IP 10905 . 11078)) (11114 24078 (BEGINMASTER.IP 
11124 . 11278) (BEGINPAGE.IP 11280 . 11553) (BEGINPREAMBLE.IP 11555 . 11815) (CONCAT.IP 11817 . 11962)
 (CONCATT.IP 11964 . 12111) (ENDMASTER.IP 12113 . 12368) (ENDPAGE.IP 12370 . 12653) (ENDPREAMBLE.IP 
12655 . 13347) (FGET.IP 13349 . 13532) (FILLTRAJECTORY.IP 13534 . 13810) (FSET.IP 13812 . 13995) (
GETFRAMEVAR.IP 13997 . 14326) (INITIALIZEMASTER.IP 14328 . 14731) (ISET.IP 14733 . 15034) (LINETO.IP 
15036 . 15389) (MASKSTROKE.IP 15391 . 15544) (MOVETO.IP 15546 . 15899) (ROTATE.IP 15901 . 16083) (
SCALE.IP 16085 . 16268) (SCALE2.IP 16270 . 16488) (SETFONT.IP 16490 . 16985) (SETSPACE.IP 16987 . 
17179) (SETXREL.IP 17181 . 17725) (SETX.IP 17727 . 18670) (SETXY.IP 18672 . 19538) (SETXYREL.IP 19540
 . 20347) (SETY.IP 20349 . 21143) (SETYREL.IP 21145 . 21408) (SHOW.IP 21410 . 23214) (TRAJECTORY.IP 
23216 . 23583) (TRANS.IP 23585 . 23849) (TRANSLATE.IP 23851 . 24076)) (24105 71788 (DEFINEFONT.IP 
24115 . 24918) (FONTNAME.IP 24920 . 25700) (HEADINGOP.IP 25702 . 27007) (INTERPRESS.BITMAPSCALE 27009
 . 27447) (INTERPRESS.OUTCHARFN 27449 . 28891) (INTERPRESSFILEP 28893 . 30062) (MAKEINTERPRESS 30064
 . 30263) (NEWLINE.IP 30265 . 30945) (NEWPAGE.IP 30947 . 34454) (NEWPAGE?.IP 34456 . 34862) (
OPENIPSTREAM 34864 . 37649) (SETUPFONTS.IP 37651 . 38606) (SHOWBITMAP.IP 38608 . 41227) (
SHOWBITMAP1.IP 41229 . 45940) (SHOWSHADE.IP 45942 . 49057) (\BITBLT.IP 49059 . 49990) (
\SCALEDBITBLT.IP 49992 . 50933) (\BLTSHADE.IP 50935 . 51717) (\CHARWIDTH.IP 51719 . 52253) (
\CLOSEIPSTREAM 52255 . 52579) (\DRAWCIRCLE.IP 52581 . 53550) (\DRAWCURVE.IP 53552 . 55489) (\IPCURVE2 
55491 . 61558) (\DRAWELLIPSE.IP 61560 . 62685) (\DRAWLINE.IP 62687 . 63310) (\DSPBOTTOMMARGIN.IP 63312
 . 63628) (\DSPFONT.IP 63630 . 65992) (\DSPLEFTMARGIN.IP 65994 . 66344) (\DSPLINEFEED.IP 66346 . 66896
) (\DSPRIGHTMARGIN.IP 66898 . 67251) (\DSPSPACEFACTOR.IP 67253 . 68047) (\DSPTOPMARGIN.IP 68049 . 
68356) (\DSPXPOSITION.IP 68358 . 68924) (\DSPYPOSITION.IP 68926 . 69206) (\FIXLINELENGTH.IP 69208 . 
69967) (\MOVETO.IP 69969 . 70136) (\SETBRUSH.IP 70138 . 70914) (\STRINGWIDTH.IP 70916 . 71384) (
\DSPCLIPPINGREGION.IP 71386 . 71786)) (71789 74860 (\INTERPRESSINIT 71799 . 74858)) (74861 75418 (
SCALEREGION 74871 . 75416)) (90716 92867 (INTERPRESSBITMAP 90726 . 92865)) (93957 100068 (NSMAP 93967
 . 94482) (\COERCEASCIITONSFONT 94484 . 97509) (\CREATEINTERPRESSFONT 97511 . 98669) (
\SEARCHINTERPRESSFONTS 98671 . 100066)))))
STOP