(FILECREATED "31-Mar-86 16:09:38" {ERIS}<LISPUSERS>KOTO>PRESSFROMNS.;17 49130  

      changes to:  (VARS PRESSFROMNSCOMS ASCIIFROM0ARRAY ASCIIFROM38ARRAY ASCIIFROM39ARRAY 
			 ASCIIFROM239ARRAY)
		   (FNS \PRESS.COERCEFONT \COERCEFONT \CREATEPRESSFONT \ENTITYSTART.PRESS 
			\SMASHPRESSFONTS GETCHARPRESSTRANSLATION PRESS.NSARRAY 
			PUTCHARPRESSTRANSLATION \DSPFONT.PRESS \DSPSPACEFACTOR.PRESS 
			\DSPFONT.PRESSFONT \CREATECHARSET.PRESS \STRINGWIDTH.PRESS \CHARWIDTH.PRESS 
			\OUTCHARFN.PRESS \NSTOASCIIARRAY \NSTOASCIITRANSLATION PRESSFONT? 
			\PRESS.CONVERT.NSCHARACTER)
		   (RECORDS PRESSDATA)

      previous date: " 5-Mar-86 10:36:56" {ERIS}<LISPUSERS>KOTO>PRESSFROMNS.;9)


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

(PRETTYCOMPRINT PRESSFROMNSCOMS)

(RPAQQ PRESSFROMNSCOMS [(* This file uses CONSTANTS defined in PRESS, so it is necessary to 
			     LOADFROM PRESS before changing this file.)
			  (FNS \SMASHPRESSFONTS)
			  (FNS GETCHARPRESSTRANSLATION PRESS.NSARRAY PUTCHARPRESSTRANSLATION)
			  (FNS \DSPFONT.PRESS \DSPSPACEFACTOR.PRESS \ENTITYSTART.PRESS 
			       \SETSPACE.PRESS \STARTPAGE.PRESS \PRESS.COERCEFONT \DSPFONT.PRESSFONT)
			  (FNS \CREATEPRESSFONT \CREATECHARSET.PRESS)
			  (COMS (* Generic utility for coercing fonts, could be used by other devices)
				(FNS \COERCEFONT))
			  (ALISTS (FONTCOERCIONS PRESS)
				  (MISSINGFONTCOERCIONS PRESS))
			  (GLOBALVARS FONTCOERCIONS MISSINGFONTCOERCIONS)
			  (FNS \STRINGWIDTH.PRESS \CHARWIDTH.PRESS \OUTCHARFN.PRESS)
			  (* * new declaration for PRESSDATA)
			  (DECLARE: DONTCOPY (RECORDS PRESSDATA))
			  (INITRECORDS PRESSDATA)
			  (* * NSTOASCIITRANSLATIONS is a list with elements of the form
			     (charset translationArrayName)
			     , where translationArrayName is bound to a translation array for charset 
			     which contains (fontFamily charcode)
			     lists)
			  (FNS \NSTOASCIIARRAY \NSTOASCIITRANSLATION)
			  (GLOBALVARS NSTOASCIITRANSLATIONS)
			  [INITVARS (PRESSFONTFAMILIES (QUOTE ((GACHA)
							       (TIMESROMAN)
							       (HELVETICA)
							       (SYMBOL)
							       (MATH)
							       (HIPPO)
							       (CYRILLIC]
			  (INITVARS (NSTOASCIITRANSLATIONS))
			  (ADDVARS (NSTOASCIITRANSLATIONS (0 ASCIIFROM0ARRAY)
							  (38 ASCIIFROM38ARRAY)
							  (39 ASCIIFROM39ARRAY)
							  (239 ASCIIFROM239ARRAY)))
			  (UGLYVARS ASCIIFROM0ARRAY ASCIIFROM38ARRAY ASCIIFROM39ARRAY 
				    ASCIIFROM239ARRAY)
			  (P (\SMASHPRESSFONTS))
			  (DECLARE: DONTCOPY (CONSTANTS (unknownCharTranslation (QUOTE (MATH 59])



(* This file uses CONSTANTS defined in PRESS, so it is necessary to LOADFROM PRESS before 
changing this file.)

(DEFINEQ

(\SMASHPRESSFONTS
  [LAMBDA NIL                                                (* rmk: "24-Feb-86 11:23")
                                                             (* Executed after all patchfns have been loaded, 
							     coerces existing Koto press fonts into NS-type press 
							     fonts)
    (FOR F IN (FONTSAVAILABLE (QUOTE *)
				    (QUOTE *)
				    (QUOTE *)
				    (QUOTE *)
				    (QUOTE PRESS))
       DO (SETQ F (FONTCREATE F))
	    (if (NULL (fetch OTHERDEVICEFONTPROPS of F))
		then (replace OTHERDEVICEFONTPROPS of F with (LIST (fetch \SFAscent
										of F)
									     (fetch \SFDescent
										of F)))
		       (\CREATECHARSET 0 F])
)
(DEFINEQ

(GETCHARPRESSTRANSLATION
  (LAMBDA (CHARCODE FONT)                                  (* thh: "28-Feb-86 12:03")
                                                             (* returns the Press translation for a character in a 
							     font)
    (COND
      ((OR (CHARCODEP CHARCODE)
	     (EQ CHARCODE 256))                            (* bitmap for char 256 is what gets printed if char 
							     not found)
	)
      ((OR (STRINGP CHARCODE)
	     (LITATOM CHARCODE))
	(SETQ CHARCODE (CHCON1 CHARCODE)))
      (T (\ILLEGAL.ARG CHARCODE)))
    (LET (TR CSINFO (FONTDESC (\GETFONTDESC FONT (QUOTE PRESS))))
                                                             (* fetch the csinfo for the character set of this 
							     character.)
         (SETQ CSINFO (\GETCHARSETINFO (\CHARSET CHARCODE)
					 FONTDESC))
         (SETQ TR (\GETBASEPTR (fetch (CHARSETINFO CHARSETBITMAP) of CSINFO)
				   (UNFOLD (\CHAR8CODE CHARCODE)
					   2)))              (* Return a copy)
         (LIST (CAR TR)
		 (CDR TR)))))

(PRESS.NSARRAY
  (LAMBDA (CHARSET FAMILY ASCIIARRAY)                      (* thh: "28-Feb-86 12:08")
                                                             (* using info in ASCIIARRAY or ASCIITONSTRANSLATIONS, 
							     creates an array of (pressFont charcode) lists)
    (LET* ((min (TIMES 256 CHARSET))
	   (max (PLUS min 255))
	   (array (ARRAY 256 NIL NIL 0)))
          (for item in (COND
			     (ASCIIARRAY (BQUOTE ((, FAMILY ASCIIARRAY))))
			     (T ASCIITONSTRANSLATIONS))
	     bind asciiArray
	     do 

          (* * item is of the form (PressFont TranslationArray NSFont))


		  (SETQ asciiArray (EVAL (CADR item)))
		  (COND
		    (asciiArray (for i from 0 to 255 do (SETA array
									(REMAINDER (ELT 
										       asciiArray i)
										     256)
									(LIST (CAR item)
										i))
				   when (AND (LEQ min (ELT asciiArray i))
						 (LEQ (ELT asciiArray i)
							max))))))
      array)))

(PUTCHARPRESSTRANSLATION
  (LAMBDA (CHARCODE FONT NEWTRANSLATION)                   (* thh: " 5-Mar-86 10:22")
                                                             (* Changes the Press translation for a character in a 
							     font)
    (COND
      ((CHARCODEP CHARCODE))
      ((OR (STRINGP CHARCODE)
	     (LITATOM CHARCODE))
	(SETQ CHARCODE (CHCON1 CHARCODE)))
      (T (\ILLEGAL.ARG CHARCODE)))
    (PROG* ((FONTDESC (\GETFONTDESC FONT (QUOTE PRESS)))
	    (CSINFO (\GETCHARSETINFO (\CHARSET CHARCODE)
				     FONTDESC))
	    (CHAR8CODE (\CHAR8CODE CHARCODE))
	    (TR (\NSTOASCIITRANSLATION NEWTRANSLATION NIL FONTDESC)))
           (UNINTERRUPTABLY
               (\RPLPTR (ffetch (CHARSETINFO CHARSETBITMAP) of CSINFO)
			  (UNFOLD CHAR8CODE 2)
			  TR)
	       (\PUTBASE (ffetch (CHARSETINFO WIDTHS) of CSINFO)
			   CHAR8CODE
			   (\FGETWIDTH (ffetch \SFWidths of (CAR TR))
				       (CDR TR)))
	       (change (ffetch CHARSETASCENT of CSINFO)
			 (MAX DATUM (CAR (ffetch OTHERDEVICEFONTPROPS of (CAR TR)))))
	       (change (ffetch CHARSETDESCENT of CSINFO)
			 (MAX DATUM (CADR (ffetch OTHERDEVICEFONTPROPS of (CAR TR)))))
	       (freplace \SFHeight of FONTDESC with (PLUS (change (ffetch \SFAscent
									       of FONTDESC)
									    (MAX DATUM
										   (ffetch 
										    CHARSETASCENT
										      of CSINFO)))
								  (change (ffetch \SFDescent
									       of FONTDESC)
									    (MAX DATUM
										   (ffetch 
										   CHARSETDESCENT
										      of CSINFO)))))
)
           (RETURN NEWTRANSLATION))))
)
(DEFINEQ

(\DSPFONT.PRESS
  [LAMBDA (PRSTREAM FONT)                                    (* rmk: "25-Feb-86 11:05")

          (* * The DSPFONT method for PRESS-type image streams -- change the stream's current logical font to FONT;
	  the device font changes only when we print a character)


    (PROG (OLDFONT FDENTRY (PRDATA (ffetch IMAGEDATA of PRSTREAM)))
	    (SETQ OLDFONT (ffetch PRLOGICALFONT of PRDATA))
	    (COND
	      ([OR (NULL FONT)
		     (EQ OLDFONT (SETQ FONT (OR (\GETFONTDESC FONT (QUOTE PRESS)
								      T)
						      (FONTCOPY OLDFONT FONT]
		(RETURN OLDFONT)))
	    (freplace PRLOGICALFONT of PRDATA with FONT)
	    (freplace PRLOGICALCHARSET of PRDATA with NIL)
	    [\SETSPACE.PRESS PRSTREAM (FIXR (TIMES (ffetch PRSPACEFACTOR of PRDATA)
							 (\FGETCHARWIDTH FONT (CHARCODE SPACE]
	    [freplace PRLINEFEED of PRDATA with (IDIFFERENCE (CONSTANT (IMINUS 
										    MicasPerPoint))
								     (FONTPROP FONT (QUOTE HEIGHT]
	    (\FIXLINELENGTH.PRESS PRSTREAM)
	    (RETURN OLDFONT])

(\DSPSPACEFACTOR.PRESS
  [LAMBDA (STREAM FACTOR)                                    (* rmk: "24-Feb-86 09:49")
    (LET ((PRDATA (ffetch IMAGEDATA of STREAM)))
         (PROG1 (ffetch PRSPACEFACTOR of PRDATA)
		  (COND
		    (FACTOR (SHOW.PRESS STREAM)
			    (freplace PRSPACEFACTOR of PRDATA with FACTOR)
			    (\SETSPACE.PRESS STREAM (FIXR (TIMES FACTOR
								       (\FGETCHARWIDTH (ffetch
											 
										    PRLOGICALFONT
											  of PRDATA)
										       (CHARCODE
											 SPACE])

(\ENTITYSTART.PRESS
  [LAMBDA (PRSTREAM)                                         (* rmk: "25-Feb-86 11:37")
    (PROG ((PRDATA (fetch IMAGEDATA of PRSTREAM)))
	    (freplace PRSPACEWIDTH of PRDATA with NIL)

          (* This really should be the spacewidth of the current font. But then, if we switch fonts to one whose 
	  space*spacefactor comes out the same, we won't know to put out a setspace command. So when we actually set up the 
	  first font in this entity, we will end up putting out an explicit setspace (even if the space factor is 1))


	    (freplace PRLOGICALFONT of PRDATA with NIL)

          (* We set the font to NIL, knowing that the current font can be recoverd from the PRCURRFDE.
	  This font will be set in the press file before the first show, if no explicit dspfont intervenes.
	  Note, however, that up until the first dspfont, the widthscache still corresponds to what was the PRLOGICALFONT)


	    (freplace DLSTARTBYTE of PRDATA with (\GETFILEPTR PRSTREAM))
	    (freplace ELSTARTBYTE of PRDATA with (\GETFILEPTR (fetch ELSTREAM of PRDATA)))
	    (freplace STARTCHARBYTE of PRDATA with (\GETFILEPTR PRSTREAM))
                                                             (* Entity starts with position at 0,0 so must 
							     re-establish current position 
							     (?))
	    (SETXY.PRESS PRSTREAM (fetch PRXPOS of PRDATA)
			   (fetch PRYPOS of PRDATA])

(\SETSPACE.PRESS
  [LAMBDA (PRSTREAM S)                                       (* rmk: "31-Mar-86 16:08")
    (PROG (ELSTREAM (PRDATA (fetch IMAGEDATA of PRSTREAM)))
	    (AND (EQ S (ffetch PRSPACEWIDTH of PRDATA))
		   (RETURN))
	    (SHOW.PRESS PRSTREAM)
	    (SETQ ELSTREAM (fetch ELSTREAM of (fetch IMAGEDATA of PRSTREAM)))
	    (if (ILEQ S 2047)
		then (\WOUT ELSTREAM (IPLUS (LLSH SetSpaceXShortCode 8)
						S))
	      else (\BOUT ELSTREAM SetSpaceXCode)
		     (\WOUT ELSTREAM S))
	    (freplace PRSPACEWIDTH of PRDATA with S])

(\STARTPAGE.PRESS
  [LAMBDA (PRSTREAM)                                         (* rmk: "25-Feb-86 11:36")
                                                             (* Should be called only when no previous page is 
							     open)
    (PROG (CFONT HFONT SPACEFACTOR (PRDATA (ffetch IMAGEDATA of PRSTREAM)))
	    (SETQ CFONT (ffetch PRLOGICALFONT of PRDATA))

          (* Save current font so that \ENTITYSTART.PRESS can make PRLOGICALFONT be NIL, indicating that there is no actual 
	  font at the beginning of a page)


	    (\ENTITYSTART.PRESS PRSTREAM)
	    [COND
	      ((ffetch PRHEADING of PRDATA)
		(SETQ SPACEFACTOR (ffetch PRSPACEFACTOR of PRDATA))
		(freplace PRSPACEFACTOR of PRDATA with 1)
		(SETQ HFONT (ffetch PRHEADINGFONT of PRDATA))
		(\DSPFONT.PRESS PRSTREAM HFONT)            (* Set up heading font)
		[SETXY.PRESS PRSTREAM (ffetch PRLEFT of PRDATA)
			       (IDIFFERENCE (ffetch PRTOP of PRDATA)
					      (FONTPROP HFONT (QUOTE ASCENT]
		(PRIN3 (ffetch PRHEADING of PRDATA)
			 PRSTREAM)                           (* Skip an inch before page number)
		(SHOW.PRESS PRSTREAM)
		(SETX.PRESS PRSTREAM (IPLUS MICASPERINCH (ffetch PRXPOS of PRDATA)))
		(PRIN3 "Page " PRSTREAM)
		(PRIN3 (add (ffetch PRPAGENUM of PRDATA)
				1)
			 PRSTREAM)
		(NEWLINE.PRESS PRSTREAM)                   (* Skip 2 lines)
		(NEWLINE.PRESS PRSTREAM)
		(freplace PRSPACEFACTOR of PRDATA with SPACEFACTOR))
	      (T (SETXY.PRESS PRSTREAM (ffetch PRLEFT of PRDATA)
				(IDIFFERENCE (ffetch PRTOP of PRDATA)
					       (FONTPROP CFONT (QUOTE ASCENT]
                                                             (* Now we set the font to our 
							     (previous) current font)
	    (\DSPFONT.PRESS PRSTREAM CFONT])

(\PRESS.COERCEFONT
  [LAMBDA (FONT FAMILY)                                      (* rmk: "25-Mar-86 15:44")
                                                             (* coerces FONT to be new FAMILY FAMILY, and caches 
							     result on \PRESS.COERCEDFONTS)
    (DECLARE (GLOBALVARS \PRESS.COERCEDFONTS))
    (COND
      [[OR (NOT FAMILY)
	     (EQ FAMILY (FONTPROP FONT (QUOTE FAMILY]
                                                             (* Don't call FONTCOPY if it's the same font.
							     This avoids circularity thru AVGCHARWIDTH and 
							     CHARWIDTH before the font has been stored in 
							     \FONTSINCORE.)
	(COND
	  ((EQ (QUOTE PRESS)
		 (FONTPROP FONT (QUOTE DEVICE)))         (* How could it not be PRESS? Ask Tad.)
	    FONT)
	  (T (FONTCOPY FONT (QUOTE DEVICE)
			 (QUOTE PRESS]
      ((OR (FONTP FAMILY)
	     (LISTP FAMILY))                               (* FAMILY is a font specification)
	(FONTCOPY FAMILY (QUOTE DEVICE)
		    (QUOTE PRESS)))
      [(FONTP (CADR (ASSOC FONT (CDR (ASSOC FAMILY \PRESS.COERCEDFONTS]
      (T (LET [(pressFont (OR (FONTCOPY FONT (QUOTE FAMILY)
					    FAMILY
					    (QUOTE DEVICE)
					    (QUOTE PRESS)
					    (QUOTE NOERROR)
					    T)
				(FONTCOPY FONT (QUOTE FAMILY)
					    FAMILY
					    (QUOTE FACE)
					    (QUOTE STANDARD)
					    (QUOTE DEVICE)
					    (QUOTE PRESS]
	      (push [CDR (OR (ASSOC FAMILY \PRESS.COERCEDFONTS)
				   (CAR (push \PRESS.COERCEDFONTS (CONS FAMILY]
		      (LIST FONT pressFont))
	  pressFont])

(\DSPFONT.PRESSFONT
  (LAMBDA (PRSTREAM PRFONT)                                  (* thh: "28-Feb-86 11:29")
                                                             (* Changes the Pressfiles device font)
    (PROG (FDENTRY LFONT (PRDATA (ffetch IMAGEDATA of PRSTREAM)))
	    (SHOW.PRESS PRSTREAM)
	    (SETQ FDENTRY (\DEFINEFONT.PRESS PRSTREAM PRFONT))
	    (COND
	      ((NEQ (ffetch FONTSET# of FDENTRY)
		      (ffetch FONTSET# of (ffetch PRCURRFDE of PRDATA)))
                                                             (* Swtich font sets)
                                                             (* must save and restore current logical font since 
							     \ENTITYSTART.PRESS makes it NIL)
		(SETQ LFONT (ffetch PRLOGICALFONT of PRDATA))
		(\ENTITYEND.PRESS PRSTREAM)
		(\ENTITYSTART.PRESS PRSTREAM)
		(\DSPFONT.PRESS PRSTREAM LFONT)))
	    (freplace PRCURRFDE of PRDATA with FDENTRY)
	    (freplace PRFONT of PRDATA with PRFONT)
	    (\BOUT (ffetch ELSTREAM of PRDATA)
		     (LOGOR FontCode (ffetch FONT# of FDENTRY))))))
)
(DEFINEQ

(\CREATEPRESSFONT
  [LAMBDA (FAMILY PSIZE FACE ROTATION DEVICE)                (* rmk: "20-Mar-86 22:04")

          (* Widths array is fully allocated, with zeroes for characters with no information. An array is not allocated for 
	  fixed WidthsY. DEVICE is PRESS or INTERPRESS)


    (DECLARE (GLOBALVARS PRESSFONTWIDTHSFILES))
    (RESETLST                                              (* RESETLST to make sure the fontfiles get closed)
		(PROG [WSTRM STRMCACHE FIXEDFLAGS RELFLAG FIRSTCHAR LASTCHAR TEM WIDTHSY
			       (WIDTHS (ARRAY (ADD1 \MAXCHAR)
						(QUOTE SMALLPOSP)
						0 0))
			       (PRESSMICASIZE (IQUOTIENT (ITIMES PSIZE 2540)
							   72))
			       (NSMICASIZE (FIXR (FQUOTIENT (ITIMES PSIZE 2540)
								72)))
			       (FD (create FONTDESCRIPTOR
					     FONTDEVICE ← DEVICE
					     FONTFAMILY ← FAMILY
					     FONTSIZE ← PSIZE
					     FONTFACE ← FACE
					     \SFFACECODE ←(\FACECODE FACE)
					     ROTATION ← ROTATION
					     FONTSCALE ←(CONSTANT (FQUOTIENT 2540 72]

          (* The PRESS world and the NS world disagree on whether to truncate or round when converting from points to micas.
	  Hence the different values PRESSMICASIZE and NSMICASIZE.)


		        (OR [for F XLATEDNAME inside PRESSFONTWIDTHSFILES when (INFILEP
											 F)
				 first (SETQ XLATEDNAME (\COERCEFONT FAMILY PSIZE FACE ROTATION
									   (QUOTE PRESS)
									   FONTCOERCIONS))
					 (if XLATEDNAME
					     then (replace FONTFAMILY of FD
						       with (CAR XLATEDNAME)))
				 do                        (* Look thru the candidate PRESSFONTWIDTHSFILES for a 
							     file that has a description for this font.)
				      [COND
					[(SETQ WSTRM (\GETSTREAM F (QUOTE INPUT)
								     T))
					  (COND
					    ((RANDACCESSP WSTRM)
					      (RESETSAVE NIL (LIST (QUOTE SETFILEPTR)
								       WSTRM
								       (GETFILEPTR WSTRM)))
					      (SETFILEPTR WSTRM 0]
					(T (RESETSAVE (SETQ WSTRM (OPENSTREAM F (QUOTE INPUT)
										    (QUOTE OLD)
										    8))
							(QUOTE (PROGN (CLOSEF? OLDVALUE]
				      [OR (RANDACCESSP WSTRM)
					    (COPYBYTES WSTRM (SETQ WSTRM (OPENSTREAM
							     (QUOTE {NODIRCORE})
							     (QUOTE BOTH)
							     (QUOTE NEW]
				      (push STRMCACHE WSTRM) 
                                                             (* Save for coercions below)
				      (COND
					((SETQ RELFLAG (\FINDFONT FD WSTRM PRESSMICASIZE 
								      NSMICASIZE))
                                                             (* OK, we found this font described in this file.)
					  (if XLATEDNAME
					      then (replace FONTDEVICESPEC of FD with 
										       XLATEDNAME)
						     (replace FONTFAMILY of FD with FAMILY))
					  (RETURN T]
			      [bind XLATEDNAME first (SETQ STRMCACHE (DREVERSE STRMCACHE))
				 while (SETQ XLATEDNAME (\COERCEFONT FAMILY PSIZE FACE ROTATION
									   (QUOTE PRESS)
									   MISSINGFONTCOERCIONS 
									   XLATEDNAME))
				 thereis (for old WSTRM in STRMCACHE
					      first (replace FONTFAMILY of FD
							 with (CAR XLATEDNAME))
					      do 

          (* We know the file was left open and is randaccessp from the previous loop, which must have run off the end of the
	  file list)


						   (SETFILEPTR WSTRM 0)
						   (COND
						     ((SETQ RELFLAG (\FINDFONT FD WSTRM 
										   PRESSMICASIZE 
										   NSMICASIZE))
						       (replace FONTDEVICESPEC of FD
							  with XLATEDNAME)
						       (replace FONTFAMILY of FD with FAMILY)
						       (RETURN T]
			      (RETURN NIL))
		        (SETQ RELFLAG (ZEROP RELFLAG))   (* Actually, \FINDFONT returns zero if the font 
							     metrics are size-relative and must be scaled.)
		        (SETFILEPTR WSTRM (UNFOLD (\FIXPIN WSTRM)
						    BYTESPERWORD))
                                                             (* Locate the segment)
		        (replace (FONTDESCRIPTOR FBBOX) of FD with (SIGNED (\WIN WSTRM)
										 BITSPERWORD))
		        (replace \SFDescent of FD with (IMINUS (SIGNED (\WIN WSTRM)
									       BITSPERWORD)))
                                                             (* Descent is -FBBOY)
		        (replace (FONTDESCRIPTOR FBBDX) of FD with (SIGNED (\WIN WSTRM)
										 BITSPERWORD))
		        (replace \SFHeight of FD with (SIGNED (\WIN WSTRM)
								    BITSPERWORD))
                                                             (* Height is FBBDY)
		        (replace \SFWidths of FD with WIDTHS)
		        (SETQ FIRSTCHAR (fetch FIRSTCHAR of FD))
		        (SETQ LASTCHAR (fetch LASTCHAR of FD))
		        [COND
			  (RELFLAG                           (* Dimensions are relative, must be scaled)
				   (replace (FONTDESCRIPTOR FBBOX) of FD
				      with (IQUOTIENT (ITIMES (fetch (FONTDESCRIPTOR FBBOX)
								       of FD)
								    PRESSMICASIZE)
							  1000))
				   (replace \SFDescent of FD
				      with (IQUOTIENT (ITIMES (fetch \SFDescent of FD)
								    PRESSMICASIZE)
							  1000))
				   (replace (FONTDESCRIPTOR FBBDX) of FD
				      with (IQUOTIENT (ITIMES (fetch (FONTDESCRIPTOR FBBDX)
								       of FD)
								    PRESSMICASIZE)
							  1000))
				   (replace \SFHeight of FD
				      with (IQUOTIENT (ITIMES (fetch \SFHeight of FD)
								    PRESSMICASIZE)
							  1000]
		        (replace \SFAscent of FD with (IDIFFERENCE (fetch \SFHeight
									      of FD)
									   (fetch \SFDescent
									      of FD)))
		        (SETQ FIXEDFLAGS (LRSH (\BIN WSTRM)
						   6))       (* The fixed flags)
		        (\BIN WSTRM)                       (* Skip the spares)
		        [COND
			  ((EQ 2 (LOGAND FIXEDFLAGS 2))
			    (SETQ TEM (\WIN WSTRM))        (* The fixed width for this font)
			    [COND
			      ((AND RELFLAG (NOT (ZEROP TEM)))
				(SETQ TEM (IQUOTIENT (ITIMES TEM PRESSMICASIZE)
							 1000]
			    (for I from FIRSTCHAR to LASTCHAR do (SETA WIDTHS I TEM)))
			  (T (AIN WIDTHS FIRSTCHAR (ADD1 (IDIFFERENCE LASTCHAR FIRSTCHAR))
				    WSTRM)
			     (for I from FIRSTCHAR to LASTCHAR when (EQ noInfoCode
										  (ELT WIDTHS I))
				do (SETA WIDTHS I 0))
			     (COND
			       (RELFLAG (for I from FIRSTCHAR to LASTCHAR
					   do (SETA WIDTHS I (IQUOTIENT (ITIMES (ELT WIDTHS 
											       I)
											PRESSMICASIZE)
									      1000]
		        [COND
			  [(EQ 1 (LOGAND FIXEDFLAGS 1))
			    (SETQ WIDTHSY (\WIN WSTRM))    (* The fixed width-Y for this font;
							     the width-Y field is a single integer in the FD)
			    (replace \SFWidthsY of FD with (COND
								   ((AND RELFLAG
									   (NOT (ZEROP WIDTHSY)))
								     (IQUOTIENT (ITIMES WIDTHSY 
										    PRESSMICASIZE)
										  1000))
								   (T WIDTHSY]
			  (T (replace \SFWidthsY of FD with (SETQ WIDTHSY
								    (ARRAY (ADD1 \MAXCHAR)
									     (QUOTE SMALLPOSP)
									     0 0)))
			     (AIN WIDTHSY FIRSTCHAR (ADD1 (IDIFFERENCE LASTCHAR FIRSTCHAR))
				    WSTRM)
			     (for I from FIRSTCHAR to LASTCHAR when (EQ noInfoCode
										  (ELT WIDTHSY I))
				do (SETA WIDTHSY I 0))
			     (COND
			       (RELFLAG (for I from FIRSTCHAR to LASTCHAR
					   do (SETA WIDTHSY I (IQUOTIENT (ITIMES
										 (ELT WIDTHSY I)
										 PRESSMICASIZE)
									       1000]
		        (freplace OTHERDEVICEFONTPROPS of FD with (LIST (ffetch \SFAscent
										   of FD)
										(ffetch \SFDescent
										   of FD)))

          (* This holds the Ascent and Descent for the font as it appears on the printer, independent of any translation.
	  This corresponds to what appears in the \SFWidths)


		        (RETURN FD])

(\CREATECHARSET.PRESS
  (LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET FONTDESC)
                                                             (* thh: " 5-Mar-86 10:18")

          (* * determines widths and translations to print the charset with Press fonts. Note that we get widths from 
	  \SFWidths, which represent the true Press widths for this devicefont, independent of any translations.
	  We are careful not to change the \SFWidths array, so that other fonts that translate through here get the true 
	  base-font information.)



          (* * NOTE: This code makes fonts that translate to themselves circular, and also gives fonts high reference counts)


    (LET ((CSETTRANSLATIONARRAY (\NSTOASCIIARRAY CHARSET))
	  (widths (ARRAY 256 (QUOTE SMALLPOSP)
			   0 0))
	  (translationArray (ARRAY 256 NIL NIL 0))
	  (ascent 0)
	  (descent 0)
	  CSETZEROTRANSLATIONS)
         (COND
	   ((EQ 0 CHARSET)
	     (COND
	       ((SETQ CSETZEROTRANSLATIONS (ASSOC (FONTPROP FONTDESC (QUOTE FAMILY))
						      PRESSFONTFAMILIES))
                                                             (* Press font)
                                                             (* use identity transformation)
		 (for i from 0 to 255 do (SETA translationArray i (CONS FONTDESC i)))
                                                             (* except for font-specific non-identities)
		 (for X in (CDR CSETZEROTRANSLATIONS) do (SETA translationArray
									 (CAR X)
									 (\NSTOASCIITRANSLATION
									   (CADR X)
									   FAMILY FONTDESC))))
	       (T                                            (* Not a press font: assume NS font)
		  (for i from 0 to 255
		     do (SETA translationArray i
				  (\NSTOASCIITRANSLATION
				    (COND
				      ((AND CSETTRANSLATIONARRAY (ELT CSETTRANSLATIONARRAY i)))
				      (T (LIST (OR FAMILY (FONTPROP FONTDESC (QUOTE FAMILY)))
						 i)))
				    FAMILY FONTDESC))))))
	   (T                                                (* CHARSET not zero, assume NS codes)
	      (for i from 0 to 255 do (SETA translationArray i
						      (\NSTOASCIITRANSLATION (AND 
									     CSETTRANSLATIONARRAY
										      (ELT 
									     CSETTRANSLATIONARRAY i))
									       FAMILY FONTDESC)))))
                                                             (* Now set the widths array)
         (for i from 0 to 255 bind translation pressFont
	    do (SETQ translation (ELT translationArray i))
		 (SETQ pressFont (CAR translation))
		 (SETA widths i (ELT (ffetch \SFWidths of pressFont)
					 (CDR translation)))
		 (SETQ ascent (MAX ascent (CAR (ffetch OTHERDEVICEFONTPROPS of pressFont))))
		 (SETQ descent (MAX descent (CADR (ffetch OTHERDEVICEFONTPROPS of pressFont)
							))))
         (create CHARSETINFO
		   WIDTHS ←(ffetch (ARRAYP BASE) of widths)
		   OFFSETS ← NIL
		   IMAGEWIDTHS ←(ffetch (ARRAYP BASE) of widths)
		   CHARSETBITMAP ←(ffetch (ARRAYP BASE) of translationArray)
		   YWIDTHS ← 0
		   CHARSETASCENT ← ascent
		   CHARSETDESCENT ← descent))))
)



(* Generic utility for coercing fonts, could be used by other devices)

(DEFINEQ

(\COERCEFONT
  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE COERCELIST BUTNOT CREATEFLG)
                                                             (* rmk: "21-Mar-86 08:58")

          (* Returns a font name that the requested font specification coerces to according to COERCELIST.
	  If CREATEFLG is T, only returns name-lists for which a font descriptor has been created. BUTNOT can be a font-spec 
	  which is not an acceptable coercion--e.g. a previous one that failed, so we want to keep looking beyond that one.)



          (* * NOSLUG? means don't create an empty (slug) csinfo if the charset is not found, just return NIL 
	  (probably only useful for display fonts))



          (* COERCELIST is an alist of font coercions indexed by device, with the value for each device being a list of the 
	  form ((user-font real-font) (user-font real-font) ...) -
	  Each user-font is either simply a family name, or a list of FAMILY, and optionally SIZE, and FACE, in standard 
	  font-name order. Any of these can be NIL, meaning that any requested value matches. In addition, the SIZE can be 
	  either a specific number, or a constraint of the form (< n) or (> n), which matches requested sizes that are less 
	  than or greater than the constraint size n. -
	  The real-font is a similar family-name or list, except that a NIL field here means that the requested parameter is 
	  simply carried over. Also, no size constraints, only explicit sizes, are allowed. (e.g., (GACHA) or 
	  (GACHA (< 10)) or (GACHA 10)))


    (for TRANSL in (CDR (ASSOC DEVICE COERCELIST)) bind NEWCSINFO USERSPEC REALSPEC 
								  FAMCONSTRAINT SIZECONSTRAINT 
								  FACECONSTRAINT NEWFONTNAME
       when (AND (SETQ USERSPEC (CAR TRANSL))
		     (OR [NULL (SETQ FAMCONSTRAINT (if (LISTP USERSPEC)
							     then (pop USERSPEC)
							   else (PROG1 USERSPEC (SETQ USERSPEC 
									     NIL]
			   (EQ FAMILY FAMCONSTRAINT))
		     (OR (NOT (SETQ SIZECONSTRAINT (pop USERSPEC)))
			   (EQ SIZE SIZECONSTRAINT)
			   (AND (LISTP SIZECONSTRAINT)
				  (SELECTQ (CAR SIZECONSTRAINT)
					     (< (LESSP SIZE (CADR SIZECONSTRAINT)))
					     (> (GREATERP SIZE (CADR SIZECONSTRAINT)))
					     NIL)))
		     (OR (NOT (SETQ FACECONSTRAINT (pop USERSPEC)))
			   (EQUAL FACE FACECONSTRAINT))
		     (SETQ REALSPEC (CADR TRANSL))
		     (SETQ NEWFONTNAME (LIST (OR (if (LISTP REALSPEC)
							   then (pop REALSPEC)
							 else (PROG1 REALSPEC (SETQ REALSPEC 
									   NIL)))
						       FAMILY)
						 (OR (pop REALSPEC)
						       SIZE)
						 (OR (pop REALSPEC)
						       FACE)
						 ROTATION DEVICE))
		     (NOT (EQUAL BUTNOT NEWFONTNAME))
		     (OR (NULL CREATEFLG)
			   (FONTCREATE NEWFONTNAME NIL NIL NIL NIL T)))
       do (RETURN NEWFONTNAME])
)

(ADDTOVAR FONTCOERCIONS (PRESS ((SYMBOL (< 10))
				  (SYMBOL 10))
				 ((SYMBOL (> 12))
				  (SYMBOL 12))))

(ADDTOVAR MISSINGFONTCOERCIONS (PRESS (MODERN HELVETICA)
					(CLASSIC TIMESROMAN)
					(LOGOTYPE LOGO)
					(TERMINAL GACHA)
					(MODERN FRUTIGER)
					(CLASSIC CENTURY)))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS FONTCOERCIONS MISSINGFONTCOERCIONS)
)
(DEFINEQ

(\STRINGWIDTH.PRESS
  [LAMBDA (STREAM STRING RDTBL)                              (* rmk: "24-Feb-86 09:49")
                                                             (* Returns the width of STRING in the press STREAM, 
							     observing spacefactor)
    (\STRINGWIDTH.GENERIC STRING (ffetch PRLOGICALFONT of (ffetch IMAGEDATA of STREAM))
			    RDTBL
			    (ffetch PRSPACEWIDTH of (ffetch IMAGEDATA of STREAM])

(\CHARWIDTH.PRESS
  [LAMBDA (STREAM CHARCODE)                                  (* rmk: "24-Feb-86 09:49")
                                                             (* Gets the width of CHARCODE in a Press STREAM, 
							     observing spacefactor)
    (COND
      ((EQ CHARCODE (CHARCODE SPACE))
	(ffetch PRSPACEWIDTH of (ffetch IMAGEDATA of STREAM)))
      (T (\FGETCHARWIDTH (ffetch PRLOGICALFONT of (ffetch IMAGEDATA of STREAM))
			 CHARCODE])

(\OUTCHARFN.PRESS
  [LAMBDA (PRSTREAM CHARCODE)                                (* rmk: "24-Feb-86 12:18")
                                                             (* Handle all the special-purpose characters going to 
							     a PRESS file)
    (SELCHARQ CHARCODE
	      (EOL                                           (* New Line)
		   (NEWLINE.PRESS PRSTREAM)
		   (replace (STREAM CHARPOSITION) of PRSTREAM with 0))
	      [LF                                            (* Line feed--move down, but not over)
		  (\DSPXPOSITION.PRESS PRSTREAM (PROG1 (DSPXPOSITION NIL PRSTREAM)
							   (NEWLINE.PRESS PRSTREAM]
	      (↑L                                            (* Form Feed)
		  (replace (STREAM CHARPOSITION) of PRSTREAM with 0)
		  (NEWPAGE.PRESS PRSTREAM))
	      (PROG (XPOS NEWXPOS CLIPPINGREGION PRCHARCODE TRANSLATION (CHARSET (\CHARSET 
											 CHARCODE))
			    (PRDATA (fetch IMAGEDATA of PRSTREAM)))
		      [if (NEQ CHARSET (ffetch PRLOGICALCHARSET of PRDATA))
			  then (LET [(CSINFO (\GETCHARSETINFO CHARSET (ffetch PRLOGICALFONT
									   of PRDATA]
				      (UNINTERRUPTABLY
                                          (freplace PRWIDTHSCACHE of PRDATA
					     with (fetch (CHARSETINFO WIDTHS) of CSINFO))
					  (freplace PRTRANSLATIONCACHE of PRDATA
					     with (fetch (CHARSETINFO CHARSETBITMAP)
						       of CSINFO))
					  (freplace PRLOGICALCHARSET of PRDATA with CHARSET))]
		      (SETQ TRANSLATION (\GETBASEPTR (ffetch PRTRANSLATIONCACHE of PRDATA)
							 (UNFOLD (\CHAR8CODE CHARCODE)
								 2)))
		      (if (NEQ (CAR TRANSLATION)
				   (fetch PRFONT of PRDATA))
			  then (\DSPFONT.PRESSFONT PRSTREAM (CAR TRANSLATION)))
		      (SETQ PRCHARCODE (CDR TRANSLATION))
		      (SETQ XPOS (fetch PRXPOS of PRDATA))
		      [SETQ NEWXPOS (IPLUS XPOS (COND
						 ((EQ CHARCODE (CHARCODE SPACE))
						   (ffetch PRSPACEWIDTH of PRDATA))
						 (T (\FGETWIDTH (ffetch (PRESSDATA PRWIDTHSCACHE)
								   of PRDATA)
								(\CHAR8CODE CHARCODE]
		      (COND
			((AND [IGEQ XPOS (fetch LEFT of (SETQ CLIPPINGREGION
								  (fetch PRClippingRegion
								     of PRDATA]
				(ILEQ NEWXPOS (fetch RIGHT of CLIPPINGREGION))
				(IGEQ (fetch PRYPOS of PRDATA)
					(fetch BOTTOM of CLIPPINGREGION)))
                                                             (* Bottom test should really subtract off the descent,
							     and also should do a top-test)
                                                             (* The Y-tests can probably be done inside SETXY, 
							     SETY, and DSPFONT.)
			  [COND
			    ((NOT (ffetch CHARWASDISPLAYING of PRDATA))
                                                             (* Was being clipped, now not)
			      (freplace CHARWASDISPLAYING of PRDATA with T)
			      (SHOW.PRESS PRSTREAM)        (* SHOW shouldn't be necessary, but ...)
			      (SETXY.PRESS PRSTREAM XPOS (fetch PRYPOS of PRDATA]
			  (\BOUT PRSTREAM PRCHARCODE))
			(T (SHOW.PRESS PRSTREAM)           (* Don't put out any characters if out of the clipping
							     region)
			   (freplace CHARWASDISPLAYING of PRDATA with NIL)))
		      (replace PRXPOS of PRDATA with NEWXPOS])
)
(* * new declaration for PRESSDATA)

(DECLARE: DONTCOPY 
[DECLARE: EVAL@COMPILE 

(DATATYPE PRESSDATA (PRHEADING                             (* The string to be printed atop each page.)
				 PRHEADINGFONT               (* Font to print the heading in)
				 PRXPOS                      (* Current X position)
				 PRYPOS                      (* Current Y position)
				 PRFONT                      (* Current font)
				 PRCURRFDE PRESSFONTDIR (PRWIDTHSCACHE POINTER 
                                                             (* Widths table for the current logical character set)
								       )
				 PRCOLOR PRLINEFEED PRPAGESTATE PDSTREAM ELSTREAM XPRPAGEREGION 
				 PRDOCNAME (PRLEFT WORD)     (* Page left margin)
				 (PRBOTTOM WORD)             (* Page bottom margin)
				 (PRRIGHT WORD)              (* Page right margin)
				 (PRTOP WORD)                (* Page top margin)
				 (PRPAGENUM WORD)            (* Current Page number)
				 (PRNEXTFONT# BYTE)
				 (PRMAXFONTSET BYTE)
				 (PRPARTSTART INTEGER)
				 (DLSTARTBYTE INTEGER)
				 (ELSTARTBYTE INTEGER)
				 (STARTCHARBYTE INTEGER)
				 (VECMOVINGRIGHT FLAG)       (* If we're drawing a curve with vector fonts, are we 
							     moving to the right?)
				 (VECWASDISPLAYING FLAG)     (* Used during curve/line clipping to remember whether
							     we were on-screen or not, so we know when to force a 
							     SETXY.)
				 VECSEGCHARS                 (* Cache for vector characters while we're moving to 
							     the left.)
				 VECCURX                     (* Current X position within vector code, in Dover 
							     spots)
				 VECCURY                     (* Current Y position with vector code, in Dover 
							     spots)
				 PRSPACEFACTOR PRSPACEWIDTH (CHARWASDISPLAYING FLAG)
                                                             (* Says whether we have been printing characters 
							     inside the clipping region)
				 PRClippingRegion

          (* The edges of the paper, as far as PRESS is concerned. Used to protect SPRUCE users who get killed when the image
	  goes off-paper)


				 PRLOGICALFONT               (* Current logical font)
				 PRLOGICALCHARSET            (* Current logical character set, whose info is 
							     cached. NIL if cache is invalid)
				 (PRTRANSLATIONCACHE POINTER 
                                                             (* Translation table for the current logical character
							     set)))
		      PRSPACEFACTOR ← 1 PRXPOS ← 0 PRYPOS ← 0 
                                                             (* We assume that the origin is translated to the 
							     bottom-left of the page region)
		      PRClippingRegion ←(create REGION
						  LEFT ← SPRUCEPAPERLEFTMICAS
						  BOTTOM ← SPRUCEPAPERBOTTOMMICAS
						  WIDTH ←(DIFFERENCE SPRUCEPAPERRIGHTMICAS 
								       SPRUCEPAPERLEFTMICAS)
						  HEIGHT ← 29210)
		      [ACCESSFNS ((PRWIDTH (IDIFFERENCE (fetch (PRESSDATA PRRIGHT)
							       of DATUM)
							    (fetch (PRESSDATA PRLEFT) of DATUM)))
				    (PRHEIGHT (IDIFFERENCE (fetch (PRESSDATA PRTOP) of DATUM)
							     (fetch (PRESSDATA PRBOTTOM)
								of DATUM)))
				    (PRPAGEREGION (fetch (PRESSDATA XPRPAGEREGION) of DATUM)
						  (PROGN (replace (PRESSDATA XPRPAGEREGION)
							      of DATUM with NEWVALUE)
							   (replace (PRESSDATA PRLEFT)
							      of DATUM with (fetch
										  (REGION LEFT)
										   of NEWVALUE))
							   (replace (PRESSDATA PRBOTTOM)
							      of DATUM with (fetch
										  (REGION BOTTOM)
										   of NEWVALUE))
							   (replace (PRESSDATA PRRIGHT)
							      of DATUM
							      with (IPLUS (fetch (REGION LEFT)
										 of NEWVALUE)
									      (fetch (REGION WIDTH)
										 of NEWVALUE)))
							   (replace (PRESSDATA PRTOP) of DATUM
							      with (IPLUS (fetch (REGION BOTTOM)
										 of NEWVALUE)
									      (fetch (REGION HEIGHT)
										 of NEWVALUE])
]
(/DECLAREDATATYPE (QUOTE PRESSDATA)
		  (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
				  POINTER POINTER POINTER POINTER POINTER POINTER WORD WORD WORD WORD 
				  WORD BYTE BYTE FIXP FIXP FIXP FIXP FLAG FLAG POINTER POINTER 
				  POINTER POINTER POINTER FLAG POINTER POINTER POINTER POINTER))
		  (QUOTE ((PRESSDATA 0 POINTER)
			  (PRESSDATA 2 POINTER)
			  (PRESSDATA 4 POINTER)
			  (PRESSDATA 6 POINTER)
			  (PRESSDATA 8 POINTER)
			  (PRESSDATA 10 POINTER)
			  (PRESSDATA 12 POINTER)
			  (PRESSDATA 14 POINTER)
			  (PRESSDATA 16 POINTER)
			  (PRESSDATA 18 POINTER)
			  (PRESSDATA 20 POINTER)
			  (PRESSDATA 22 POINTER)
			  (PRESSDATA 24 POINTER)
			  (PRESSDATA 26 POINTER)
			  (PRESSDATA 28 POINTER)
			  (PRESSDATA 30 (BITS . 15))
			  (PRESSDATA 31 (BITS . 15))
			  (PRESSDATA 32 (BITS . 15))
			  (PRESSDATA 33 (BITS . 15))
			  (PRESSDATA 34 (BITS . 15))
			  (PRESSDATA 28 (BITS . 7))
			  (PRESSDATA 26 (BITS . 7))
			  (PRESSDATA 35 FIXP)
			  (PRESSDATA 37 FIXP)
			  (PRESSDATA 39 FIXP)
			  (PRESSDATA 41 FIXP)
			  (PRESSDATA 24 (FLAGBITS . 0))
			  (PRESSDATA 24 (FLAGBITS . 16))
			  (PRESSDATA 44 POINTER)
			  (PRESSDATA 46 POINTER)
			  (PRESSDATA 48 POINTER)
			  (PRESSDATA 50 POINTER)
			  (PRESSDATA 52 POINTER)
			  (PRESSDATA 52 (FLAGBITS . 0))
			  (PRESSDATA 54 POINTER)
			  (PRESSDATA 56 POINTER)
			  (PRESSDATA 58 POINTER)
			  (PRESSDATA 60 POINTER)))
		  (QUOTE 62))
)
(/DECLAREDATATYPE (QUOTE PRESSDATA)
		  (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
				  POINTER POINTER POINTER POINTER POINTER POINTER WORD WORD WORD WORD 
				  WORD BYTE BYTE FIXP FIXP FIXP FIXP FLAG FLAG POINTER POINTER 
				  POINTER POINTER POINTER FLAG POINTER POINTER POINTER POINTER))
		  (QUOTE ((PRESSDATA 0 POINTER)
			  (PRESSDATA 2 POINTER)
			  (PRESSDATA 4 POINTER)
			  (PRESSDATA 6 POINTER)
			  (PRESSDATA 8 POINTER)
			  (PRESSDATA 10 POINTER)
			  (PRESSDATA 12 POINTER)
			  (PRESSDATA 14 POINTER)
			  (PRESSDATA 16 POINTER)
			  (PRESSDATA 18 POINTER)
			  (PRESSDATA 20 POINTER)
			  (PRESSDATA 22 POINTER)
			  (PRESSDATA 24 POINTER)
			  (PRESSDATA 26 POINTER)
			  (PRESSDATA 28 POINTER)
			  (PRESSDATA 30 (BITS . 15))
			  (PRESSDATA 31 (BITS . 15))
			  (PRESSDATA 32 (BITS . 15))
			  (PRESSDATA 33 (BITS . 15))
			  (PRESSDATA 34 (BITS . 15))
			  (PRESSDATA 28 (BITS . 7))
			  (PRESSDATA 26 (BITS . 7))
			  (PRESSDATA 35 FIXP)
			  (PRESSDATA 37 FIXP)
			  (PRESSDATA 39 FIXP)
			  (PRESSDATA 41 FIXP)
			  (PRESSDATA 24 (FLAGBITS . 0))
			  (PRESSDATA 24 (FLAGBITS . 16))
			  (PRESSDATA 44 POINTER)
			  (PRESSDATA 46 POINTER)
			  (PRESSDATA 48 POINTER)
			  (PRESSDATA 50 POINTER)
			  (PRESSDATA 52 POINTER)
			  (PRESSDATA 52 (FLAGBITS . 0))
			  (PRESSDATA 54 POINTER)
			  (PRESSDATA 56 POINTER)
			  (PRESSDATA 58 POINTER)
			  (PRESSDATA 60 POINTER)))
		  (QUOTE 62))
(* * NSTOASCIITRANSLATIONS is a list with elements of the form (charset translationArrayName) 
, where translationArrayName is bound to a translation array for charset which contains (
fontFamily charcode) lists)

(DEFINEQ

(\NSTOASCIIARRAY
  [LAMBDA (CHARSET)                                        (* thh: "17-Feb-86 09:05")
                                                             (* gets the translation array to use for this charset)
    (EVAL (CADR (ASSOC CHARSET NSTOASCIITRANSLATIONS])

(\NSTOASCIITRANSLATION
  (LAMBDA (TRANSLATION FAMILY FONTDESC)                      (* thh: " 5-Mar-86 10:23")
                                                             (* returns (fontdesc . charcode) to use in place of 
							     the specified 8-bit charcode)
                                                             (* FAMILY, if specified, is font family to use when 
							     not specified by the translation array)

          (* * determine the (family charcode) translation)


    (OR TRANSLATION (SETQ TRANSLATION unknownCharTranslation))
    (COND
      ((FIXP TRANSLATION)
	(SETQ TRANSLATION (LIST (OR FAMILY FONTDESC)
				    TRANSLATION))))

          (* * coerce to a full font descriptor)


    (CONS (\PRESS.COERCEFONT FONTDESC (CAR TRANSLATION))
	    (CADR TRANSLATION))))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS NSTOASCIITRANSLATIONS)
)

(RPAQ? PRESSFONTFAMILIES (QUOTE ((GACHA)
				   (TIMESROMAN)
				   (HELVETICA)
				   (SYMBOL)
				   (MATH)
				   (HIPPO)
				   (CYRILLIC))))

(RPAQ? NSTOASCIITRANSLATIONS )

(ADDTOVAR NSTOASCIITRANSLATIONS (0 ASCIIFROM0ARRAY)
				  (38 ASCIIFROM38ARRAY)
				  (39 ASCIIFROM39ARRAY)
				  (239 ASCIIFROM239ARRAY))
(READVARS ASCIIFROM0ARRAY ASCIIFROM38ARRAY ASCIIFROM39ARRAY ASCIIFROM239ARRAY)
({Y256 POINTER 0 {R163 NIL}  (SYMBOL 126)  (SYMBOL 127) NIL NIL  (SYMBOL 120) NIL 96 NIL NIL  (SYMBOL 
55)  (SYMBOL 34)  (SYMBOL 33)  (SYMBOL 35) NIL  (SYMBOL 6) NIL NIL  (SYMBOL 2) NIL  (SYMBOL 123) NIL  
(SYMBOL 13) 39 {R25 NIL}  (SYMBOL 125) {R44 NIL} }  {Y256 POINTER 0  (HIPPO 118) {R64 NIL}  (HIPPO 65)
  (HIPPO 66) NIL  (HIPPO 71)  (HIPPO 68)  (HIPPO 69) NIL NIL  (HIPPO 90)  (HIPPO 72)  (HIPPO 81)  (
HIPPO 73)  (HIPPO 75)  (HIPPO 76)  (HIPPO 77)  (HIPPO 78)  (HIPPO 67)  (HIPPO 79)  (HIPPO 80) NIL  (
HIPPO 82)  (HIPPO 83) NIL  (HIPPO 84)  (HIPPO 85)  (HIPPO 70)  (HIPPO 88)  (HIPPO 89)  (HIPPO 87) NIL 
NIL NIL  (HIPPO 97)  (HIPPO 98) NIL  (HIPPO 103)  (HIPPO 100)  (HIPPO 101) NIL NIL  (HIPPO 122)  (
HIPPO 104)  (HIPPO 113)  (HIPPO 105)  (HIPPO 107)  (HIPPO 108)  (HIPPO 109)  (HIPPO 110)  (HIPPO 99)  
(HIPPO 111)  (HIPPO 112) NIL  (HIPPO 114)  (HIPPO 115)  (HIPPO 106)  (HIPPO 116)  (HIPPO 117)  (HIPPO 
102)  (HIPPO 120)  (HIPPO 121)  (HIPPO 119) {R130 NIL} }  {Y256 POINTER 0  (CYRILLIC 127) {R32 NIL}  (
CYRILLIC 65)  (CYRILLIC 66)  (CYRILLIC 86)  (CYRILLIC 71)  (CYRILLIC 68)  (CYRILLIC 69)  (CYRILLIC 36)
  (CYRILLIC 87)  (CYRILLIC 90)  (CYRILLIC 73)  (CYRILLIC 74)  (CYRILLIC 75)  (CYRILLIC 76)  (CYRILLIC 
77)  (CYRILLIC 78)  (CYRILLIC 79)  (CYRILLIC 80)  (CYRILLIC 82)  (CYRILLIC 83)  (CYRILLIC 84)  (
CYRILLIC 85)  (CYRILLIC 70)  (CYRILLIC 81)  (CYRILLIC 126)  (CYRILLIC 42)  (CYRILLIC 123)  (CYRILLIC 
125)  (CYRILLIC 94)  (CYRILLIC 88)  (CYRILLIC 67)  (CYRILLIC 64)  (CYRILLIC 89)  (CYRILLIC 72) {R15 
NIL}  (CYRILLIC 97)  (CYRILLIC 98)  (CYRILLIC 118)  (CYRILLIC 103)  (CYRILLIC 100)  (CYRILLIC 101)  (
CYRILLIC 52)  (CYRILLIC 119)  (CYRILLIC 122)  (CYRILLIC 105)  (CYRILLIC 106)  (CYRILLIC 107)  (
CYRILLIC 108)  (CYRILLIC 109)  (CYRILLIC 110)  (CYRILLIC 111)  (CYRILLIC 112)  (CYRILLIC 114)  (
CYRILLIC 115)  (CYRILLIC 116)  (CYRILLIC 117)  (CYRILLIC 102)  (CYRILLIC 113)  (CYRILLIC 54)  (
CYRILLIC 56)  (CYRILLIC 91)  (CYRILLIC 93)  (CYRILLIC 95)  (CYRILLIC 120)  (CYRILLIC 143)  (CYRILLIC 
50)  (CYRILLIC 121)  (CYRILLIC 104) {R12 NIL}  (CYRILLIC 99) {R129 NIL} }  {Y256 POINTER 0 {R36 NIL}  
(TIMESROMAN 155)  (TIMESROMAN 156) {R6 NIL}  (TIMESROMAN 152)  (TIMESROMAN 153) NIL  (TIMESROMAN 159) 
 (MATH 33)  (MATH 70)  (SYMBOL 104)  (SYMBOL 105) NIL NIL  (SYMBOL 96)  (SYMBOL 97)  (MATH 113) NIL  (
SYMBOL 109)  (SYMBOL 108)  (MATH 116)  (MATH 118)  (MATH 115)  (MATH 117)  (MATH 64) NIL  (SYMBOL 37) 
 (SYMBOL 38) {R4 NIL}  (MATH 109) NIL  (MATH 66)  (MATH 78)  (MATH 44)  (SYMBOL 40)  (SYMBOL 44)  (
SYMBOL 41)  (MATH 126)  (MATH 81)  (SYMBOL 36)  (MATH 98) NIL NIL  (SYMBOL 92)  (SYMBOL 91)  (SYMBOL 
19)  (SYMBOL 18)  (SYMBOL 27)  (SYMBOL 26) NIL NIL  (MATH 75)  (MATH 72) NIL  (MATH 79)  (SYMBOL 8)  (
SYMBOL 9)  (MATH 54)  (SYMBOL 11)  (TIMESROMAN 183)  (SYMBOL 5)  (MATH 104) NIL  (SYMBOL 58) NIL  (
SYMBOL 54) NIL NIL  (MATH 22)  (SYMBOL 16)  (MATH 80)  (SYMBOL 17)  (SYMBOL 29) NIL  (SYMBOL 115)  (
MATH 7)  (SYMBOL 39) NIL  (SYMBOL 25)  (MATH 19)  (MATH 1)  (SYMBOL 112)  (SYMBOL 7) {R41 NIL}  (
SYMBOL 59) {R6 NIL}  (MATH 82) NIL  (SYMBOL 100)  (SYMBOL 101)  (SYMBOL 98)  (SYMBOL 99)  (SYMBOL 57) 
 (SYMBOL 56)  (SYMBOL 94)  (SYMBOL 95)  (MATH 90)  (MATH 68)  (MATH 100) {R69 NIL} })
(\SMASHPRESSFONTS)
(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 

(RPAQQ unknownCharTranslation (MATH 59))

[CONSTANTS (unknownCharTranslation (QUOTE (MATH 59]
)
)
(PUTPROPS PRESSFROMNS COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (2691 3492 (\SMASHPRESSFONTS 2701 . 3490)) (3493 7518 (GETCHARPRESSTRANSLATION 3503 . 
4643) (PRESS.NSARRAY 4645 . 5710) (PUTCHARPRESSTRANSLATION 5712 . 7516)) (7519 16400 (\DSPFONT.PRESS 
7529 . 8706) (\DSPSPACEFACTOR.PRESS 8708 . 9288) (\ENTITYSTART.PRESS 9290 . 10828) (\SETSPACE.PRESS 
10830 . 11468) (\STARTPAGE.PRESS 11470 . 13452) (\PRESS.COERCEFONT 13454 . 15201) (\DSPFONT.PRESSFONT 
15203 . 16398)) (16401 28469 (\CREATEPRESSFONT 16411 . 25074) (\CREATECHARSET.PRESS 25076 . 28467)) (
28549 31625 (\COERCEFONT 28559 . 31623)) (32005 36605 (\STRINGWIDTH.PRESS 32015 . 32485) (
\CHARWIDTH.PRESS 32487 . 32997) (\OUTCHARFN.PRESS 32999 . 36603)) (43984 45175 (\NSTOASCIIARRAY 43994
 . 44295) (\NSTOASCIITRANSLATION 44297 . 45173)))))
STOP