1 ;;; xbm-thumb.el --- create XBM thumbnail under Emacs.
2 ;; Copyright (C) 2000 Daiki Ueno
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
6 ;; Keywords: xbm, image
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 (defvar xbm-thumb-dot-threshold 1)
33 (defun xbm-thumb-fold-left (function accu sequence)
34 (if (null sequence) accu
36 function (funcall function accu (car sequence))
39 (defun xbm-thumb-aggregate-block (b1 b2)
40 (let ((idx 128) (result 0))
43 (logior (lsh result 1)
44 (if (< xbm-thumb-dot-threshold
48 (logand b1 (lsh idx -1))
50 (logand b2 (lsh idx -1)))))
55 (defun xbm-thumb-aggregate-row (row)
56 (let ((len (/ (length row) 2))
61 (format "%s\\x%02x" result
63 (lsh (xbm-thumb-aggregate-block
64 (aref row (1+ i)) (aref row (+ i 1 len))) 4)
65 (xbm-thumb-aggregate-block
66 (aref row i) (aref row (+ i len)))))
71 (defun xbm-make-thumbnail (data)
72 "Create XBM thumbnail."
73 (let* ((string (nth 2 data))
75 (width (/ (car data) 8))
81 (xbm-thumb-aggregate-row
82 (substring string i (setq i (+ i (* 2 width))))))))
84 (/ (car data) 2) (/ (nth 1 data) 2)
85 (car (read-from-string (concat "\"" result "\""))))))
89 ;;; xbm-thumb.el ends here