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