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