(FILECREATED "17-NOV-83 10:56:46" {PHYLUM}<LISPCORE>SOURCES>AFONT.;3 22895  

      changes to:  (FNS \READACFONTFILE)

      previous date: "16-NOV-83 19:04:09" {PHYLUM}<LISPCORE>SOURCES>AFONT.;2)


(PRETTYCOMPRINT AFONTCOMS)

(RPAQQ AFONTCOMS ((FNS \ACFONTFILENAME \CREATESTARFONT \READACFONTBOXES \READACFONTFILE 
		       \WDFONTFILENAME \ACCHARWIDTHLIST \GETFBB \ACCHARPOSLIST \ACROTATECHAR 
		       \READFONTWDFILE \WDFINDFONT)
		  [INITVARS (\STARFONTFILEEXTENSION (QUOTE AC))
			    (STARFONTDIRECTORIES (QUOTE ({PHYLUM}<STARFONTS>]
		  (GLOBALVARS STARFONTDIRECTORIES \STARFONTFILEEXTENSION)
		  (DECLARE: DONTCOPY EVAL@COMPILE (FILES (LOADCOMP)
							 FONT))))
(DEFINEQ

(\ACFONTFILENAME
  [LAMBDA (FAMILY SIZE FACE)                                 (* jds "11-NOV-83 11:02")
                                                             (* returns the name of the file that should contain the 
							     character information for a font.)
    (DECLARE (GLOBALVARS \STARFONTFILEEXTENSION))
    (PACKFILENAME (QUOTE NAME)
		  (PACK* (QUOTE SCREEN>LFONTS>)
			 FAMILY SIZE (SELECTQ (fetch WEIGHT of FACE)
					      (BOLD (QUOTE -B))
					      "")
			 (SELECTQ (fetch SLOPE of FACE)
				  (ITALIC (QUOTE -I))
				  "")
			 "-C0")
		  (QUOTE EXTENSION)
		  \STARFONTFILEEXTENSION])

(\CREATESTARFONT
  [LAMBDA (FAMILY PSIZE FACE ROTATION DEVICE)                (* jds "11-NOV-83 16:50")

          (* 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 FONTWIDTHSFILES))
    (RESETLST                                                (* RESETLST to make sure the fontfiles get closed)
	      (PROG (WFILE WOFD FIXEDFLAGS RELFLAG FIRSTCHAR LASTCHAR TEM WIDTHSY
			   (WIDTHS (ARRAY (ADD1 \MAXCHAR)
					  (QUOTE SMALLPOSP)
					  0 0))
			   (MSIZE (FIXR (FQUOTIENT (ITIMES PSIZE 2540)
						   72)))
			   (FD (create FONTDESCRIPTOR
				       FONTDEVICE ← DEVICE
				       FONTFAMILY ← FAMILY
				       FONTSIZE ← PSIZE
				       FONTFACE ← FACE
				       \SFFACECODE ←(\FACECODE FACE)
				       ROTATION ← ROTATION)))
		    (COND
		      ((SETQ WFILE (FINDFILE (\WDFONTFILENAME FAMILY PSIZE FACE)
					     T STARFONTDIRECTORIES))
			[RESETSAVE (SETQ WOFD (OPENSTREAM WFILE (QUOTE INPUT)
							  (QUOTE OLD)))
				   (QUOTE (PROGN (CLOSEF? OLDVALUE]
			(SETFILEPTR WOFD 0)
			(SETQ RELFLAG (\WDFINDFONT FD MSIZE WOFD)))
		      (T (RETURN NIL)))
		    (SETQ RELFLAG (ZEROP RELFLAG))
		    (SETFILEPTR WOFD (LLSH (INTIN WOFD)
					   1))               (* Locate the segment)
		    (replace FBBOX of FD with (SIGNED (\WIN WOFD)
						      BITSPERWORD))
		    (replace \SFDescent of FD with (IMINUS (SIGNED (\WIN WOFD)
								   BITSPERWORD)))
                                                             (* Descent is -FBBOY)
		    (replace FBBDX of FD with (SIGNED (\WIN WOFD)
						      BITSPERWORD))
		    (replace \SFHeight of FD with (SIGNED (\WIN WOFD)
							  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 FBBOX of FD with (IQUOTIENT (ITIMES (fetch FBBOX
									       of FD)
									    MSIZE)
								    1000))
			       (replace \SFDescent of FD with (IQUOTIENT (ITIMES (fetch \SFDescent
										    of FD)
										 MSIZE)
									 1000))
			       (replace FBBDX of FD with (IQUOTIENT (ITIMES (fetch FBBDX
									       of FD)
									    MSIZE)
								    1000))
			       (replace \SFHeight of FD with (IQUOTIENT (ITIMES (fetch \SFHeight
										   of FD)
										MSIZE)
									1000]
		    (replace \SFAscent of FD with (IDIFFERENCE (fetch \SFHeight of FD)
							       (fetch \SFDescent of FD)))
		    (SETQ FIXEDFLAGS (LRSH (\BIN WOFD)
					   6))               (* The fixed flags)
		    (\BIN WOFD)                              (* Skip the spares)
		    [COND
		      ((EQ 2 (LOGAND FIXEDFLAGS 2))
			(SETQ TEM (\WIN WOFD))               (* The fixed width for this font)
			[COND
			  ((AND RELFLAG (NOT (ZEROP TEM)))
			    (SETQ TEM (IQUOTIENT (ITIMES TEM MSIZE)
						 1000]
			(for I from FIRSTCHAR to LASTCHAR do (SETA WIDTHS I TEM)))
		      (T (AIN WIDTHS FIRSTCHAR (ADD1 (IDIFFERENCE LASTCHAR FIRSTCHAR))
			      WOFD)
			 (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)
									    MSIZE)
								    1000]
		    [COND
		      [(EQ 1 (LOGAND FIXEDFLAGS 1))
			(SETQ WIDTHSY (\WIN WOFD))           (* 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 MSIZE)
								      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))
			      WOFD)
			 (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)
									     MSIZE)
								     1000]
		    (RETURN FD])

(\READACFONTBOXES
  [LAMBDA (FILE STARTCHAR ENDCHAR)                           (* jds "10-NOV-83 19:32")
                                                             (* GETACCHARSPECS returns (bbox bboy bbdx bbdy))
                                                             (* if bbdx and bbdy are both zero, then treat it as a 
							     space.)
    (SETFILEPTR FILE 48)
    (for X from STARTCHAR to ENDCHAR bind (BBLIST STARTWORD BBOX BBOY BBDX BBDY)
       collect (for I from 1 to 8 do (\BIN FILE))            (* Skip over the 8 bytes of Wx and Wy)
	       (SETQ BBOX (SIGNED (\WIN FILE)
				  BITSPERWORD))
	       (SETQ BBOY (SIGNED (\WIN FILE)
				  BITSPERWORD))
	       (SETQ BBDX (SIGNED (\WIN FILE)
				  BITSPERWORD))
	       (SETQ BBDY (SIGNED (\WIN FILE)
				  BITSPERWORD))              (* Now collect the 4 bounding box values into a list)
	       (LIST BBOX BBOY BBDX BBDY])

(\READACFONTFILE
  [LAMBDA (FILENAME FAMILY SIZE FACE PAD.LEFT DONT.PAD.RIGHT)
                                                             (* jds "17-NOV-83 10:47")
                                                             (* Read an AC-format font file)
    (PROG (FILE FBBLIST STARTCHAR ENDCHAR CHARWIDTHLIST OFFSETARRAY CHARWIDTHARRAY FONTDESC FBBBITMAP 
		CHARBITMAP STARTWORDLIST BBOXLIST)
          (SETQ FILE (OPENSTREAM FILENAME (QUOTE INPUT)
				 (QUOTE OLD)))
          (SETFILEPTR FILE 28)
          (SETQ STARTCHAR (BIN FILE))                        (* Get the first and last characters in this font)
          (SETQ ENDCHAR (BIN FILE))
          (SETQ BBOXLIST (\READACFONTBOXES FILE STARTCHAR ENDCHAR))
          (SETQ FBBLIST (\GETFBB BBOXLIST))
          (SETQ CHARWIDTHLIST (\ACCHARWIDTHLIST BBOXLIST FBBLIST))
          (COND
	    ((NULL (REMOVE 0 CHARWIDTHLIST))
	      (ERROR (QUOTE No% raster% images.))
	      (RETURN)))
          (SETQ CHARWIDTHARRAY (ARRAY (ADD1 ENDCHAR)
				      (QUOTE (BITS 16))
				      0 0))
          [for X from STARTCHAR to ENDCHAR bind Y do (SETA CHARWIDTHARRAY X
							   (COND
							     ((ZEROP (SETQ Y (pop CHARWIDTHLIST)))
							       0)
							     (T (IPLUS Y (COND
									 (PAD.LEFT 1)
									 (T 0))
								       (COND
									 (DONT.PAD.RIGHT 0)
									 (T 1]
          (SETQ FONTDESC (create FONTDESCRIPTOR
				 FONTFAMILY ← FAMILY
				 FONTFACE ← FACE
				 FONTSIZE ← SIZE
				 FONTDEVICE ←(QUOTE DISPLAY)))
          (replace FIRSTCHAR of FONTDESC with STARTCHAR)
          (replace LASTCHAR of FONTDESC with ENDCHAR)
          (replace \SFWidths of FONTDESC with CHARWIDTHARRAY)
          (replace \SFAscent of FONTDESC with (IPLUS (CADR FBBLIST)
						     (CADDDR FBBLIST)))
                                                             (* fbbdy + fbboy)
          (replace \SFDescent of FONTDESC with (IMINUS (CADDDR FBBLIST)))
                                                             (* -fbboy)
          (replace \SFHeight of FONTDESC with (CADR FBBLIST))
          [replace CHARACTERBITMAP of FONTDESC with (SETQ CHARBITMAP (BITMAPCREATE
							(for (X ← STARTCHAR) to ENDCHAR
							   sum (ELT CHARWIDTHARRAY X))
							(CADR FBBLIST]
          (SETQ OFFSETARRAY (ARRAY (ADD1 ENDCHAR)
				   (QUOTE (BITS 16))
				   0 0))
          (SETQ STARTWORDLIST (\ACCHARPOSLIST FILE STARTCHAR ENDCHAR))
          (bind (DESTLEFT ← 0) for NTHCHAR from STARTCHAR to ENDCHAR as BBLIST in BBOXLIST
	     as STARTWORD in STARTWORDLIST
	     do (PROG (RASTERINFO BBOX BBBITMAP BBBMBASE)    (* \ACCHARPOSLIST returns NIL if no raster exists for 
							     the code)
		      (COND
			((NULL STARTWORD)

          (* If the char has no raster image, 0 should return the proper value of the offset array entry.
	  It currently returns 0 although we might want it to point to some default no-raster character that we make)


			  (SETA OFFSETARRAY NTHCHAR 0)
			  (GO L2)))
		      (SETFILEPTR FILE STARTWORD)
		      (SETQ RASTERINFO (\WIN FILE))
		      (COND
			((EQUAL (CADDDR BBLIST)
				-1)
			  (GO L2)))                          (* \ACCHARPOSLIST returns NIL if no raster exists for 
							     the code)
		      (SETQ BBOX (CAR BBLIST))
		      (COND
			((AND (ZEROP (CADDR BBLIST))
			      (ZEROP (CADDDR BBLIST)))
			  (GO L3)))
		      (SETQ BBBITMAP (BITMAPCREATE (TIMES 16 (LRSH RASTERINFO 10))
						   (LOGAND RASTERINFO 1023)))
		      (SETQ BBBMBASE (fetch BITMAPBASE of BBBITMAP))

          (* STARTWORD is the characters raster information word. The high 6 bits record number of words per scan line and 
	  the lower 10 bits is the same as bbdx bbdx. The raster for the char follows STARTWORD)


		      (\BINS FILE BBBMBASE 0 (TIMES (LRSH RASTERINFO 10)
						    2
						    (LOGAND RASTERINFO 1023)))
		      (SETQ BBBITMAP (\ACROTATECHAR BBBITMAP))
                                                             (* here is the place to add a rotation function to 
							     manipulate the character images coming off *.ac)
		      (BITBLT BBBITMAP 0 0 CHARBITMAP [PLUS DESTLEFT (COND
							      ((GREATERP 0 BBOX)
								0)
							      (T (COND
								   (PAD.LEFT (ADD1 BBOX))
								   (T BBOX]
			      (DIFFERENCE (CADR BBLIST)
					  (CADDDR FBBLIST))
			      (ELT CHARWIDTHARRAY NTHCHAR)
			      (CADDDR BBLIST)
			      (QUOTE INPUT)
			      (QUOTE REPLACE))               (* ADD1 to BBOX because we add an empty column to each 
							     raster image to the left)
		  L3  (SETA OFFSETARRAY NTHCHAR DESTLEFT)

          (* on screen ac fonts, there are no spaces stored so that the width of the char is exactly that of the character 
	  image without any spacing columns)


		  L2  (SETQ DESTLEFT (IPLUS DESTLEFT (ELT CHARWIDTHARRAY NTHCHAR)))
                                                             (* add 2 because of the two blank columns we add;
							     one on either side of the ac raster image)
		  ))
          (replace \SFOffsets of FONTDESC with OFFSETARRAY)
          (CLOSEF FILE)
          (RETURN FONTDESC])

(\WDFONTFILENAME
  [LAMBDA (FAMILY SIZE FACE)                                 (* jds "11-NOV-83 11:31")
                                                             (* returns the name of the file that should contain the 
							     character information for a font.)
    (DECLARE (GLOBALVARS \STARFONTFILEEXTENSION))
    (PACKFILENAME (QUOTE NAME)
		  (PACK* (QUOTE FORMATTER>WIDTHS>)
			 FAMILY SIZE (SELECTQ (fetch WEIGHT of FACE)
					      (BOLD (QUOTE -B))
					      "")
			 (SELECTQ (fetch SLOPE of FACE)
				  (ITALIC (QUOTE -I))
				  "")
			 "-C0")
		  (QUOTE EXTENSION)
		  (QUOTE WD])

(\ACCHARWIDTHLIST
  [LAMBDA (BOXLIST FBBOX)                                    (* jds "10-NOV-83 19:45")
                                                             (* GETACCHARSPECS returns (bbox bboy bbdx bbdy))
                                                             (* if bbdx and bbdy are both zero, then treat it as a 
							     space.)
    (for BOX in BOXLIST bind (BBLIST STARTWORD BBOX BBOY BBDX BBDY)
       collect (SETQ BBOX (CAR BOX))
	       (SETQ BBOY (CADR BOX))
	       (SETQ BBDX (CADDR BOX))
	       (SETQ BBDY (CADDR BOX))
	       (COND
		 ((AND (ZEROP BBDX)
		       (ZEROP BBDY))                         (* we've found a Space)
		   (LRSH (CAR FBBOX)
			 1))
		 (T (COND
		      ((IEQP BBDX -1)
			0)
		      (T (IPLUS BBDX (COND
				  ((GREATERP 0 BBOX)
				    0)
				  (T BBOX])

(\GETFBB
  [LAMBDA (BOXLIST)                                          (* jds "10-NOV-83 19:37")
                                                             (* Read a font bounding box from an AC file)
    (PROG (RESULTLIST CHARCOUNT BBLIST MAXBBOX MAXBBOY MINBBOX MINBBOY MAXSUMBBOXBBDX MAXSUMBBOYBBDY 
		      BBOX BBOY BBDX BBDY)                   (* \GETFBB returns the fbbdx fbbdy fbbox fbboy of an 
							     acfont)
          (SETQ MINBBOX 32767)
          (SETQ MINBBOY 32767)
          (SETQ MAXBBOX -32768)
          (SETQ MAXBBOY -32768)
          (SETQ MAXSUMBBOXBBDX -32768)
          (SETQ MAXSUMBBOYBBDY -32768)
          [for BOX in BOXLIST
	     do (SETQ BBOX (CAR BOX))
		(SETQ BBOY (CADR BOX))
		(SETQ BBDX (CADDR BOX))
		(SETQ BBDY (CADDDR BOX))                     (* GETACCHARSPECS returns bbox bboy bbdx bbdy)
		(COND
		  [(IEQP BBDY -1)
		    (SETQ BBLIST (QUOTE (0 0 0 -1]
		  (T (COND
		       ((IGREATERP BBOX MAXBBOX)
			 (SETQ MAXBBOX BBOX))
		       ((ILESSP BBOX MINBBOX)
			 (SETQ MINBBOX BBOX)))
		     (COND
		       ((IGREATERP BBOY MAXBBOY)
			 (SETQ MAXBBOY BBOY))
		       ((ILESSP BBOY MINBBOY)
			 (SETQ MINBBOY BBOY)))
		     [COND
		       ((IGREATERP (IPLUS BBOX BBDX)
				   MAXSUMBBOXBBDX)
			 (SETQ MAXSUMBBOXBBDX (IPLUS BBOX BBDX]
		     (COND
		       ((IGREATERP (IPLUS BBOY BBDY)
				   MAXSUMBBOYBBDY)
			 (SETQ MAXSUMBBOYBBDY (IPLUS BBOY BBDY]
                                                             (* \GETFBB returns the fbbdx fbbdy fbbox fbboy of an 
							     acfont)
          (RETURN (LIST (IDIFFERENCE MAXSUMBBOXBBDX MINBBOX)
			(IDIFFERENCE MAXSUMBBOYBBDY MINBBOY)
			MINBBOX MINBBOY])

(\ACCHARPOSLIST
  [LAMBDA (FILE STARTCHAR ENDCHAR)                           (* jds "10-NOV-83 20:19")
                                                             (* \ACCHARPOSLIST returns the word position of the 
							     raster for the nth character of the file)
    [SETFILEPTR FILE (IPLUS 48 (ITIMES 16 (ADD1 (IDIFFERENCE ENDCHAR STARTCHAR]
    (bind HIWORD LOWORD [DIRECTORYSTART ←(IPLUS 48 (ITIMES 16 (ADD1 (IDIFFERENCE ENDCHAR STARTCHAR]
       first (SETFILEPTR FILE DIRECTORYSTART) for X from STARTCHAR to ENDCHAR
       collect (SETQ HIWORD (\WIN FILE))
	       (SETQ LOWORD (\WIN FILE))                     (* If the position of the acchar is given as -1,-1 then 
							     the raster does not exist so return nil)
	       (COND
		 ((AND (IEQP HIWORD 65535)
		       (IEQP LOWORD 65535))
		   NIL)
		 (T (IPLUS (LLSH HIWORD 17)
			   (LLSH LOWORD 1)
			   DIRECTORYSTART])

(\ACROTATECHAR
  [LAMBDA (BITMAP)                                           (* HK "12-JUL-82 11:48")
    (PROG (NEW.BITMAP (WIDTH (fetch (BITMAP BITMAPWIDTH) of BITMAP))
		      (HEIGHT (fetch (BITMAP BITMAPHEIGHT) of BITMAP)))
          (SETQ NEW.BITMAP (BITMAPCREATE HEIGHT WIDTH))
          [for Y from 0 to (SUB1 HEIGHT) do (for X from 0 to (SUB1 WIDTH)
					       bind (Y1 ←(IDIFFERENCE (SUB1 HEIGHT)
								      Y))
					       do (BITMAPBIT NEW.BITMAP Y1 X (BITMAPBIT BITMAP X Y]
          (RETURN NEW.BITMAP])

(\READFONTWDFILE
  [LAMBDA (FILE FD WIDTHS SCALE)                             (* jds "10-NOV-83 14:15")

          (* 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 FONTWIDTHSFILES))
    (RESETLST                                                (* RESETLST to make sure the fontfiles get closed)
	      (PROG (FIXEDFLAGS FIRSTCHAR LASTCHAR TEM WIDTHSY)
		    (SETFILEPTR FILE (LLSH (INTIN FILE)
					   1))               (* Locate the segment)
		    (replace FBBOX of FD with (SIGNED (\WIN FILE)
						      BITSPERWORD))
		    (replace \SFDescent of FD with (IMINUS (SIGNED (\WIN FILE)
								   BITSPERWORD)))
                                                             (* Descent is -FBBOY)
		    (replace FBBDX of FD with (SIGNED (\WIN FILE)
						      BITSPERWORD))
		    (replace \SFHeight of FD with (SIGNED (\WIN FILE)
							  BITSPERWORD))
                                                             (* Height is FBBDY)
		    (replace \SFWidths of FD with WIDTHS)
		    (SETQ FIRSTCHAR (fetch FIRSTCHAR of FD))
                                                             (* First and last "real" characters in the font)
		    (SETQ LASTCHAR (fetch LASTCHAR of FD))
		    [COND
		      (SCALE                                 (* Dimensions are relative, must be scaled)
			     (replace FBBOX of FD with (IQUOTIENT (ITIMES (fetch FBBOX of FD)
									  SCALE)
								  1000))
			     (replace \SFDescent of FD with (IQUOTIENT (ITIMES (fetch \SFDescent
										  of FD)
									       SCALE)
								       1000))
			     (replace FBBDX of FD with (IQUOTIENT (ITIMES (fetch FBBDX of FD)
									  SCALE)
								  1000))
			     (replace \SFHeight of FD with (IQUOTIENT (ITIMES (fetch \SFHeight
										 of FD)
									      SCALE)
								      1000]
		    (replace \SFAscent of FD with (IDIFFERENCE (fetch \SFHeight of FD)
							       (fetch \SFDescent of FD)))
		    (SETQ FIXEDFLAGS (LRSH (\BIN FILE)
					   6))               (* The fixed flags)
		    (\BIN FILE)                              (* Skip the spares)
		    [COND
		      ((EQ 2 (LOGAND FIXEDFLAGS 2))
			(SETQ TEM (\WIN FILE))               (* The fixed width for this font)
			[COND
			  ((AND SCALE (NOT (ZEROP TEM)))
			    (SETQ TEM (IQUOTIENT (ITIMES TEM SCALE)
						 1000]
			(for I from FIRSTCHAR to LASTCHAR do (SETA WIDTHS I TEM)))
		      (T (AIN WIDTHS FIRSTCHAR (ADD1 (IDIFFERENCE LASTCHAR FIRSTCHAR))
			      FILE)
			 (for I from FIRSTCHAR to LASTCHAR when (EQ noInfoCode (ELT WIDTHS I))
			    do (SETA WIDTHS I 0))
			 (COND
			   (SCALE (for I from FIRSTCHAR to LASTCHAR
				     do (SETA WIDTHS I (IQUOTIENT (ITIMES (ELT WIDTHS I)
									  SCALE)
								  1000]
		    (COND
		      [(EQ 1 (LOGAND FIXEDFLAGS 1))
			(SETQ WIDTHSY (\WIN FILE))           (* 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 SCALE (NOT (ZEROP WIDTHSY)))
							   (IQUOTIENT (ITIMES WIDTHSY SCALE)
								      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))
			      FILE)
			 (for I from FIRSTCHAR to LASTCHAR when (EQ noInfoCode (ELT WIDTHSY I))
			    do (SETA WIDTHSY I 0))
			 (COND
			   (SCALE (for I from FIRSTCHAR to LASTCHAR
				     do (SETA WIDTHSY I (IQUOTIENT (ITIMES (ELT WIDTHSY I)
									   SCALE)
								   1000])

(\WDFINDFONT
  [LAMBDA (FD MSIZE WOFD)                                    (* jds "11-NOV-83 16:36")

          (* Finds the widths information for the specified FAMILY, FACECODE, MSIZE, and ROTATION. The FIRSTCHAR and 
	  LASTCHAR of the font are filled in, since we have to read past those to check the size. If successful, returns the
	  size found in the widths file, with zero indicating that dimensions in the widths file are relative, leaving the 
	  file pointing just after the Rotation word of the font. -
	  Returns NIL if the font is not found)


    (bind TYPE LENGTH SIZE FAMILYCODE (ROTATION ←(fetch ROTATION of FD))
	  (FACECODE ←(\FACECODE (fetch FONTFACE of FD)))
	  (NEXT ← 0) first (OR (SETQ FAMILYCODE (\FAMILYCODE (fetch FONTFAMILY of FD)
							     WOFD))
			       (RETURN NIL))
       do (SETQ TYPE (\BIN WOFD))
	  (SETQ LENGTH (\BIN WOFD))
	  (add NEXT (LLSH (IPLUS LENGTH (LLSH (LOGAND TYPE 15)
					      8))
			  1))
	  (SELECTQ (LRSH TYPE 4)
		   [4 (COND
			((AND (EQ FAMILYCODE (\BIN WOFD))
			      (EQ FACECODE (\BIN WOFD)))
			  (replace FIRSTCHAR of FD with (\BIN WOFD))
			  (replace LASTCHAR of FD with (\BIN WOFD))
			  (COND
			    ((AND (OR (ZEROP (SETQ SIZE (\WIN WOFD)))
				      (EQ MSIZE SIZE))
				  (EQ ROTATION (\WIN WOFD)))
			      (replace \SFFACECODE of FD with FACECODE)
			      (RETURN SIZE]
		   (0 (RETURN NIL))
		   NIL)
	  (SETFILEPTR WOFD NEXT])
)

(RPAQ? \STARFONTFILEEXTENSION (QUOTE AC))

(RPAQ? STARFONTDIRECTORIES (QUOTE ({PHYLUM}<STARFONTS>)))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS STARFONTDIRECTORIES \STARFONTFILEEXTENSION)
)
(DECLARE: DONTCOPY EVAL@COMPILE 
(FILESLOAD (LOADCOMP)
	   FONT)
)
(DECLARE: DONTCOPY
  (FILEMAP (NIL (683 22594 (\ACFONTFILENAME 693 . 1337) (\CREATESTARFONT 1339 . 6061) (\READACFONTBOXES 
6063 . 7022) (\READACFONTFILE 7024 . 12362) (\WDFONTFILENAME 12364 . 12998) (\ACCHARWIDTHLIST 13000 . 
13851) (\GETFBB 13853 . 15551) (\ACCHARPOSLIST 15553 . 16491) (\ACROTATECHAR 16493 . 17073) (
\READFONTWDFILE 17075 . 21080) (\WDFINDFONT 21082 . 22592)))))
STOP