Mercurial > emacs
annotate lisp/bdf.el @ 23834:ce563c147515
Do string comparision of _NMAKE_VER.
author | Geoff Voelker <voelker@cs.washington.edu> |
---|---|
date | Tue, 08 Dec 1998 23:56:14 +0000 |
parents | ced1e63179e6 |
children |
rev | line source |
---|---|
23169
ced1e63179e6
(bdf-generate-font): New argument CHARSET. Give WIDTH
Kenichi Handa <handa@m17n.org>
parents:
23093
diff
changeset
|
1 ;;; bdf.el --- BDF font file handler for ps-print. |
23093 | 2 |
3 ;; Copyright (C) 1998 Electrotechnical Laboratory, JAPAN. | |
4 ;; Licensed to the Free Software Foundation. | |
5 | |
6 ;; Keywords: BDF, font, PostScript | |
7 | |
8 ;; This file is part of GNU Emacs. | |
9 | |
10 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 ;; it under the terms of the GNU General Public License as published by | |
12 ;; the Free Software Foundation; either version 2, or (at your option) | |
13 ;; any later version. | |
14 | |
15 ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 ;; GNU General Public License for more details. | |
19 | |
20 ;; You should have received a copy of the GNU General Public License | |
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 ;; Boston, MA 02111-1307, USA. | |
24 | |
25 ;;; Commentary: | |
26 | |
27 ;; Functions for getting bitmap information from X's BDF font file are | |
28 ;; provided. | |
29 | |
30 ;;; Code: | |
31 | |
32 (eval-when-compile (require 'ps-print)) | |
33 | |
34 (defvar bdf-directory-list | |
35 nil | |
36 "*List of directories to search for `BDF' font files.") | |
37 | |
38 (defun bdf-expand-file-name (bdfname) | |
39 "Return an abosolute path name of a `BDF' font file BDFNAME. | |
40 It searches directories listed in the variable `bdf-directory-list' | |
41 for BDFNAME." | |
42 (if (file-name-absolute-p bdfname) | |
43 (if (file-readable-p bdfname) | |
44 bdfname) | |
45 (let ((l bdf-directory-list)) | |
46 (catch 'tag | |
47 (while l | |
48 (if (file-readable-p (expand-file-name bdfname (car l))) | |
49 (throw 'tag (expand-file-name bdfname (car l)))) | |
50 (setq l (cdr l))))))) | |
51 | |
52 (defsubst bdf-file-mod-time (filename) | |
53 "Return modification time of FILENAME. | |
54 The value is a list of two integers, the first integer has high-order | |
55 16 bits, the second has low 16 bits." | |
56 (nth 5 (file-attributes filename))) | |
57 | |
58 (defun bdf-file-newer-than-time (filename mod-time) | |
59 "Return non-nil if and only if FILENAME is newer than MOD-TIME. | |
60 MOD-TIME is a modification time as a list of two integers, the first | |
61 integer has high-order 16 bits, the second has low 16 bits." | |
62 (let ((new-mod-time (bdf-file-mod-time (bdf-expand-file-name filename)))) | |
63 (or (> (car new-mod-time) (car mod-time)) | |
64 (and (= (car new-mod-time) (car mod-time)) | |
65 (> (nth 1 new-mod-time) (nth 1 mod-time)))))) | |
66 | |
67 (defun bdf-find-file (bdfname) | |
68 "Return a buffer visiting a bdf file BDFNAME. | |
69 If BDFNAME is not an absolute path, directories listed in | |
70 `bdf-directory-list' is searched. | |
71 If BDFNAME doesn't exist, return nil." | |
72 (let ((buf (generate-new-buffer " *bdf-work*")) | |
73 (coding-system-for-read 'no-conversion)) | |
74 (save-excursion | |
75 (set-buffer buf) | |
76 (insert-file-contents (bdf-expand-file-name bdfname)) | |
77 buf))) | |
78 | |
79 (defvar bdf-cache-file "~/.bdfcache.el" | |
80 "Name of cache file which contains information of `BDF' font files.") | |
81 | |
82 (defvar bdf-cache nil | |
83 "Cached information of `BDF' font files. It is a list of FONT-INFO. | |
84 FONT-INFO is a list of the following format: | |
85 (BDFFILE ABSOLUTE-PATH MOD-TIME SIZE FONT-BOUNDING-BOX | |
86 RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR) | |
87 See the documentation of the function `bdf-read-font-info' for more detail.") | |
88 | |
89 (defun bdf-read-cache () | |
90 "Return a cached information about `BDF' font files from a cache file. | |
91 The variable `bdf-cache-file' holds the cache file name. | |
92 If the cache file is not readable, this return nil." | |
93 (setq bdf-cache nil) | |
94 (condition-case nil | |
95 (if (file-readable-p bdf-cache-file) | |
96 (load-file bdf-cache-file)) | |
97 (error nil)) | |
98 (if (not (listp bdf-cache)) | |
99 (setq bdf-cache nil))) | |
100 | |
101 (defun bdf-write-cache () | |
102 "Write out cached information of `BDF' font file to a file. | |
103 The variable `bdf-cache-file' holds the cache file name. | |
104 The file is written if and only if the file alreay exists and writable." | |
105 (if (and bdf-cache | |
106 (file-exists-p bdf-cache-file) | |
107 (file-writable-p bdf-cache-file)) | |
108 (write-region (format "(setq bdf-cache '%S)\n" bdf-cache) | |
109 nil bdf-cache-file))) | |
110 | |
111 (defun bdf-set-cache (font-info) | |
112 "Cache FONT-INFO as information about one `BDF' font file. | |
113 FONT-INFO is a list of the following format: | |
114 (BDFFILE ABSOLUTE-PATH MOD-TIME SIZE FONT-BOUNDING-BOX | |
115 RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR) | |
116 See the documentation of the function `bdf-read-font-info' for more detail." | |
117 (let ((slot (assoc (car font-info) bdf-cache))) | |
118 (if slot | |
119 (setcdr slot (cdr font-info)) | |
120 (setq bdf-cache (cons font-info bdf-cache))))) | |
121 | |
122 (defun bdf-initialize () | |
123 "Initialize `bdf' library." | |
124 (if (bdf-read-cache) | |
125 (add-hook 'kill-emacs-hook 'bdf-write-cache))) | |
126 | |
127 (defun bdf-compact-code (code code-range) | |
128 (if (or (< code (aref code-range 4)) | |
129 (> code (aref code-range 5))) | |
130 (setq code (aref code-range 6))) | |
131 (+ (* (- (lsh code -8) (aref code-range 0)) | |
132 (1+ (- (aref code-range 3) (aref code-range 2)))) | |
133 (- (logand code 255) (aref code-range 2)))) | |
134 | |
135 (defun bdf-expand-code (code code-range) | |
136 (let ((code0-range (1+ (- (aref code-range 3) (aref code-range 2))))) | |
137 (+ (* (+ (/ code code0-range) (aref code-range 0)) 256) | |
138 (+ (% code code0-range) (aref code-range 2))))) | |
139 | |
140 (defun bdf-read-font-info (bdfname) | |
141 "Read `BDF' font file BDFNAME and return information (FONT-INFO) of the file. | |
142 FONT-INFO is a list of the following format: | |
143 (BDFFILE ABSOLUTE-PATH MOD-TIME FONT-BOUNDING-BOX | |
144 RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR) | |
145 | |
146 BDFFILE is a name of a font file (excluding directory part). | |
147 | |
148 ABSOLUTE-PATH is an absolute path of the font file. | |
149 | |
150 MOD-TIME is last modification time as a list of two integers, the | |
151 first integer has high-order 16 bits, the second has low 16 bits. | |
152 | |
153 SIZE is a size of the font. This value is got from SIZE record of the | |
154 font. | |
155 | |
156 FONT-BOUNDING-BOX is the font bounding box as a list of four integers, | |
157 BBX-WIDTH, BBX-HEIGHT, BBX-XOFF, and BBX-YOFF. | |
158 | |
159 RELATIVE-COMPOSE is an integer value of the font's property | |
160 `_MULE_RELATIVE_COMPOSE'. If the font doesn't have this property, the | |
161 value is 0. | |
162 | |
163 BASELINE-OFFSET is an integer value of the font's property | |
164 `_MULE_BASELINE_OFFSET'. If the font doesn't have this property, the | |
165 value is 0. | |
166 | |
167 CODE-RANGE is a vector of minimum 1st byte, maximum 1st byte, minimum | |
168 2nd byte, maximum 2nd byte, minimum code, maximum code, and default | |
169 code. For 1-byte fonts, the first two elements are 0. | |
170 | |
171 MAXLEN is a maximum bytes of one glyph informaion in the font file. | |
172 | |
173 OFFSET-VECTOR is a vector of a file position which starts bitmap data | |
174 of the glyph in the font file. | |
175 | |
176 Nth element of OFFSET-VECTOR is a file position for the glyph of code | |
177 CODE, where N and CODE are in the following relation: | |
178 (bdf-compact-code CODE) => N, (bdf-expand-code N) => CODE" | |
179 (let ((absolute-path (bdf-expand-file-name bdfname)) | |
180 (maxlen 0) | |
181 size | |
182 font-bounding-box | |
183 (relative-compose 'false) | |
184 (baseline-offset 0) | |
185 default-char | |
186 code-range | |
187 offset-vector | |
188 buf) | |
189 (if absolute-path | |
190 (message "Reading %s..." bdfname) | |
191 (error "BDF file %s doesn't exist" bdfname)) | |
192 (setq buf (bdf-find-file absolute-path)) | |
193 (unwind-protect | |
194 (save-excursion | |
195 (set-buffer buf) | |
196 (goto-char (point-min)) | |
197 (search-forward "\nFONTBOUNDINGBOX") | |
198 (setq font-bounding-box (vector (read (current-buffer)) | |
199 (read (current-buffer)) | |
200 (read (current-buffer)) | |
201 (read (current-buffer)))) | |
202 ;; The following kludgy code is to avoid bugs of fonts | |
203 ;; jiskan16.bdf and jiskan24.bdf distributed with X. | |
204 ;; They contain wrong FONTBOUNDINGBOX. | |
205 (if (and (> (aref font-bounding-box 3) 0) | |
206 (string-match "jiskan\\(16\\|24\\)" bdfname)) | |
207 (aset font-bounding-box 3 | |
208 (- (aref font-bounding-box 3)))) | |
209 | |
210 (goto-char (point-min)) | |
211 (search-forward "\nSIZE ") | |
212 (setq size (read (current-buffer))) | |
213 ;; The following kludgy code is t avoid bugs of several | |
214 ;; fonts which have wrong SIZE record. | |
215 (if (<= size (/ (aref font-bounding-box 1) 2)) | |
216 (setq size (aref font-bounding-box 1))) | |
217 | |
218 (goto-char (point-min)) | |
219 (if (search-forward "\nDEFAULT_CHAR" nil t) | |
220 (setq default-char (read (current-buffer)))) | |
221 | |
222 (search-forward "\nSTARTCHAR") | |
223 (forward-line -1) | |
224 (let ((limit (point))) | |
225 (goto-char (point-min)) | |
226 (if (search-forward "\n_MULE_RELATIVE_COMPOSE" limit t) | |
227 (progn | |
228 (goto-char (match-end 0)) | |
229 (setq relative-compose (read (current-buffer))))) | |
230 (goto-char (point-min)) | |
231 (if (search-forward "\n_MULE_BASELINE_OFFSET" limit t) | |
232 (progn | |
233 (goto-char (match-end 0)) | |
234 (setq baseline-offset (read (current-buffer)))))) | |
235 | |
236 (let ((min-code0 256) (min-code1 256) (max-code0 0) (max-code1 0) | |
237 (min-code 65536) | |
238 (max-code 0) | |
239 (glyph-list nil) | |
240 code bbx offset) | |
241 (while (search-forward "\nSTARTCHAR" nil t) | |
242 (setq offset (line-beginning-position)) | |
243 (search-forward "\nENCODING") | |
244 (setq code (read (current-buffer))) | |
245 (let ((code0 (lsh code -8)) | |
246 (code1 (logand code 255))) | |
247 (if (< code0 min-code0) (setq min-code0 code0) | |
248 (if (> code0 max-code0) (setq max-code0 code0))) | |
249 (if (< code1 min-code1) (setq min-code1 code1) | |
250 (if (> code1 max-code1) (setq max-code1 code1)))) | |
251 (if (< code min-code) | |
252 (setq min-code code) | |
253 (if (> code max-code) | |
254 (setq max-code code))) | |
255 (search-forward "ENDCHAR") | |
256 (if (< maxlen (- (point) offset)) | |
257 (setq maxlen (- (point) offset))) | |
258 (setq glyph-list (cons (cons code offset) glyph-list))) | |
259 (setq code-range | |
260 (vector min-code0 max-code0 min-code1 max-code1 | |
261 min-code max-code (or default-char min-code))) | |
262 (setq offset-vector | |
263 (make-vector (1+ (bdf-compact-code max-code code-range)) | |
264 nil)) | |
265 (while glyph-list | |
266 (let ((glyph (car glyph-list))) | |
267 (aset offset-vector | |
268 (bdf-compact-code (car glyph) code-range) | |
269 (cdr glyph))) | |
270 (setq glyph-list (cdr glyph-list))))) | |
271 (kill-buffer buf)) | |
272 (message "Reading %s...done" bdfname) | |
273 (list bdfname absolute-path (bdf-file-mod-time absolute-path) | |
274 size font-bounding-box relative-compose baseline-offset | |
275 code-range maxlen offset-vector))) | |
276 | |
277 (defsubst bdf-info-absolute-path (font-info) (nth 1 font-info)) | |
278 (defsubst bdf-info-mod-time (font-info) (nth 2 font-info)) | |
279 (defsubst bdf-info-size (font-info) (nth 3 font-info)) | |
280 (defsubst bdf-info-font-bounding-box (font-info) (nth 4 font-info)) | |
281 (defsubst bdf-info-relative-compose (font-info) (nth 5 font-info)) | |
282 (defsubst bdf-info-baseline-offset (font-info) (nth 6 font-info)) | |
283 (defsubst bdf-info-code-range (font-info) (nth 7 font-info)) | |
284 (defsubst bdf-info-maxlen (font-info) (nth 8 font-info)) | |
285 (defsubst bdf-info-offset-vector (font-info) (nth 9 font-info)) | |
286 | |
287 (defun bdf-get-font-info (bdfname) | |
288 "Return information about `BDF' font file BDFNAME. | |
289 The value FONT-INFO is a list of the following format: | |
290 (BDFFILE ABSOLUTE-PATH MOD-TIME SIZE FONT-BOUNDING-BOX | |
291 RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR) | |
292 See the documentation of the function `bdf-read-font-info' for more detail." | |
293 (or bdf-cache | |
294 (bdf-read-cache)) | |
295 (let ((font-info (assoc bdfname bdf-cache))) | |
296 (if (or (not font-info) | |
297 (not (file-readable-p (bdf-info-absolute-path font-info))) | |
298 (bdf-file-newer-than-time bdfname (bdf-info-mod-time font-info))) | |
299 (progn | |
300 (setq font-info (bdf-read-font-info bdfname)) | |
301 (bdf-set-cache font-info))) | |
302 font-info)) | |
303 | |
304 (defun bdf-read-bitmap (bdfname offset maxlen) | |
305 "Read `BDF' font file BDFNAME to get bitmap data at file poistion OFFSET. | |
306 BDFNAME is an abosolute path name of the font file. | |
307 MAXLEN specifies how many bytes we should read at least. | |
308 The value is a list of DWIDTH, BBX, and BITMAP-STRING. | |
309 DWIDTH is a pixel width of a glyph. | |
310 BBX is a bounding box of the glyph. | |
311 BITMAP-STRING is a string representing bits by hexadecimal digits." | |
312 (let ((coding-system-for-read 'no-conversion) | |
313 dwidth bbx height yoff bitmap-string) | |
314 (condition-case nil | |
315 (with-temp-buffer | |
316 (insert-file-contents bdfname nil offset (+ offset maxlen)) | |
317 (goto-char (point-min)) | |
318 (search-forward "\nDWIDTH") | |
319 (setq dwidth (read (current-buffer))) | |
320 (goto-char (point-min)) | |
321 (search-forward "\nBBX") | |
322 (setq bbx (vector (read (current-buffer)) (read (current-buffer)) | |
323 (read (current-buffer)) (read (current-buffer)))) | |
324 (setq height (aref bbx 1) yoff (aref bbx 3)) | |
325 (search-forward "\nBITMAP") | |
326 (forward-line 1) | |
327 (delete-region (point-min) (point)) | |
328 (if (looking-at "\\(0+\n\\)+") | |
329 (progn | |
330 (setq height | |
331 (- height (count-lines (point) (match-end 0)))) | |
332 (delete-region (point) (match-end 0)))) | |
333 (or (looking-at "ENDCHAR") | |
334 (progn | |
335 (search-forward "ENDCHAR" nil 'move) | |
336 (forward-line -1) | |
337 (while (looking-at "0+$") | |
338 (setq yoff (1+ yoff) height (1- height)) | |
339 (forward-line -1)) | |
340 (forward-line 1))) | |
341 (aset bbx 1 height) | |
342 (aset bbx 3 yoff) | |
343 (delete-region (point) (point-max)) | |
344 (goto-char (point-min)) | |
345 (while (not (eobp)) | |
346 (end-of-line) | |
347 (delete-char 1)) | |
348 (setq bitmap-string (buffer-string))) | |
349 (error nil)) | |
350 (list dwidth bbx bitmap-string))) | |
351 | |
352 (defun bdf-get-bitmaps (bdfname codes) | |
353 "Return bitmap information of glyphs of CODES in `BDF' font file BDFNAME. | |
354 CODES is a list of encoding number of glyphs in the file. | |
355 The value is a list of CODE, DWIDTH, BBX, and BITMAP-STRING. | |
356 DWIDTH is a pixel width of a glyph. | |
357 BBX is a bounding box of the glyph. | |
358 BITMAP-STRING is a string representing bits by hexadecimal digits." | |
359 (let* ((font-info (bdf-get-font-info bdfname)) | |
360 (absolute-path (bdf-info-absolute-path font-info)) | |
361 (font-bounding-box (bdf-info-font-bounding-box font-info)) | |
362 (maxlen (bdf-info-maxlen font-info)) | |
363 (code-range (bdf-info-code-range font-info)) | |
364 (offset-vector (bdf-info-offset-vector font-info))) | |
365 (mapcar (function | |
366 (lambda (x) | |
367 (cons x (bdf-read-bitmap | |
368 absolute-path | |
369 (aref offset-vector (bdf-compact-code x code-range)) | |
370 maxlen)))) | |
371 codes))) | |
372 | |
373 ;;; Interface to ps-print.el | |
374 | |
375 ;; Called from ps-mule-init-external-library. | |
376 (defun bdf-generate-prologue () | |
377 (or bdf-cache | |
378 (bdf-initialize)) | |
379 (ps-mule-generate-bitmap-prologue)) | |
380 | |
381 ;; Called from ps-mule-generate-font. | |
23169
ced1e63179e6
(bdf-generate-font): New argument CHARSET. Give WIDTH
Kenichi Handa <handa@m17n.org>
parents:
23093
diff
changeset
|
382 (defun bdf-generate-font (charset font-spec) |
23093 | 383 (let* ((font-name (ps-mule-font-spec-name font-spec)) |
384 (font-info (bdf-get-font-info font-name))) | |
385 (ps-mule-generate-bitmap-font font-name | |
386 (ps-mule-font-spec-bytes font-spec) | |
23169
ced1e63179e6
(bdf-generate-font): New argument CHARSET. Give WIDTH
Kenichi Handa <handa@m17n.org>
parents:
23093
diff
changeset
|
387 (charset-width charset) |
23093 | 388 (bdf-info-size font-info) |
389 (bdf-info-relative-compose font-info) | |
390 (bdf-info-baseline-offset font-info) | |
391 (bdf-info-font-bounding-box font-info)))) | |
392 | |
393 ;; Called from ps-mule-generate-glyphs. | |
394 (defun bdf-generate-glyphs (font-spec code-list bytes) | |
395 (let ((font-name (ps-mule-font-spec-name font-spec))) | |
396 (mapcar (function | |
397 (lambda (x) | |
398 (apply 'ps-mule-generate-bitmap-glyph font-name x))) | |
399 (bdf-get-bitmaps font-name code-list)))) | |
400 | |
401 (provide 'bdf) | |
402 | |
403 ;;; bdf.el ends here |