cwiki-glyph.el

   1 (require 'cwiki-common)
   2
   3 (setq file-name-coding-system 'utf-8-jp)
   4
   5 (defun www-glyph-generate-png (ccs code-point &optional size)
   6   (unless size
   7     (setq size 40))
   8   (let (png-file dir font char ret plain)
   9     (cond
  10      ((eq ccs '=ucs@JP/hanazono)
  11       (setq font
  12             (if (<= code-point 65535)
  13                 "/usr/local/share/fonts/TrueType/Hanazono/HanaMinA.ttf"
  14               "/usr/local/share/fonts/TrueType/Hanazono/HanaMinB.ttf"))
  15       (setq char (decode-char '=ucs code-point)
  16             png-file (format "/opt/chisewiki/glyphs/%d/Hanazono/u%04X.png"
  17                              size code-point))
  18       )
  19      ((eq ccs '=gt)
  20       (setq char (decode-char '=gt code-point)
  21             png-file (format "/opt/chisewiki/glyphs/%d/GT/%05d.png"
  22                              size code-point))
  23       (setq plain 1)
  24       (while (and (<= plain 11)
  25                   (null
  26                    (setq ret (encode-char
  27                               char
  28                               (intern (format "=gt-pj-%d" plain))))))
  29         (setq plain (1+ plain)))
  30       (setq font (format
  31                   "/usr/local/share/fonts/TrueType/GT/gt2000%02d.ttf"
  32                   plain)
  33             char (decode-char '=jis-x0208@1990 ret))
  34       (when (setq ret (encode-char char '=ucs@jis/1990))
  35         (setq char (decode-char '=ucs ret)))
  36       )
  37      ((eq ccs '=gt-k)
  38       (setq char (decode-char '=gt-k code-point)
  39             png-file (format "/opt/chisewiki/glyphs/%d/GT-K/%05d.png"
  40                              size code-point))
  41       (setq plain 1)
  42       (while (and (<= plain 11)
  43                   (null
  44                    (setq ret (encode-char
  45                               char
  46                               (intern (format "=gt-pj-k%d" plain))))))
  47         (setq plain (1+ plain)))
  48       (setq font (format
  49                   "/usr/local/share/fonts/TrueType/GT/gt2000k%d.ttf"
  50                   plain)
  51             char (decode-char '=jis-x0208@1990 ret))
  52       (when (setq ret (encode-char char '=ucs@jis/1990))
  53         (setq char (decode-char '=ucs ret)))
  54       )
  55      ((eq ccs '=big5)
  56       (setq font "/usr/local/share/fonts/TrueType/Arphic/bsmi00lp.ttf"
  57             char (decode-char '=big5 code-point)
  58             png-file (format "/opt/chisewiki/glyphs/%d/Big5/%04X.png"
  59                              size code-point))
  60       (when (setq ret (or (encode-char char '=ucs@big5)
  61                           (char-ucs char)))
  62         (setq char (decode-char '=ucs ret)))
  63       )
  64      ((eq ccs '=big5-cdp)
  65       (setq font "/usr/local/share/fonts/TrueType/CDP/Cdpeudc.ttf"
  66             char (decode-char '=big5-pua code-point)
  67             png-file (format "/opt/chisewiki/glyphs/%d/CDP/%04X.png"
  68                              size code-point))
  69       )
  70      ((eq ccs '=ruimoku-v6)
  71       (setq font "/usr/local/share/fonts/TrueType/Zinbun/rui6-eudc.ttf"
  72             char (decode-char '=ucs code-point)
  73             png-file (format "/opt/chisewiki/glyphs/%d/Ruimoku-v6/%04X.png"
  74                              size code-point))
  75       ))
  76     (when font
  77       (if (= (call-process
  78               "convert" nil nil nil
  79               "-size" (format "%dx%d" size size)
  80               "-font" font
  81               (concat "label:" (char-to-string char))
  82               (progn
  83                 (setq dir (file-name-directory png-file))
  84                 (unless (file-exists-p dir)
  85                   (make-directory dir t))
  86                 png-file))
  87              0)
  88           png-file))))
  89
  90 (defun www-glyph-display-png (char-rep &optional size)
  91   (when (stringp size)
  92     (setq size (string-to-int size)))
  93   (let ((png-file
  94          (cond
  95           ((string-match "^hana-JU\\+\\([0-9A-F]+\\)" char-rep)
  96            (www-glyph-generate-png
  97             '=ucs@JP/hanazono
  98             (string-to-int (match-string 1 char-rep) 16)
  99             size)
 100            )
 101           ((string-match "^GT-\\([0-9]+\\)" char-rep)
 102            (www-glyph-generate-png
 103             '=gt
 104             (string-to-int (match-string 1 char-rep))
 105             size)
 106            )
 107           ((string-match "^GT-K\\([0-9]+\\)" char-rep)
 108            (www-glyph-generate-png
 109             '=gt-k
 110             (string-to-int (match-string 1 char-rep))
 111             size)
 112            )
 113           ((string-match "^B-\\([0-9A-F]+\\)" char-rep)
 114            (www-glyph-generate-png
 115             '=big5
 116             (string-to-int (match-string 1 char-rep) 16)
 117             size)
 118            )
 119           ((string-match "^CDP-\\([0-9A-F]+\\)" char-rep)
 120            (www-glyph-generate-png
 121             '=big5-cdp
 122             (string-to-int (match-string 1 char-rep) 16)
 123             size)
 124            )
 125           ((string-match "^RUI6-\\([0-9A-F]+\\)" char-rep)
 126            (www-glyph-generate-png
 127             '=ruimoku-v6
 128             (string-to-int (match-string 1 char-rep) 16)
 129             size)
 130            ))
 131          ))
 132     (when png-file
 133       (princ (format "Content-Type: %s"
 134                      (with-temp-buffer
 135                        (call-process
 136                         "file"
 137                         nil t t
 138                         "-b" "--mime" png-file)
 139                        (insert "\n")
 140                        (let ((coding-system-for-read 'binary)
 141                              (coding-system-for-write 'binary))
 142                          (insert-file-contents-literally png-file))
 143                        (buffer-string)))))))
 144
 145 (defun www-batch-display-glyph ()
 146   (setq terminal-coding-system 'binary)
 147   (condition-case err
 148       (let* ((target (pop command-line-args-left))
 149              ;; (user (pop command-line-args-left))
 150              ;; (accept-language (pop command-line-args-left))
 151              ;; (lang
 152              ;;  (intern
 153              ;;   (car (split-string
 154              ;;         (car (split-string
 155              ;;               (car (split-string accept-language ","))
 156              ;;               ";"))
 157              ;;         "-"))))
 158              ret)
 159         (cond
 160          ((stringp target)
 161           (setq target
 162                 (mapcar (lambda (cell)
 163                           (if (string-match "=" cell)
 164                               (cons
 165                                (intern
 166                                 (decode-uri-string
 167                                  (substring cell 0 (match-beginning 0))
 168                                  'utf-8-mcs-er))
 169                                (substring cell (match-end 0)))
 170                             (list (decode-uri-string cell 'utf-8-mcs-er))))
 171                         (split-string target "&")))
 172           (setq ret (car target))
 173           (cond ((eq (car ret) 'char)
 174                  (www-glyph-display-png
 175                   (cdr ret)
 176                   (cdr (assq 'size target)))
 177                  ))
 178           ))
 179         )
 180     (error nil
 181            (princ (format "%S" err)))
 182     ))