(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")

(FILECREATED "15-Jul-88 16:33:54" |{MCS:MCS:STANFORD}<LANE>READDISPLAYFONT.;2|
 4644   

      changes to%:  (VARS READDISPLAYFONTCOMS)

      previous date%: " 3-May-88 10:33:05" |{MCS:MCS:STANFORD}<LANE>READDISPLAYFONT.;1|)


(* "
Copyright (c) 1988 by Stanford University.  All rights reserved.
")

(PRETTYCOMPRINT READDISPLAYFONTCOMS)

(RPAQQ READDISPLAYFONTCOMS
 ((* Redefinition of DISPLAY font functions to facilitate addition of 
                                   new font types)
                                (FNS \READDISPLAYFONTFILE FONTFILEFORMAT)
                                (ADDVARS (DISPLAYFONTTYPES (AC \READACFONTFILE)
                                                (STRIKE \READSTRIKEFONTFILE)))
                                (GLOBALVARS DISPLAYFONTTYPES)
                                (DECLARE%: DONTCOPY (RECORDS DISPLAYFONTTYPE))))



(* Redefinition of DISPLAY font functions to facilitate addition of new font types)


(DEFINEQ

(\READDISPLAYFONTFILE

  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET)
         (* ; "Edited  3-May-88 10:31 by cdl")


    (DECLARE
 (GLOBALVARS DISPLAYFONTEXTENSIONS DISPLAYFONTDIRECTORIES))
    (bind
 FONTFILE FONTTYPE CSINFO STREAM for
 EXTENSION inside
 DISPLAYFONTEXTENSIONS
       when
 (SETQ FONTFILE (\FINDFONTFILE FAMILY SIZE FACE ROTATION DEVICE CHARSET 
                                  DISPLAYFONTDIRECTORIES (LIST EXTENSION)))
       do
 (* Use CLOSE? to avoid redundant CLOSEF in AC font file case)

          (RESETLST [RESETSAVE NIL `(CLOSEF? ,(SETQ STREAM (OPENSTREAM FONTFILE 'INPUT]
                 (if
 (SETQ FONTTYPE (ASSOC (FONTFILEFORMAT
 STREAM T)
                                           DISPLAYFONTTYPES))
                     then
 (SETQ CSINFO (with
 DISPLAYFONTTYPE FONTTYPE (APPLY* READFN STREAM FAMILY 
                                                                             SIZE FACE)))
                   else
 (SHOULDNT)))
          (RETURN CSINFO])

(FONTFILEFORMAT

  [LAMBDA (STREAM LEAVEOPEN)
                                 (* ; "Edited  3-May-88 10:26 by cdl")

                                                             (* Returns the font format of STREAM)

    [OR (OPENP STREAM 'INPUT)
        (SETQ STREAM (OPENSTREAM STREAM 'INPUT]
    (PROG1 (OR (LET [(EXTENSION (FILENAMEFIELD (FULLNAME STREAM)
                                       'EXTENSION]
          
          (* AC and Strike files count on side effects of this function so we have to 

          handle them separately for now)


                    (if
 (AND [NOT (FMEMB EXTENSION '(AC STRIKE]
                             (ASSOC EXTENSION DISPLAYFONTTYPES))
                        then
 EXTENSION))
               (SELECTC (\WIN STREAM)
                   ((LIST (LLSH 1 15)
                          (LOGOR (LLSH 1 15)
                                 (LLSH 1 13))) 
          
          (* If high bit of type is on, then must be strike.

          If 2nd bit is on, must be strike-index, and we punt.

          We don't care about the 3rd bit)


                        
          
          (* first word has high bits (onebit index fixed)%.

          Onebit means "new-style font" %, index is 0 for simple strike, 1 for index, and 

          fixed is if all chars have max width. Lisp doesn't care about "fixed")


                        'STRIKE)
                   ((LOGOR (LLSH 16 8)
                           12) 
          
          (* This is the length of a standard index header.

          Other files could also have this value, but it's a pretty good discriminator)


                        
          
          (* Skip to byte 25; do it with BINS so works for non-randaccessp devices.

          This skips the standard name header, then look for type 3 in the following 

          header)


                        (FRPTQ 22 (\BIN STREAM))             (* (SETFILEPTR STREAM 25))

                        (AND (EQ 3 (LRSH (\BIN STREAM)
                                         4))
                             'AC))
                   NIL))
           (OR LEAVEOPEN (CLOSEF STREAM])
)

(ADDTOVAR DISPLAYFONTTYPES
 (AC \READACFONTFILE)
                               (STRIKE \READSTRIKEFONTFILE))
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS DISPLAYFONTTYPES)
)
(DECLARE%: DONTCOPY 
(DECLARE%: EVAL@COMPILE

(RECORD DISPLAYFONTTYPE
 (TYPE READFN))
)
)
(PUTPROPS READDISPLAYFONT COPYRIGHT ("Stanford University" 1988))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1028 4280 (\READDISPLAYFONTFILE 1038 . 2081) (FONTFILEFORMAT 2083 . 4278)))))
STOP