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

(FILECREATED "15-Jul-88 16:34:43" |{MCS:MCS:STANFORD}<LANE>READAPPLEFONT.;18|
 8757   

      changes to%:  (VARS READAPPLEFONTCOMS)
                    (RECORDS APPLEFONTREC)
                    (FNS READAPPLEFONTREC \READAPPLEFONTFILE READAPPLEFONTFILE)

      previous date%: "20-May-88 10:56:08" |{MCS:MCS:STANFORD}<LANE>READAPPLEFONT.;12|)


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

(PRETTYCOMPRINT READAPPLEFONTCOMS)

(RPAQQ READAPPLEFONTCOMS
 ((FNS READAPPLEFONTFILE READAPPLEFONTREC)
                              (INITVARS (APPLEFONTREC.OFFSET 264)
                                     READAPPLEFONT.DEBUG)
                              (GLOBALVARS APPLEFONTREC.OFFSET READAPPLEFONT.DEBUG)
                              (DECLARE%: DONTCOPY (RECORDS APPLEFONTREC))
                              (INITRECORDS APPLEFONTREC)
                              (FILES READDISPLAYFONT)
                              (APPENDVARS (DISPLAYFONTTYPES (APPLE READAPPLEFONTFILE))
                                     (DISPLAYFONTEXTENSIONS APPLE))))
(DEFINEQ

(READAPPLEFONTFILE

  [LAMBDA (STREAM FAMILY SIZE FACE)
                      (* ; "Edited 15-Jul-88 09:37 by cdl")

    (LET ((APPLEFONTREC (READAPPLEFONTREC
 STREAM))
          (CSINFO (create
 CHARSETINFO
                         IMAGEWIDTHS _ (\CREATECSINFOELEMENT)
                         YWIDTHS _ (\CREATECSINFOELEMENT)))
          OFFSETS WIDTHS IMAGEWIDTHS YWIDTHS NUMBCODES BITMAP CHARBITMAP)
         (SETQ OFFSETS (fetch
 (CHARSETINFO OFFSETS) of
 CSINFO))
         (SETQ WIDTHS (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO))
         (SETQ IMAGEWIDTHS (fetch
 (CHARSETINFO IMAGEWIDTHS) of
 CSINFO))
         (SETQ YWIDTHS (fetch
 (CHARSETINFO YWIDTHS) of
 CSINFO))
         (with
 APPLEFONTREC APPLEFONTREC (replace
 (CHARSETINFO CHARSETASCENT) of
 CSINFO
                                                with
 ASCENT)
                (replace
 (CHARSETINFO CHARSETDESCENT) of
 CSINFO with
 DESCENT)
                (SETQ BITMAP (BITMAPCREATE (UNFOLD ROWWORDS BITSPERWORD)
                                    FRECTHEIGHT))
                (\BINS STREAM (fetch
 BITMAPBASE of
 BITMAP)
                       0
                       (UNFOLD (TIMES ROWWORDS FRECTHEIGHT)
                              BYTESPERWORD))
                (SETQ NUMBCODES (PLUS (DIFFERENCE LASTCHAR FIRSTCHAR)
                                      3))
                (bind
 (YWIDTH _ (PLUS LEADING FRECTHEIGHT)) for
 I from
 0
                   to
 (PLUS \MAXTHINCHAR 2) do
 (\FSETOFFSET OFFSETS I 0) 
                                                             (* ; 

                                                           "initialize the offsets and widths")

                                                      (\FSETWIDTH WIDTHS I 0)
                                                      (\FSETWIDTH IMAGEWIDTHS I 0)
                                                      (\FSETWIDTH YWIDTHS I YWIDTH))
                (for
 I from
 FIRSTCHAR as
 N to
 NUMBCODES
                   do
 (\FSETOFFSET OFFSETS I (BIN16 STREAM)))
                (SETFILEPTR STREAM OWTLOC)
                (SETQ CHARBITMAP (BITMAPCREATE (TIMES FRECTWIDTH NUMBCODES)
                                        FRECTHEIGHT))
                (bind
 WORD CHAROFFSET OLDOFFSET for
 CHAR from
 FIRSTCHAR as
 N
                   to
 (SUB1 NUMBCODES) as
 OFFSET from
 0 by
 FRECTWIDTH
                   unless
 (EQUAL (SETQ WORD (BIN16 STREAM))
                                     (MASK.1'S 0 16))
                   do
 (\FSETWIDTH WIDTHS CHAR (LOGAND WORD (MASK.1'S 0 8)))
                         (SETQ CHAROFFSET (RSH WORD 8))
                         (SETQ OLDOFFSET (\FGETOFFSET OFFSETS CHAR))
                         (\FSETWIDTH IMAGEWIDTHS CHAR (PLUS CHAROFFSET (DIFFERENCE
                                                                        (\FGETOFFSET OFFSETS
                                                                               (ADD1 CHAR))
                                                                        OLDOFFSET)))
                         (BITBLT BITMAP OLDOFFSET 0 CHARBITMAP (PLUS CHAROFFSET OFFSET)
                                0
                                (\FGETWIDTH IMAGEWIDTHS CHAR))
                         (\FSETOFFSET OFFSETS CHAR OFFSET)))
         (replace
 (CHARSETINFO CHARSETBITMAP) of
 CSINFO with
 CHARBITMAP)
         CSINFO])

(READAPPLEFONTREC

  [LAMBDA (STREAM)
                                       (* ; "Edited 15-Jul-88 09:53 by cdl")

    (SETFILEPTR STREAM APPLEFONTREC.OFFSET)
    (LET ((APPLEFONTREC (create
 APPLEFONTREC)))
         (with
 APPLEFONTREC APPLEFONTREC (SETQ FONTTYPE (BIN16 STREAM))
                (SETQ FIRSTCHAR (BIN16 STREAM))
                (SETQ LASTCHAR (BIN16 STREAM))
                (SETQ WIDMAX (BIN16 STREAM))
                (SETQ KERNMAX (BIN16 STREAM))
                (SETQ NDESCENT (BIN16 STREAM))
                (SETQ FRECTWIDTH (BIN16 STREAM))
                (SETQ FRECTHEIGHT (BIN16 STREAM))
                [SETQ OWTLOC (PLUS (GETFILEPTR STREAM)
                                   (TIMES 2 (BIN16 STREAM]
                (SETQ ASCENT (BIN16 STREAM))
                (SETQ DESCENT (BIN16 STREAM))
                (SETQ LEADING (BIN16 STREAM))
                (SETQ ROWWORDS (BIN16 STREAM)))
         (if
 READAPPLEFONT.DEBUG
             then
 (INSPECT APPLEFONTREC))
         APPLEFONTREC])
)

(RPAQ? APPLEFONTREC.OFFSET
 264)

(RPAQ? READAPPLEFONT.DEBUG
 NIL)
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS APPLEFONTREC.OFFSET READAPPLEFONT.DEBUG)
)
(DECLARE%: DONTCOPY 
(DECLARE%: EVAL@COMPILE

(DATATYPE APPLEFONTREC
 ((FONTTYPE WORD)
                            (FIRSTCHAR WORD)                 (* ; "minimum ascii code")

                            (LASTCHAR WORD)                  (* ; "maximum ascii code")

                            (WIDMAX WORD)                    (* ; "maximum width")

                            (KERNMAX WORD)                   (* ; 

                                                           "negative of maximum character kern")

                            (NDESCENT WORD)                  (* ; "negative of descent")

                            (FRECTWIDTH WORD)                (* ; "width of font rectangle")

                            (FRECTHEIGHT WORD)               (* ; 

                                                  "height of font rectangle, also height of bitmap")

                            (OWTLOC FIXP)                    (* ; "offset to offset/width table")

                            (ASCENT WORD)                    (* ; 

                                                           "ascent in scan lines (=FBBdy+FBBoy)")

                            (DESCENT WORD)                   (* ; "descent in scan lines (=FBBoy)")

                            (LEADING WORD)
                            (ROWWORDS WORD)                  (* ; "raster width of bitmap")

                            ))
)

(/DECLAREDATATYPE 'APPLEFONTREC
       '(WORD WORD WORD WORD WORD WORD WORD WORD FIXP WORD WORD WORD WORD)
       '((APPLEFONTREC 0 (BITS . 15))
         (APPLEFONTREC 1 (BITS . 15))
         (APPLEFONTREC 2 (BITS . 15))
         (APPLEFONTREC 3 (BITS . 15))
         (APPLEFONTREC 4 (BITS . 15))
         (APPLEFONTREC 5 (BITS . 15))
         (APPLEFONTREC 6 (BITS . 15))
         (APPLEFONTREC 7 (BITS . 15))
         (APPLEFONTREC 8 FIXP)
         (APPLEFONTREC 10 (BITS . 15))
         (APPLEFONTREC 11 (BITS . 15))
         (APPLEFONTREC 12 (BITS . 15))
         (APPLEFONTREC 13 (BITS . 15)))
       '14)
)

(/DECLAREDATATYPE 'APPLEFONTREC
       '(WORD WORD WORD WORD WORD WORD WORD WORD FIXP WORD WORD WORD WORD)
       '((APPLEFONTREC 0 (BITS . 15))
         (APPLEFONTREC 1 (BITS . 15))
         (APPLEFONTREC 2 (BITS . 15))
         (APPLEFONTREC 3 (BITS . 15))
         (APPLEFONTREC 4 (BITS . 15))
         (APPLEFONTREC 5 (BITS . 15))
         (APPLEFONTREC 6 (BITS . 15))
         (APPLEFONTREC 7 (BITS . 15))
         (APPLEFONTREC 8 FIXP)
         (APPLEFONTREC 10 (BITS . 15))
         (APPLEFONTREC 11 (BITS . 15))
         (APPLEFONTREC 12 (BITS . 15))
         (APPLEFONTREC 13 (BITS . 15)))
       '14)

(FILESLOAD READDISPLAYFONT)

(APPENDTOVAR DISPLAYFONTTYPES
 (APPLE READAPPLEFONTFILE))

(APPENDTOVAR DISPLAYFONTEXTENSIONS
 APPLE)
(PUTPROPS READAPPLEFONT COPYRIGHT ("Stanford University" 1988))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1145 5691 (READAPPLEFONTFILE 1155 . 4653) (READAPPLEFONTREC 4655 . 5689)))))
STOP