cgit.sxemacs.org Git - packages/blob - xemacs-packages/ps-print/ps-bdf.el

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