cwiki-glyph.el

   1 (require 'cwiki-common)
   2
   3 (setq file-name-coding-system 'utf-8-jp)
   4
   5 (defun www-glyph-big5-to-ucs-pua (code-point)
   6   (let ((H (lsh code-point -8))
   7         (L (logand code-point #xff)))
   8   (if (<= #x8140 code-point)
   9       (if (<= code-point #x8DFE)
  10           (+ #xEEB8 (* 157 (- H 0x81))
  11              (if (< L #x80)
  12                  (- L #x40)
  13                (- L #x62)))
  14         (if (<= #x8E40 code-point)
  15             (if (<= code-point #xA0FE)
  16                 (+ #xE311 (* 157 (- H #x8e))
  17                    (if (< L #x80)
  18                        (- L #x40)
  19                      (- L #x62)))
  20               (if (<= #xC6A1 code-point)
  21                   (if (<= code-point #xC8FE)
  22                       (+ #xF672 (* 157 (- H #xC6))
  23                          (if (< L #x80)
  24                              (- L #x40)
  25                            (- L #x62)))
  26                     (if (<= #xFA40 code-point)
  27                         (if (<= code-point #xFEFE)
  28                             (+ #xE000 (* 157 (- H #xFA))
  29                                (if (< L #x80)
  30                                    (- L #x40)
  31                                  (- L #x62)))))))))))))
  32
  33 (defun www-glyph-generate-png (ccs code-point &optional size)
  34   (unless size
  35     (setq size 40))
  36   (let (png-file dir font char ret plain)
  37     (cond
  38      ((eq ccs '=ucs@JP/hanazono)
  39       (setq font
  40             (if (<= code-point 65535)
  41                 "/usr/local/share/fonts/TrueType/Hanazono/HanaMinA.ttf"
  42               "/usr/local/share/fonts/TrueType/Hanazono/HanaMinB.ttf"))
  43       (setq char (decode-char '=ucs code-point)
  44             png-file (format "/opt/chisewiki/glyphs/%d/Hanazono/u%04X.png"
  45                              size code-point))
  46       )
  47      ((eq ccs '=gt)
  48       (setq char (decode-char '=gt code-point)
  49             png-file (format "/opt/chisewiki/glyphs/%d/GT/%05d.png"
  50                              size code-point))
  51       (setq plain 1)
  52       (while (and (<= plain 11)
  53                   (null
  54                    (setq ret (encode-char
  55                               char
  56                               (intern (format "=gt-pj-%d" plain))))))
  57         (setq plain (1+ plain)))
  58       (setq font (format
  59                   "/usr/local/share/fonts/TrueType/GT/gt2000%02d.ttf"
  60                   plain)
  61             char (decode-char '=jis-x0208@1990 ret))
  62       (when (setq ret (encode-char char '=ucs@jis/1990))
  63         (setq char (decode-char '=ucs ret)))
  64       )
  65      ((eq ccs '=gt-k)
  66       (setq char (decode-char '=gt-k code-point)
  67             png-file (format "/opt/chisewiki/glyphs/%d/GT-K/%05d.png"
  68                              size code-point))
  69       (setq plain 1)
  70       (while (and (<= plain 11)
  71                   (null
  72                    (setq ret (encode-char
  73                               char
  74                               (intern (format "=gt-pj-k%d" plain))))))
  75         (setq plain (1+ plain)))
  76       (setq font (format
  77                   "/usr/local/share/fonts/TrueType/GT/gt2000k%d.ttf"
  78                   plain)
  79             char (decode-char '=jis-x0208@1990 ret))
  80       (when (setq ret (encode-char char '=ucs@jis/1990))
  81         (setq char (decode-char '=ucs ret)))
  82       )
  83      ((eq ccs '=big5)
  84       (setq font "/usr/local/share/fonts/TrueType/Arphic/bsmi00lp.ttf"
  85             char (decode-char '=big5 code-point)
  86             png-file (format "/opt/chisewiki/glyphs/%d/Big5/%04X.png"
  87                              size code-point))
  88       (when (setq ret (or (encode-char char '=ucs@big5)
  89                           (char-ucs char)))
  90         (setq char (decode-char '=ucs ret)))
  91       )
  92      ((eq ccs '=big5-cdp)
  93       (setq font "/usr/local/share/fonts/TrueType/CDP/Cdpeudc.ttf"
  94             char (or (decode-char '=big5-pua code-point)
  95                      (decode-char '=ucs
  96                                   (www-glyph-big5-to-ucs-pua code-point)))
  97             png-file (format "/opt/chisewiki/glyphs/%d/CDP/%04X.png"
  98                              size code-point))
  99       )
 100      ((eq ccs '=hanziku-1)
 101       (setq font "/usr/local/share/fonts/TrueType/Hanziku/hzk1u.ttf"
 102             char (or (decode-char '=big5-pua code-point)
 103                      (decode-char '=ucs
 104                                   (www-glyph-big5-to-ucs-pua code-point)))
 105             png-file (format "/opt/chisewiki/glyphs/%d/Hanziku-01/%04X.png"
 106                              size code-point))
 107       )
 108      ((eq ccs '=hanziku-2)
 109       (setq font "/usr/local/share/fonts/TrueType/Hanziku/hzk2u.ttf"
 110             char (or (decode-char '=big5-pua code-point)
 111                      (decode-char '=ucs
 112                                   (www-glyph-big5-to-ucs-pua code-point)))
 113             png-file (format "/opt/chisewiki/glyphs/%d/Hanziku-02/%04X.png"
 114                              size code-point))
 115       )
 116      ((eq ccs '=hanziku-3)
 117       (setq font "/usr/local/share/fonts/TrueType/Hanziku/hzk3u.ttf"
 118             char (or (decode-char '=big5-pua code-point)
 119                      (decode-char '=ucs
 120                                   (www-glyph-big5-to-ucs-pua code-point)))
 121             png-file (format "/opt/chisewiki/glyphs/%d/Hanziku-03/%04X.png"
 122                              size code-point))
 123       )
 124      ((eq ccs '=hanziku-4)
 125       (setq font "/usr/local/share/fonts/TrueType/Hanziku/hzk4u.ttf"
 126             char (or (decode-char '=big5-pua code-point)
 127                      (decode-char '=ucs
 128                                   (www-glyph-big5-to-ucs-pua code-point)))
 129             png-file (format "/opt/chisewiki/glyphs/%d/Hanziku-04/%04X.png"
 130                              size code-point))
 131       )
 132      ((eq ccs '=hanziku-5)
 133       (setq font "/usr/local/share/fonts/TrueType/Hanziku/hzk5u.ttf"
 134             char (or (decode-char '=big5-pua code-point)
 135                      (decode-char '=ucs
 136                                   (www-glyph-big5-to-ucs-pua code-point)))
 137             png-file (format "/opt/chisewiki/glyphs/%d/Hanziku-05/%04X.png"
 138                              size code-point))
 139       )
 140      ((eq ccs '=hanziku-6)
 141       (setq font "/usr/local/share/fonts/TrueType/Hanziku/hzk6u.ttf"
 142             char (or (decode-char '=big5-pua code-point)
 143                      (decode-char '=ucs
 144                                   (www-glyph-big5-to-ucs-pua code-point)))
 145             png-file (format "/opt/chisewiki/glyphs/%d/Hanziku-06/%04X.png"
 146                              size code-point))
 147       )
 148      ((eq ccs '=hanziku-7)
 149       (setq font "/usr/local/share/fonts/TrueType/Hanziku/hzk7u.ttf"
 150             char (or (decode-char '=big5-pua code-point)
 151                      (decode-char '=ucs
 152                                   (www-glyph-big5-to-ucs-pua code-point)))
 153             png-file (format "/opt/chisewiki/glyphs/%d/Hanziku-07/%04X.png"
 154                              size code-point))
 155       )
 156      ((eq ccs '=hanziku-8)
 157       (setq font "/usr/local/share/fonts/TrueType/Hanziku/hzk8u.ttf"
 158             char (or (decode-char '=big5-pua code-point)
 159                      (decode-char '=ucs
 160                                   (www-glyph-big5-to-ucs-pua code-point)))
 161             png-file (format "/opt/chisewiki/glyphs/%d/Hanziku-08/%04X.png"
 162                              size code-point))
 163       )
 164      ((eq ccs '=hanziku-9)
 165       (setq font "/usr/local/share/fonts/TrueType/Hanziku/hzk9u.ttf"
 166             char (or (decode-char '=big5-pua code-point)
 167                      (decode-char '=ucs
 168                                   (www-glyph-big5-to-ucs-pua code-point)))
 169             png-file (format "/opt/chisewiki/glyphs/%d/Hanziku-09/%04X.png"
 170                              size code-point))
 171       )
 172      ((eq ccs '=hanziku-10)
 173       (setq font "/usr/local/share/fonts/TrueType/Hanziku/hzkau.ttf"
 174             char (or (decode-char '=big5-pua code-point)
 175                      (decode-char '=ucs
 176                                   (www-glyph-big5-to-ucs-pua code-point)))
 177             png-file (format "/opt/chisewiki/glyphs/%d/Hanziku-10/%04X.png"
 178                              size code-point))
 179       )
 180      ((eq ccs '=hanziku-11)
 181       (setq font "/usr/local/share/fonts/TrueType/Hanziku/hzkbu.ttf"
 182             char (or (decode-char '=big5-pua code-point)
 183                      (decode-char '=ucs
 184                                   (www-glyph-big5-to-ucs-pua code-point)))
 185             png-file (format "/opt/chisewiki/glyphs/%d/Hanziku-11/%04X.png"
 186                              size code-point))
 187       )
 188      ((eq ccs '=hanziku-12)
 189       (setq font "/usr/local/share/fonts/TrueType/Hanziku/hzkcu.ttf"
 190             char (or (decode-char '=big5-pua code-point)
 191                      (decode-char '=ucs
 192                                   (www-glyph-big5-to-ucs-pua code-point)))
 193             png-file (format "/opt/chisewiki/glyphs/%d/Hanziku-12/%04X.png"
 194                              size code-point))
 195       )
 196      ((eq ccs '=ruimoku-v6)
 197       (setq font "/usr/local/share/fonts/TrueType/Zinbun/rui6-eudc.ttf"
 198             char (decode-char '=ucs code-point)
 199             png-file (format "/opt/chisewiki/glyphs/%d/Ruimoku-v6/%04X.png"
 200                              size code-point))
 201       ))
 202     (when font
 203       (if (= (call-process
 204               "convert" nil nil nil
 205               "-size" (format "%dx%d" size size)
 206               "-font" font
 207               (concat "label:" (char-to-string char))
 208               (progn
 209                 (setq dir (file-name-directory png-file))
 210                 (unless (file-exists-p dir)
 211                   (make-directory dir t))
 212                 png-file))
 213              0)
 214           png-file))))
 215
 216 (defun www-glyph-display-png (char-rep &optional size)
 217   (when (stringp size)
 218     (setq size (string-to-int size)))
 219   (let ((png-file
 220          (cond
 221           ((string-match "^hana-JU\\+\\([0-9A-F]+\\)" char-rep)
 222            (www-glyph-generate-png
 223             '=ucs@JP/hanazono
 224             (string-to-int (match-string 1 char-rep) 16)
 225             size)
 226            )
 227           ((string-match "^GT-\\([0-9]+\\)" char-rep)
 228            (www-glyph-generate-png
 229             '=gt
 230             (string-to-int (match-string 1 char-rep))
 231             size)
 232            )
 233           ((string-match "^GT-K\\([0-9]+\\)" char-rep)
 234            (www-glyph-generate-png
 235             '=gt-k
 236             (string-to-int (match-string 1 char-rep))
 237             size)
 238            )
 239           ((string-match "^B-\\([0-9A-F]+\\)" char-rep)
 240            (www-glyph-generate-png
 241             '=big5
 242             (string-to-int (match-string 1 char-rep) 16)
 243             size)
 244            )
 245           ((string-match "^CDP-\\([0-9A-F]+\\)" char-rep)
 246            (www-glyph-generate-png
 247             '=big5-cdp
 248             (string-to-int (match-string 1 char-rep) 16)
 249             size)
 250            )
 251           ((string-match
 252             "^HZK\\(0[1-9]\\|1[0-2]\\)-\\([0-9A-F]+\\)"
 253             char-rep)
 254            (www-glyph-generate-png
 255             (intern (format "=hanziku-%d"
 256                             (string-to-int (match-string 1 char-rep))))
 257             (string-to-int (match-string 2 char-rep) 16)
 258             size)
 259            )
 260           ((string-match "^RUI6-\\([0-9A-F]+\\)" char-rep)
 261            (www-glyph-generate-png
 262             '=ruimoku-v6
 263             (string-to-int (match-string 1 char-rep) 16)
 264             size)
 265            ))
 266          ))
 267     (when png-file
 268       (princ (format "Content-Type: %s"
 269                      (with-temp-buffer
 270                        (call-process
 271                         "file"
 272                         nil t t
 273                         "-b" "--mime" png-file)
 274                        (insert "\n")
 275                        (let ((coding-system-for-read 'binary)
 276                              (coding-system-for-write 'binary))
 277                          (insert-file-contents-literally png-file))
 278                        (buffer-string)))))))
 279
 280 (defun www-batch-display-glyph ()
 281   (setq terminal-coding-system 'binary)
 282   (condition-case err
 283       (let* ((target (pop command-line-args-left))
 284              ;; (user (pop command-line-args-left))
 285              ;; (accept-language (pop command-line-args-left))
 286              ;; (lang
 287              ;;  (intern
 288              ;;   (car (split-string
 289              ;;         (car (split-string
 290              ;;               (car (split-string accept-language ","))
 291              ;;               ";"))
 292              ;;         "-"))))
 293              ret)
 294         (cond
 295          ((stringp target)
 296           (setq target
 297                 (mapcar (lambda (cell)
 298                           (if (string-match "=" cell)
 299                               (cons
 300                                (intern
 301                                 (decode-uri-string
 302                                  (substring cell 0 (match-beginning 0))
 303                                  'utf-8-mcs-er))
 304                                (substring cell (match-end 0)))
 305                             (list (decode-uri-string cell 'utf-8-mcs-er))))
 306                         (split-string target "&")))
 307           (setq ret (car target))
 308           (cond ((eq (car ret) 'char)
 309                  (www-glyph-display-png
 310                   (cdr ret)
 311                   (cdr (assq 'size target)))
 312                  ))
 313           ))
 314         )
 315     (error nil
 316            (princ (format "%S" err)))
 317     ))