(FILECREATED "28-Nov-84 22:57:10" {ERIS}<LISPCORE>LIBRARY>NSTOASCIIDISPLAYFONT.;2
 5226   

      changes to:  (FNS NSTOASCIIDISPLAYFONT READNSDISPLAYFONTFILE)

      previous date: "28-Nov-84 22:27:11" {ERIS}<LISPCORE>LIBRARY>NSTOASCIIDISPLAYFONT.;1)


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

(PRETTYCOMPRINT NSTOASCIIDISPLAYFONTCOMS)

(RPAQQ NSTOASCIIDISPLAYFONTCOMS
 ((FNS NSTOASCIIDISPLAYFONT READNSDISPLAYFONTFILE)
				 (FILES (FROM VALUEOF LISPUSERSDIRECTORIES)
					EDITFONT)))
(DEFINEQ

(NSTOASCIIDISPLAYFONT

  [LAMBDA (ASCIITONSMAPARRAY ASCIITONSFIXARRAY ASCIIFAMILY NSFAMILY SIZE FONTFACE ROTATION DEVICE)
                                                             (* rmk: "28-Nov-84 22:56")

                                                             (* Produces an ASCII displayfont by getting bitmaps and

							     widths from NS character sets, as determined by the 

							     translation table)

                                                             (* 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 (READNSDISPLAYFONTFILE
 NSFAMILY SIZE FONTFACE)))
          (
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 (NSCHARSET 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

					 ((READNSDISPLAYFONTFILE
 NSFAMILY SIZE FONTFACE 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
 (NSCHARSET NSCODE)
						CHARSETDIR)))
	     do
                                              (* For each non-ASCII character, look for width info in

							     the right NS place. If none, use zero width.)

		(
PUTCHARBITMAP
 I FD (
GETCHARBITMAP
 (NSCHAR NSCODE)
						   CHARSETINFO)))
          (
RETURN
 FD])

(READNSDISPLAYFONTFILE

  [LAMBDA (FAMILY SIZE FACE CHARSET)                         (* rmk: "28-Nov-84 22:25")

    (DECLARE
 (
GLOBALVARS
 DISPLAYFONTEXTENSIONS DISPLAYFONTDIRECTORIES))
    (
SELECTQ
 (
SYSTEMTYPE
)
	     (J (
PROG
 ((FONTFILE (
\FONTFILENAME
 FAMILY SIZE FACE))
		       FONTDESC STRM)
		      (
COND

			((
SETQ
 STRM (
AND
 FONTDIRECTORIES (
FINDFILE
 FONTFILE T FONTDIRECTORIES)))
			  (
SETQ
 STRM (
OPENSTREAM
 FONTFILE (
QUOTE
 INPUT)))
			  (
SETQ
 FONTDESC (\READJERICHOFONTFILE FAMILY SIZE FACE STRM))
			  (
CLOSEF
 STRM)))
		      (replace
 FONTSCALE of
 FONTDESC with
 1)
		      (
RETURN
 FONTDESC)))
	     [D (for
 E FONTFILE FONTDESC STRM inside
 DISPLAYFONTEXTENSIONS
		   when
 (
SETQ
 FONTFILE (
FINDFILE
 (
\FONTFILENAME
 FAMILY SIZE FACE E CHARSET)
						 T DISPLAYFONTDIRECTORIES))
		   do
 (
SETQ
 STRM (
OPENSTREAM
 FONTFILE (
QUOTE
 INPUT)))
		      [
RESETLST
 (
SETQ
 FONTDESC (
SELECTQ
 (
FONTFILEFORMAT
 STRM T)
							(STRIKE (
RESETSAVE

								  NIL
								  (
LIST
 (
FUNCTION
 CLOSEF)
									STRM))
								(
\READSTRIKEFONTFILE
 STRM FAMILY SIZE 
										     FACE))
							(AC 
                                                             (* CLOSEF is guaranteed inside \READACFONTFILE, against

							     the possibility that we have to copy to make 

							     randaccessp)

							    (
\READACFONTFILE
 STRM FAMILY SIZE FACE))
							(
PROG1
 (
CLOSEF
 STRM)
                                                             (* This would get done by RESETSAVE if AC's were read 

							     sequentially and we could factor the RESETSAVE)

							       ]

          (* If not a recognizable format, I guess we should keep looking for another possible extension, altho it would also 

	  be nice to tell the user that he has a bogus file.)



		      (
COND

			(FONTDESC (replace
 FONTSCALE of
 FONTDESC with
 1)
				  (
RETURN
 FONTDESC]
	     (
SHOULDNT
])
)
(FILESLOAD (FROM VALUEOF LISPUSERSDIRECTORIES)
	   EDITFONT)
(PUTPROPS NSTOASCIIDISPLAYFONT COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (520 5074 (NSTOASCIIDISPLAYFONT 530 . 3015) (READNSDISPLAYFONTFILE 3017 . 5072)))))
STOP