-
-
Notifications
You must be signed in to change notification settings - Fork 24
/
Copy pathREADAPPLEFONT
175 lines (158 loc) · 8.65 KB
/
READAPPLEFONT
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
(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