(est-coded-charset-entity-reference-alist): New variable.
[chise/est.git] / 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     ))