1 ;;; bitmap-stipple.el --- display bitmap file using stipple.
2 ;; Copyright (C) 1998-2000 Daiki Ueno
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
6 ;; Keywords: bitmap, stipple
8 ;; This file is not part of any package.
10 ;; This program 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)
15 ;; This program 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.
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.
31 (defun bitmap-stipple-xbm-file-to-stipple (file)
32 "Convert xbm FILE into icon format and return the list of spec and buffers."
35 (let ((case-fold-search t) width height xbytes right margin)
36 (insert-file-contents file)
37 (goto-char (point-min))
38 (or (re-search-forward "_width[\t ]+\\([0-9]+\\)" nil t)
39 (error "!! Illegal xbm file format" (current-buffer)))
40 (setq width (string-to-int (match-string 1))
41 xbytes (/ (+ width 7) 8))
42 (goto-char (point-min))
43 (or (re-search-forward "_height[\t ]+\\([0-9]+\\)" nil t)
44 (error "!! Illegal xbm file format" (current-buffer)))
45 (setq height (string-to-int (match-string 1)))
47 (goto-char (point-min))
48 (re-search-forward "0x[0-9a-f][0-9a-f],")
49 (delete-region (point-min) (match-beginning 0))
51 (goto-char (point-min))
52 (while (re-search-forward "[\n\r\t ,;}]" nil t)
54 (goto-char (point-min))
55 (while (re-search-forward "0x" nil t)
56 (replace-match "\\x" nil t))
57 (goto-char (point-min))
58 (insert "(" (number-to-string width) " " (number-to-string height) " \"")
59 (goto-char (point-max))
61 (goto-char (point-min))
62 (read (current-buffer)))))
64 (defun bitmap-stipple-insert-pixmap (pixmap &optional center)
65 "Insert PIXMAP in the current buffer.
66 Optional argument CENTER specified, pixmap will be centered."
67 (let (width height beg i)
68 (or (facep 'bitmap-stipple-splash)
69 (make-face 'bitmap-stipple-splash))
70 (setq width (/ (car pixmap) (frame-char-width))
71 height (/ (cadr pixmap) (frame-char-height)))
72 (set-face-foreground 'bitmap-stipple-splash "red")
73 (set-face-stipple 'bitmap-stipple-splash pixmap)
74 (if center (insert-char ?\n height))
79 (set-text-properties beg (point) '(face bitmap-stipple-splash))
84 (defun bitmap-stipple-insert-xbm-file (file)
85 "Insert xbm FILE at point."
86 (interactive "fxbm file: ")
88 (bitmap-stipple-insert-pixmap
89 (bitmap-stipple-xbm-file-to-stipple file))))
91 (provide 'bitmap-stipple)
93 ;;; bitmap-stipple.el ends here