;;; bitmap-stipple.el --- display bitmap file using stipple.
;; Copyright (C) 1998-2000 Daiki Ueno

;; Author: Daiki Ueno <ueno@unixuser.org>
;; Created: 1999-05-30
;; Keywords: bitmap, stipple

;; This file is not part of any package.

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.


;;; Commentary:
;; 

;;; Code:

(defun bitmap-stipple-xbm-file-to-stipple (file)
  "Convert xbm FILE into icon format and return the list of spec and buffers."
  (with-temp-buffer
    (erase-buffer)
    (let ((case-fold-search t) width height xbytes right margin)
      (insert-file-contents file)
      (goto-char (point-min))
      (or (re-search-forward "_width[\t ]+\\([0-9]+\\)" nil t)
	  (error "!! Illegal xbm file format" (current-buffer)))
      (setq width (string-to-int (match-string 1))
	    xbytes (/ (+ width 7) 8))
      (goto-char (point-min))
      (or (re-search-forward "_height[\t ]+\\([0-9]+\\)" nil t)
	  (error "!! Illegal xbm file format" (current-buffer)))
      (setq height (string-to-int (match-string 1)))

      (goto-char (point-min))
      (re-search-forward "0x[0-9a-f][0-9a-f],")
      (delete-region (point-min) (match-beginning 0))

      (goto-char (point-min))
      (while (re-search-forward "[\n\r\t ,;}]" nil t)
	(replace-match ""))
      (goto-char (point-min))
      (while (re-search-forward "0x" nil t)
	(replace-match "\\x" nil t))
      (goto-char (point-min))
      (insert "(" (number-to-string width) " " (number-to-string height) " \"")
      (goto-char (point-max))
      (insert "\")")
      (goto-char (point-min))
      (read (current-buffer)))))

(defun bitmap-stipple-insert-pixmap (pixmap &optional center)
  "Insert PIXMAP in the current buffer.
Optional argument CENTER specified, pixmap will be centered."
  (let (width height beg i)
    (or (facep 'bitmap-stipple-splash)
	(make-face 'bitmap-stipple-splash))
    (setq width (/ (car pixmap) (frame-char-width))
	  height (/ (cadr pixmap) (frame-char-height)))
    (set-face-foreground 'bitmap-stipple-splash "red")
    (set-face-stipple 'bitmap-stipple-splash pixmap)
    (if center (insert-char ?\n height))
    (setq i height)
    (while (> i 0)
      (setq beg (point))
      (insert-char ?  width)
      (set-text-properties beg (point) '(face bitmap-stipple-splash))
      (insert "\n")
      (decf i))))
  
;;;###autoload
(defun bitmap-stipple-insert-xbm-file (file)
  "Insert xbm FILE at point."
  (interactive "fxbm file: ")
  (save-excursion
    (bitmap-stipple-insert-pixmap
     (bitmap-stipple-xbm-file-to-stipple file))))

(provide 'bitmap-stipple)

;;; bitmap-stipple.el ends here