code.delx.au - gnu-emacs/blob - lisp/bdf.el

   1 ;;; bdf.el --- BDF font file handler for ps-print.
   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.
 382 (defun bdf-generate-font (charset font-spec)
 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)
 387                                   (charset-width charset)
 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