(uncompface): Make buffer, in which uncompface program runs, unibyte.
[gnus] / contrib / compface.el
1 ;;; compface.el --- functions for converting X-Face headers
2 ;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
3
4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
5 ;;      TAKAI Kousuke <tak@kmc.gr.jp>
6 ;; Keywords: news
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 3, 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., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301, USA.
24
25 ;;; Commentary:
26
27 ;;; Code:
28
29 (defgroup compface nil
30   "X-Face image conversion."
31   :group 'extensions)
32
33 (defcustom uncompface-use-external (and (not noninteractive)
34                                         (executable-find "uncompface")
35                                         (executable-find "icontopbm")
36                                         'undecided)
37   "*Specify which of the internal or the external decoder should be used.
38 nil means to use the internal ELisp-based uncompface program.  t means
39 to use the external decoder.  In the later case, you need to have the
40 external `uncompface' and `icontopbm' programs installed.  The default
41 value is nil if those external programs aren't available, otherwise
42 `undecided' which means to determine it by checking whether the host
43 machine is slow.  See also `uncompface-use-external-threshold'.  You
44 can skip that check by setting this value as nil or t explicitly."
45   :type '(choice (const :tag "Use the internal decoder" nil)
46                  (const :tag "Use the external decoder" t)
47                  (const :tag "Autodetection" undecided))
48   :group 'compface)
49
50 (defcustom uncompface-use-external-threshold 0.1
51   "*Number of seconds to check whether the host machine is slow.
52 If the host takes time larger than this value for decoding an X-Face
53 using the internal ELisp-based uncompface program, it will be changed
54 to using the external `uncompface' and `icontopbm' programs if they
55 are available.  Note that the measurement may never be exact."
56   :type 'number
57   :group 'compface)
58
59 (eval-when-compile
60   (defmacro uncompface-float-time (&optional specified-time)
61     (if (fboundp 'float-time)
62         `(float-time ,specified-time)
63       `(let ((time (or ,specified-time (current-time))))
64          (+ (* (car time) 65536.0)
65             (cadr time)
66             (cond ((consp (setq time (cddr time)))
67                    (/ (car time) 1000000.0))
68                   (time
69                    (/ time 1000000.0))
70                   (t
71                    0)))))))
72
73 (defun uncompface (face)
74   "Convert FACE to pbm.
75 If `uncompface-use-external' is t, it requires the external programs
76 `uncompface', and `icontopbm'.  On a GNU/Linux system these might be
77 in packages with names like `compface' or `faces-xface' and `netpbm'
78 or `libgr-progs', for instance."
79   (cond ((eq uncompface-use-external nil)
80          (uncompface-internal face))
81         ((eq uncompface-use-external t)
82          (with-temp-buffer
83            (unless (featurep 'xemacs) (set-buffer-multibyte nil))
84            (insert face)
85            (let ((coding-system-for-read 'raw-text)
86                  ;; At least "icontopbm" doesn't work with Windows because
87                  ;; the line-break code is converted into CRLF by default.
88                  (coding-system-for-write 'binary))
89              (and (eq 0 (apply 'call-process-region (point-min) (point-max)
90                                "uncompface"
91                                'delete '(t nil) nil))
92                   (progn
93                     (goto-char (point-min))
94                     (insert "/* Width=48, Height=48 */\n")
95                     ;; I just can't get "icontopbm" to work correctly on its
96                     ;; own in XEmacs.  And Emacs doesn't understand un-raw pbm
97                     ;; files.
98                     (if (not (featurep 'xemacs))
99                         (eq 0 (call-process-region (point-min) (point-max)
100                                                    "icontopbm"
101                                                    'delete '(t nil)))
102                       (shell-command-on-region (point-min) (point-max)
103                                                "icontopbm | pnmnoraw"
104                                                (current-buffer) t)
105                       t))
106                   (buffer-string)))))
107         (t
108          (let* ((gc-cons-threshold (eval '(lsh -1 -1)))
109                 (start (current-time)))
110            (prog1
111                (uncompface-internal face)
112              (setq uncompface-use-external
113                    (and (> (- (uncompface-float-time (current-time))
114                               (uncompface-float-time start))
115                            uncompface-use-external-threshold)
116                         (executable-find "uncompface")
117                         (executable-find "icontopbm")
118                         t))
119              (message "Setting `uncompface-use-external' to `%s'"
120                       uncompface-use-external))))))
121
122 ;; The following section is a bug-for-bug compatible version of
123 ;; `uncompface' program entirely implemented in Emacs-Lisp.
124
125 (eval-when-compile
126   ;; The size of 48x48 is actually hard-coded into the code itself,
127   ;; so you cannot simply change those values.  So we hard-code
128   ;; them into the compiled code.
129   (defconst uncompface-width 48
130     "Width of X-Face bitmap image.")
131   (defconst uncompface-height 48
132     "Height of X-Face bitmap image.")
133
134   ;; Again, this is also hard-coded into the compiled code.
135   (defconst uncompface-guesses
136     (mapcar (lambda (x)
137               (mapcar (lambda (x)
138                         (let ((vector (make-vector (length x) nil))
139                               (i 0))
140                           (while x
141                             (or (zerop (car x))
142                                 (aset vector i t))
143                             (setq x (cdr x)
144                                   i (1+ i)))
145                           vector))
146                       x))
147             '((;; g_00
148                (0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
149                 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 1
150                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
151                 1 1 1 0 0 0 1 1 1 1 0 1 1 1 1 1
152                 0 0 0 0 0 1 0 1 0 0 0 1 0 1 1 1
153                 0 0 0 0 0 1 0 1 0 0 0 0 1 1 1 1
154                 0 0 0 0 0 0 0 0 0 0 0 1 1 0 1 1
155                 0 0 0 0 1 1 1 1 1 1 0 1 1 1 1 1
156                 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0
157                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
158                 0 0 0 0 1 1 0 1 0 0 0 0 1 1 1 1
159                 0 0 0 0 0 0 1 1 0 1 1 1 1 1 1 1
160                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
161                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1
162                 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 1
163                 0 1 0 0 0 1 0 1 0 0 1 0 1 1 1 1
164                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
165                 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 1
166                 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 0
167                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
168                 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0
169                 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1
170                 0 0 0 0 0 0 0 1 0 0 1 1 1 1 1 1
171                 1 1 0 0 1 1 1 1 1 1 1 1 1 1 1 1
172                 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 1
173                 1 0 0 0 0 0 0 0 1 1 0 0 1 0 0 1
174                 0 0 0 0 1 1 1 1 0 0 0 0 1 1 1 1
175                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
176                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
177                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
178                 0 0 0 1 1 0 1 1 0 0 0 1 1 1 1 1
179                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
180                 0 1 0 0 1 1 1 1 0 1 0 1 0 1 0 0
181                 0 0 0 0 0 1 1 1 0 0 0 1 1 1 1 1
182                 0 1 0 1 0 1 1 1 0 1 0 0 0 1 1 1
183                 1 1 0 1 0 1 1 1 0 0 1 1 1 1 0 1
184                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
185                 0 1 0 1 1 1 1 1 0 0 0 1 1 1 1 1
186                 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
187                 0 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1
188                 0 0 0 0 0 1 0 1 0 0 0 0 1 1 1 1
189                 0 0 0 0 0 0 0 1 0 0 0 0 1 1 1 1
190                 0 0 0 0 1 1 1 1 0 1 0 1 1 1 1 1
191                 1 0 0 1 1 0 1 1 1 1 0 1 1 1 1 1
192                 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
193                 0 1 0 1 1 1 1 1 0 0 0 1 1 1 0 1
194                 0 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1
195                 0 0 0 0 1 1 1 1 0 0 0 1 1 1 1 1
196                 0 0 0 0 1 1 1 1 0 1 0 1 1 1 1 1
197                 0 0 0 0 0 0 1 1 0 0 0 1 1 1 1 1
198                 0 1 0 0 1 1 1 1 0 1 0 1 1 1 1 1
199                 1 1 1 1 0 1 1 1 0 1 1 1 1 1 1 1
200                 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
201                 0 0 0 0 1 1 0 1 0 0 0 0 1 1 1 1
202                 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1
203                 1 1 1 1 0 1 1 1 1 0 1 1 1 1 1 1
204                 0 0 0 0 1 1 1 1 0 1 0 0 1 1 1 1
205                 1 1 0 1 0 1 1 1 0 0 1 1 1 1 1 1
206                 0 1 0 0 1 1 1 1 0 1 1 1 1 1 1 1
207                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
208                 0 1 1 0 0 1 1 1 1 0 1 1 1 1 1 1
209                 0 1 0 1 0 1 1 0 0 0 1 0 0 1 0 1
210                 0 0 0 1 1 1 1 1 0 1 1 1 1 1 1 1
211                 1 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1
212                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
213                 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1
214                 0 1 0 1 1 1 1 1 0 1 1 1 1 1 1 1
215                 0 0 0 0 0 0 0 1 1 1 0 1 1 1 1 1
216                 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 0
217                 0 0 0 0 0 1 0 1 0 0 0 0 1 1 1 1
218                 0 0 0 0 0 1 1 1 1 0 1 0 0 0 1 0
219                 0 0 0 0 1 0 0 1 0 0 0 0 1 1 1 1
220                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
221                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
222                 0 0 0 0 1 1 1 1 0 1 0 1 1 1 1 1
223                 0 0 0 1 1 0 0 0 1 1 0 1 0 1 1 1
224                 1 0 0 1 0 1 0 0 0 1 1 1 0 0 0 1
225                 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1
226                 0 0 0 1 1 1 1 1 1 0 1 1 0 1 1 1
227                 0 0 0 0 1 1 0 0 0 0 0 0 0 1 1 1
228                 0 0 0 0 1 1 1 1 0 0 0 0 1 1 1 1
229                 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1
230                 0 0 0 0 1 1 1 1 0 0 0 1 1 1 1 1
231                 1 0 0 0 0 1 0 0 1 0 0 0 1 1 1 1
232                 0 0 0 0 0 1 0 1 0 0 0 1 0 1 0 1
233                 0 0 0 0 0 1 0 1 0 0 0 0 1 1 1 1
234                 0 1 0 0 1 1 1 1 1 1 1 1 1 1 1 1
235                 1 0 0 0 0 1 1 1 1 1 0 1 1 1 1 1
236                 0 0 0 0 0 1 0 1 0 0 0 0 0 0 0 1
237                 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0
238                 0 0 0 0 1 1 1 1 0 0 0 0 1 1 1 1
239                 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0
240                 0 0 0 0 0 1 0 1 0 0 0 0 0 1 0 0
241                 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 1
242                 0 1 0 0 1 1 1 1 1 1 1 1 1 1 1 1
243                 1 0 0 1 1 1 1 1 1 0 0 0 1 1 1 1
244                 0 1 0 0 1 0 1 0 0 1 0 0 0 0 0 0
245                 0 1 0 1 1 1 1 1 0 1 0 1 1 1 1 1
246                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0
247                 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1
248                 0 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1
249                 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1
250                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
251                 0 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1
252                 0 0 0 0 1 1 1 1 1 1 1 1 1 1 0 1
253                 1 1 0 1 0 1 1 1 0 1 0 1 1 1 1 1
254                 0 1 0 0 1 1 1 1 0 1 1 1 1 1 1 1
255                 0 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1
256                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
257                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
258                 1 1 1 1 1 1 1 1 0 1 1 1 0 1 1 1
259                 1 1 0 1 1 1 1 1 0 1 1 1 1 1 1 1
260                 0 1 0 0 1 1 1 1 1 1 1 0 1 1 1 1
261                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
262                 0 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1
263                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
264                 0 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1
265                 0 0 0 0 1 1 1 1 0 1 0 0 1 1 1 1
266                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
267                 1 0 0 1 1 1 0 1 1 1 1 1 1 1 1 1
268                 0 0 0 0 1 1 1 1 1 1 1 0 1 1 1 1
269                 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1
270                 0 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1
271                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
272                 0 1 0 0 1 1 1 1 1 1 1 1 1 1 1 1
273                 1 1 0 0 1 1 0 1 0 0 0 0 1 1 1 1
274                 0 1 0 0 1 1 1 1 1 1 1 1 1 1 1 1
275                 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1
276                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
277                 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 1
278                 0 0 0 0 0 1 0 1 0 0 0 0 0 0 1 0
279                 0 0 0 0 0 0 1 0 0 0 0 0 1 1 1 1
280                 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0
281                 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0
282                 0 0 0 0 0 0 0 1 0 0 0 0 0 1 1 0
283                 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1
284                 0 0 1 0 0 0 0 0 0 0 0 0 0 0 1 1
285                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
286                 0 0 0 0 0 1 0 1 0 0 0 0 1 1 1 1
287                 0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 0
288                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
289                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1
290                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1
291                 0 0 0 0 1 1 0 0 0 0 0 0 1 1 1 1
292                 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0
293                 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
294                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
295                 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
296                 0 0 0 0 0 0 0 0 0 0 0 1 0 1 0 0
297                 0 0 0 0 0 0 0 1 0 0 0 0 0 1 0 1
298                 0 0 0 0 0 0 0 1 0 0 0 1 0 1 0 1
299                 1 0 1 0 1 1 1 1 0 0 0 0 1 1 1 1
300                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1
301                 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0
302                 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0
303                 0 1 0 0 0 1 1 0 0 0 0 0 1 1 0 0
304                 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0
305                 1 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0
306                 0 0 0 0 1 1 1 1 0 0 0 1 0 1 0 1
307                 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1
308                 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0
309                 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1
310                 0 1 1 1 1 1 1 1 0 1 0 1 1 1 1 1
311                 1 1 0 1 1 0 1 1 1 1 1 1 1 1 1 1
312                 0 1 0 0 1 1 1 1 0 0 1 1 1 1 1 0
313                 0 0 0 0 0 1 0 1 0 0 0 0 1 1 1 1
314                 0 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1
315                 1 0 0 1 0 1 0 1 0 1 0 0 1 1 1 1
316                 0 0 0 0 1 1 0 1 0 0 0 0 1 1 1 1
317                 0 0 0 0 0 0 0 1 0 0 0 0 1 1 1 1
318                 0 1 0 0 1 1 1 1 0 1 0 1 1 1 1 1
319                 1 0 0 1 1 1 1 1 1 1 0 1 1 1 1 1
320                 0 0 1 0 0 1 0 1 0 0 0 0 1 1 1 0
321                 0 0 0 0 1 1 0 1 0 0 0 0 1 1 0 1
322                 0 1 0 0 1 1 1 1 0 1 1 1 1 1 1 1
323                 1 0 0 0 1 1 1 1 0 0 0 0 1 1 1 1
324                 0 0 0 0 1 1 1 1 1 1 1 1 1 0 1 0
325                 0 0 0 0 0 1 0 0 0 1 0 0 1 1 1 1
326                 0 1 0 0 1 1 1 1 1 1 1 1 1 1 1 1
327                 1 1 1 1 0 1 1 1 0 1 1 1 0 1 1 1
328                 0 1 0 0 0 1 1 1 1 1 1 0 1 1 0 1
329                 0 0 0 0 0 1 0 1 0 0 0 0 1 1 1 1
330                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
331                 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1
332                 0 1 0 0 1 1 1 1 0 1 1 0 1 1 1 1
333                 1 1 0 1 1 0 0 0 0 1 0 1 1 1 1 1
334                 0 0 0 0 1 1 1 1 0 1 1 1 1 1 1 1
335                 1 1 0 1 1 1 1 1 0 1 0 1 1 1 1 1
336                 0 0 0 0 0 1 1 1 0 0 0 0 1 1 1 1
337                 1 0 0 1 0 1 0 0 0 0 0 0 1 1 0 1
338                 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1
339                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
340                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0
341                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1
342                 0 1 0 0 0 1 1 0 0 1 0 1 0 1 1 1
343                 0 0 0 0 0 0 0 1 0 0 0 0 1 1 0 1
344                 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0
345                 0 0 0 0 0 0 0 1 0 0 0 0 1 1 1 1
346                 0 1 0 0 0 1 1 1 0 1 1 0 1 1 0 0
347                 0 0 0 0 1 1 0 1 0 0 0 0 1 1 1 1
348                 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0
349                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
350                 0 0 0 0 1 0 1 1 0 1 0 0 1 1 1 1
351                 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0
352                 0 0 0 0 0 1 0 1 0 0 0 0 0 0 0 0
353                 1 0 0 1 0 1 0 1 0 0 0 0 0 0 0 1
354                 0 0 0 0 1 1 1 1 0 1 1 1 1 1 1 1
355                 0 0 0 0 1 1 0 0 0 0 0 0 1 1 1 1
356                 0 0 0 0 0 0 0 1 0 0 0 0 1 1 1 0
357                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
358                 0 0 0 0 1 1 1 1 0 1 0 0 0 0 0 1
359                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
360                 0 0 0 0 0 1 0 0 0 0 1 0 0 1 0 0
361                 0 0 0 0 1 1 0 1 0 0 0 0 1 1 1 1
362                 0 0 0 0 1 1 1 1 0 1 1 1 1 1 1 1
363                 1 1 0 0 1 1 1 1 1 1 0 1 1 1 1 1
364                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
365                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
366                 0 0 0 0 0 1 0 0 0 1 0 0 0 0 0 0
367                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
368                 0 0 0 0 0 1 1 0 0 0 1 0 0 1 1 0
369                 1 1 0 0 1 1 1 1 0 0 0 0 0 1 0 1
370                 1 1 0 0 1 1 1 1 0 1 1 1 1 1 1 1
371                 1 1 0 1 1 1 1 1 1 1 0 1 1 1 1 1
372                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
373                 0 0 0 1 0 1 1 1 0 1 0 1 1 1 1 1
374                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1
375                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
376                 0 1 0 0 0 1 1 0 0 0 0 0 1 0 0 1
377                 0 1 0 0 1 1 1 1 0 1 0 1 1 1 1 1
378                 0 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1
379                 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1
380                 0 0 0 0 1 0 1 0 1 0 0 0 1 0 0 0
381                 1 0 1 0 0 1 1 1 0 1 1 1 1 1 1 1
382                 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
383                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
384                 0 0 0 0 1 1 1 1 0 0 0 0 0 1 0 0
385                 1 1 0 1 1 1 1 1 0 1 1 1 1 1 1 1
386                 0 1 0 0 1 1 1 1 1 1 1 1 1 1 1 1
387                 1 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1
388                 0 0 0 0 1 1 1 0 1 1 1 0 0 1 1 0
389                 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1
390                 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
391                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
392                 0 0 0 0 1 1 1 1 1 1 1 0 1 1 0 0
393                 1 0 0 0 1 1 1 1 0 1 0 0 1 1 1 1
394                 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
395                 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1
396                 0 0 0 0 1 1 1 1 1 1 0 0 1 1 1 1
397                 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1
398                 0 1 1 0 1 1 1 1 0 1 1 1 1 1 1 1
399                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
400                 0 0 0 0 0 0 1 1 0 0 0 0 1 1 0 0
401                 1 0 0 1 1 1 0 1 0 0 0 0 1 1 1 1
402                 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
403                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
404                ;; g_10
405                (0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
406                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
407                 0 1 0 1 0 0 0 0 0 0 0 0 0 0 0 0
408                 1 1 1 1 0 0 1 1 0 1 0 1 1 1 1 1
409                 1 0 0 0 0 1 0 0 0 0 0 0 0 1 0 0
410                 0 0 0 1 0 1 1 1 1 0 0 1 1 1 1 1
411                 0 0 0 0 0 1 0 0 0 0 1 0 0 0 1 1
412                 0 0 0 0 0 1 0 1 1 1 1 1 1 1 1 1
413                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
414                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0
415                 0 0 0 0 0 0 1 1 0 0 0 0 0 0 1 1
416                 0 0 1 1 0 0 1 1 1 1 0 1 0 1 1 1
417                 0 0 0 0 0 1 0 1 0 0 0 0 0 0 1 1
418                 0 1 0 1 1 1 1 1 0 0 1 1 1 1 1 1
419                 0 0 0 1 0 1 1 1 0 0 1 1 0 0 1 1
420                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
421                 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0
422                 0 0 0 0 0 0 1 0 0 0 0 0 0 1 0 0
423                 0 0 0 1 0 0 1 0 0 0 0 0 0 0 0 0
424                 0 0 0 1 0 0 0 1 0 1 0 1 0 1 1 1
425                 0 0 0 0 0 1 0 1 0 0 1 0 0 1 0 1
426                 0 0 0 0 0 1 0 1 0 0 0 0 0 0 1 1
427                 0 0 1 1 0 1 0 1 1 0 1 1 1 1 1 1
428                 1 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1
429                 0 0 0 0 0 1 1 1 0 1 1 0 1 1 1 1
430                 0 0 1 0 0 0 0 0 0 1 0 0 0 0 0 0
431                 0 0 0 1 0 1 1 1 0 0 0 0 0 1 1 0
432                 1 1 1 1 1 0 1 0 1 1 1 0 1 0 0 0
433                 0 0 0 0 0 0 0 1 0 0 0 0 0 1 1 1
434                 0 0 0 1 1 1 1 1 1 0 0 1 1 1 1 1
435                 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1
436                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
437                ;; g_20
438                (0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0
439                 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 1
440                 0 1 0 0 0 0 1 1 0 0 1 0 1 1 1 0
441                 1 1 1 1 1 1 1 1 0 0 1 1 1 1 1 1)
442                ;; g_40
443                (0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1
444                 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 1
445                 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 1
446                 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 1
447                 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1
448                 0 0 0 0 0 0 0 0 0 1 0 0 1 1 1 0
449                 1 1 1 0 0 1 0 0 0 0 0 0 1 1 0 1
450                 0 0 0 1 0 0 0 0 0 0 0 0 1 1 1 1
451                 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1
452                 0 1 0 0 0 1 0 0 0 1 0 0 1 1 1 1
453                 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 0
454                 0 0 0 0 1 1 1 1 0 0 0 0 1 1 1 1
455                 1 0 1 0 1 1 1 0 1 0 1 0 1 1 1 1
456                 0 1 0 0 0 1 0 1 0 1 1 1 1 1 1 1
457                 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1
458                 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1
459                 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 1
460                 0 0 0 0 0 0 0 1 0 0 0 1 0 0 0 1
461                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1
462                 0 0 0 1 1 1 0 0 1 1 0 1 1 1 0 1
463                 0 0 0 0 0 0 0 0 0 0 0 1 0 1 0 1
464                 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1
465                 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0
466                 0 0 0 0 0 0 0 0 1 1 1 1 1 1 0 1
467                 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1
468                 0 1 0 0 1 1 1 1 0 1 0 1 1 1 1 1
469                 0 0 1 1 1 1 0 1 1 1 1 1 1 1 1 1
470                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
471                 0 1 0 0 1 1 1 1 1 1 1 1 1 1 1 1
472                 0 0 0 1 1 1 0 0 1 1 1 1 1 1 1 1
473                 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1
474                 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1
475                 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 1
476                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
477                 0 0 0 0 0 0 0 0 0 0 0 1 0 1 0 1
478                 0 0 0 0 0 0 0 1 0 0 0 0 0 1 1 1
479                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1
480                 0 0 0 0 0 0 1 0 0 0 0 1 1 1 1 1
481                 0 0 0 0 0 0 0 1 0 0 0 1 0 0 0 1
482                 0 0 0 0 0 1 0 1 0 1 1 1 1 1 1 1
483                 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1
484                 0 1 0 0 0 0 0 1 0 1 0 1 0 1 1 1
485                 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1
486                 0 0 0 0 0 1 0 1 0 1 1 1 0 1 1 1
487                 0 0 0 0 1 1 0 1 0 1 0 1 1 1 1 1
488                 0 1 0 0 1 1 0 1 1 1 1 1 1 1 1 1
489                 0 1 0 0 1 1 1 1 1 1 1 1 1 1 1 1
490                 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1
491                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
492                 0 0 0 0 0 0 1 0 0 0 0 0 0 1 0 1
493                 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 1
494                 0 0 0 0 0 1 0 1 0 1 1 1 1 1 0 1
495                 0 0 0 1 0 0 0 0 0 0 0 1 0 1 0 1
496                 0 0 1 0 1 1 1 1 1 1 1 1 1 1 1 1
497                 0 1 0 0 0 0 0 0 0 1 0 1 0 0 0 0
498                 0 0 0 0 1 1 0 1 1 1 1 1 1 1 0 1
499                 0 0 0 0 0 1 0 0 0 0 0 0 1 1 1 1
500                 0 0 0 0 0 1 1 1 0 0 0 1 1 1 1 1
501                 0 0 0 0 0 1 1 1 0 1 1 1 1 1 1 1
502                 0 0 0 0 1 1 1 1 1 0 1 1 1 1 1 1
503                 0 0 0 0 1 1 0 1 0 1 1 1 1 1 1 1
504                 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1
505                 0 1 0 0 1 1 0 1 0 1 1 1 1 1 0 1
506                 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1))
507               (;; g_01
508                (0 0 1 1 0 1 1 1 0 1 1 1 0 0 1 1
509                 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 1
510                 0 1 0 1 0 1 1 1 0 1 1 1 1 1 1 1
511                 1 1 1 1 0 1 0 1 1 1 1 1 1 0 1 1
512                 0 1 1 1 0 0 0 0 0 0 1 1 0 0 1 1
513                 1 1 1 1 0 0 0 0 1 1 1 1 1 0 0 1
514                 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
515                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
516                ;; g_11
517                (0 0 0 0 0 0 0 1 0 0 0 1 0 0 1 1
518                 0 0 0 0 0 0 1 1 0 1 1 1 1 1 1 1)
519                ;; g_21
520                (0 0 0 1 0 1 1 1)
521                ;; g_41
522                (0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 1
523                 0 0 0 0 0 0 0 1 0 0 0 1 1 1 1 1
524                 0 0 0 0 0 0 1 1 0 0 0 1 1 1 1 1
525                 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1))
526               (;; g_02
527                (0 1 0 1)
528                ;; g_12
529                (0 1)
530                ;; g_22
531                (0)
532                ;; g_42
533                (0 0 0 1))))
534     "Static prediction table for X-Face image compression algorithm.")
535
536   ;; Macros for inlining critical values. 
537   (defmacro uncompface-width () (list 'quote uncompface-width))
538   (defmacro uncompface-height () (list 'quote uncompface-height))
539   (defmacro uncompface-guesses () (list 'quote uncompface-guesses))
540
541   (defmacro uncompface-loop (&rest body)
542     "Eval BODY and repeat if last expression of BODY yields non-nil."
543     (list 'while (cons 'progn body))))
544
545 ;; (defun uncompface-print-bignum (bignum &optional prefix)
546 ;;   (princ (format (concat prefix "<%s>\n")
547 ;;               (mapconcat (lambda (x) (format "%02x" x))
548 ;;                          (reverse bignum) " "))))
549
550 ;; Shut up the byte-compiler.
551 ;; These variables are once bound in `uncompface' and all subfunctions
552 ;; accesses them directly rather than creating their own bindings.
553 (eval-when-compile
554   (defvar bignum)
555   (defvar face))
556
557 ;; Big-number facilities.
558 ;; These functions were used to be implemented with `lsh' and `logand',
559 ;; but rewritten to use `/' and `%'.  The last two are mapped into
560 ;; byte-code directly, but the formers are normal functions even in
561 ;; compiled code which involve expensive `funcall' operations.
562 (eval-when-compile
563   (defsubst uncompface-big-mul-add (multiplier adder)
564     "Multiply BIGNUM by MULTIPLIER and add ADDER and put result in `bignum'."
565     (setq bignum (if (= multiplier 0)
566                      (cons 0 bignum)
567                    (prog1 bignum
568                      (while (progn
569                               (setcar bignum (% (setq adder (+ (* (car bignum)
570                                                                   multiplier)
571                                                                adder))
572                                                 256))
573                               (setq adder (/ adder 256))
574                               (cdr bignum))
575                        (setq bignum (cdr bignum)))
576                      (or (= adder 0)
577                          (setcdr bignum (list adder))))))))
578
579 ;; This trick is for XEmacs 21.4 which doesn't allow inlining a function
580 ;; using `defsubst' into another function also defined with `defsubst'.
581 (eval-when-compile
582   (when (featurep 'xemacs)
583     (defvar uncompface-big-mul-add (symbol-function 'uncompface-big-mul-add))
584     (defmacro uncompface-big-mul-add (multiplier adder)
585       `(,uncompface-big-mul-add ,multiplier ,adder))))
586
587 ;; Separate `eval-when-compile' for the byte compiler
588 ;; to properly define `uncompface-big-mul-add' before `uncompface-big-pop'.
589 (eval-when-compile
590   (defsubst uncompface-big-pop (prob)
591     (let ((n (car bignum)) (i 0))
592       (if (cdr bignum)
593           (setq bignum (cdr bignum))
594         (setcar bignum 0))
595       (while (or (< n (cdr (car prob)))
596                  (>= n (+ (cdr (car prob)) (car (car prob)))))
597         (setq prob (cdr prob)
598               i (1+ i)))
599       (uncompface-big-mul-add (car (car prob)) (- n (cdr (car prob))))
600       i)))
601
602 ;; This function cannot be inlined due to recursive calls.
603 (defun uncompface-pop-grays (offset size)
604   (if (<= size 3)
605       (let ((bits (uncompface-big-pop
606                    ;; This is freqs[16] in compface_private.h.
607                    '(( 0 .   0) (38 .   0) (38 .  38) (13 . 152)
608                      (38 .  76) (13 . 165) (13 . 178) ( 6 . 230)
609                      (38 . 114) (13 . 191) (13 . 204) ( 6 . 236)
610                      (13 . 217) ( 6 . 242) ( 5 . 248) ( 3 . 253)))))
611 ;;      (if (/= (logand bits 1) 0)
612 ;;          (aset face offset t))
613 ;;      (if (/= (logand bits 2) 0)
614 ;;          (aset face (1+ offset) t))
615 ;;      (if (/= (logand bits 4) 0)
616 ;;          (aset face (+ offset (uncompface-width)) t))
617 ;;      (if (/= (logand bits 8) 0)
618 ;;          (aset face (+ offset (uncompface-width) 1) t))
619         (when (>= bits 8)
620           (aset face (+ offset (uncompface-width) 1) t)
621           (setq bits (- bits 8)))
622         (when (>= bits 4)
623           (aset face (+ offset (uncompface-width)) t)
624           (setq bits (- bits 4)))
625         (or (eq (if (< bits 2)
626                     bits
627                   (aset face (1+ offset) t)
628                   (- bits 2))
629                 0)
630             (aset face offset t))
631         )
632     (setq size (/ size 2))
633     (uncompface-pop-grays offset size)
634     (uncompface-pop-grays (+ offset size) size)
635     (uncompface-pop-grays (+ offset (* (uncompface-width) size)) size)
636     (uncompface-pop-grays (+ offset (* (uncompface-width) size) size) size)))
637
638 ;; Again, this function call itself recursively.
639 (defun uncompface-uncompress (offset size level)
640   ;; This used to be (funcall (aref [(lambda ...) ...] (u-big-pop ...)))
641   ;; but this was slow due to function call.
642   (let ((i (uncompface-big-pop (car level))))
643     (cond ((eq i 0)                     ; black
644            (uncompface-pop-grays offset size))
645           ((eq i 1)                     ; gray
646            (setq size (/ size 2)
647                  level (cdr level))
648            (uncompface-uncompress offset size level)
649            (uncompface-uncompress (+ offset size) size level)
650            (uncompface-uncompress (+ offset (* size (uncompface-width)))
651                                   size level)
652            (uncompface-uncompress (+ offset (* size (uncompface-width)) size)
653                                   size level))
654           ;; ((eq i 2) nil)
655           ;; (t (error "Cannot happen"))
656           )))
657
658 (eval-when-compile
659   (defmacro uncompface-shift-in (k dy dx)
660     `(+ k k (if (aref face (+ i (* ,dy (uncompface-width)) ,dx)) 1 0))))
661
662 (defun uncompface-internal (string &optional raw)
663   "Decode X-Face data STRING and return an image in the pbm format.
664 If the optional RAW is non-nil, return a raw bitmap as a vector."
665   (let (;; `bignum' and `face' are semi-global variables.
666         ;; Do not use '(0) below, because BIGNUM is modified in-place.
667         (bignum (list 0))
668         (face (make-vector (* (uncompface-width) (uncompface-height)) nil))
669         ;;(uncompface-big-shift -16)
670         ;;(uncompface-big-mask 65535)
671         (y 0) x)
672     (mapc (lambda (c)
673             (and (>= c ?!) (<= c ?~)
674                  (uncompface-big-mul-add (1+ (- ?~ ?!)) (- c ?!))))
675           string)
676     ;;(uncompface-print-bignum bignum)
677     ;;(setq y 0)
678     (uncompface-loop
679       (setq x 0)
680       (uncompface-loop
681         (uncompface-uncompress (+ (* (uncompface-width) y) x) 16
682                                ;; This is levels[4][3] in compface_private.h.
683                                '(;; Top of tree almost always grey
684                                  ((  1 . 255) (251 .   0) (  4 . 251))
685                                  ((  1 . 255) (200 .   0) ( 55 . 200))
686                                  (( 33 . 223) (159 .   0) ( 64 . 159))
687                                  ;; Grey disallowed at bottom
688                                  ((131 .   0) (  0 .   0) (125 . 131))))
689         (< (setq x (+ x 16)) (uncompface-width)))
690       (< (setq y (+ y 16)) (uncompface-height)))
691     (setq y 0)
692     (let ((i 0) guesses k)
693       (uncompface-loop
694         (setq guesses (cond ((= y 1) (nth 2 (uncompface-guesses)))
695                             ((= y 2) (nth 1 (uncompface-guesses)))
696                             (t       (nth 0 (uncompface-guesses))))
697               x 0)
698         (uncompface-loop
699           (setq k 0)
700           (when (>= x 1)
701             (when (>= x 2)
702               (when (>= x 3)
703                 (when (>= y 1)
704                   (when (>= y 2)
705                     (when (>= y 3)
706                       (setq k (uncompface-shift-in k -2 -2)))
707                     (setq k (uncompface-shift-in k -1 -2)))
708                   (setq k (uncompface-shift-in k 0 -2))))
709               (when (>= y 1)
710                 (when (>= y 2)
711                   (when (>= y 3)
712                     (setq k (uncompface-shift-in k -2 -1)))
713                   (setq k (uncompface-shift-in k -1 -1)))
714                 (setq k (uncompface-shift-in k 0 -1))))
715             (when (>= y 2)
716               (when (>= y 3)
717                 (setq k (uncompface-shift-in k -2 0)))
718               (setq k (uncompface-shift-in k -1 0)))
719             (when (>= y 2)
720               (when (>= y 3)
721                 (setq k (uncompface-shift-in k -2 1)))
722               (setq k (uncompface-shift-in k -1 1)))
723             (when (<= x (- (uncompface-width) 2))
724               (when (>= y 2)
725                 (when (>= y 3)
726                   (setq k (uncompface-shift-in k -2 2)))
727                 (setq k (uncompface-shift-in k -1 2)))))
728           (if (aref (car (cond ((= x 1)
729                                 (cdr (cdr guesses)))
730                                ((= x 2)
731                                 (cdr guesses))
732                                ((= x (1- (uncompface-width)))
733                                 (cdr (cdr (cdr guesses))))
734                                (t
735                                 guesses))) k)
736               (aset face i (not (aref face i))))
737           (setq i (1+ i))
738           (< (setq x (1+ x)) (uncompface-width)))
739         (< (setq y (1+ y)) (uncompface-height))))
740     (if raw
741         face
742       (concat (eval-when-compile
743                 (format "P1\n%d %d\n" uncompface-width uncompface-height))
744               (mapconcat (lambda (bit) (if bit "1" "0")) face " ")
745               "\n"))))
746
747 (provide 'compface)
748
749 ;; Local variables:
750 ;; eval: (put 'uncompface-loop 'lisp-indent-hook 0)
751 ;; End:
752
753 ;; arch-tag: a8e3f4a0-e375-4f1d-a426-c7da30e16c18
754 ;;; compface.el ends here