Add kanjivg
Makefile
12 | 12 | include jibiki.mk | |
13 | 13 | include jmdict.mk | |
14 | 14 | include kanjidic.mk | |
15 | + | include kanjivg.mk | |
15 | 16 | include radicals.mk | |
16 | 17 | include wadoku.mk | |
17 | 18 |
kanjivg.mk unknown status 1
1 | + | DICOS+=dicos/kanjivg.nani | |
2 | + | DOWNLOADS+=dictionaries/kanjivg | |
3 | + | ||
4 | + | dictionaries/kanjivg: | |
5 | + | git clone --depth 1 https://github.com/KanjiVG/kanjivg $@ | |
6 | + | ||
7 | + | dicos/kanjivg.nani: dictionaries/kanjivg tools/kanjivg.scm $(DICO_MODULES) | |
8 | + | guile -L modules tools/kanjivg.scm build $< $@ |
modules/nani/kanji/kanjivg.scm unknown status 1
1 | + | ;;; Nani Project website | |
2 | + | ;;; Copyright ?? 2021 Julien Lepiller <julien@lepiller.eu> | |
3 | + | ;;; | |
4 | + | ;;; This file is part of the Nani Project website. | |
5 | + | ;;; | |
6 | + | ;;; The Nani Project website is free software; you can redistribute it and/or modify it | |
7 | + | ;;; under the terms of the GNU Affero General Public License as published by | |
8 | + | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
9 | + | ;;; your option) any later version. | |
10 | + | ;;; | |
11 | + | ;;; The Nani Project website is distributed in the hope that it will be useful, but | |
12 | + | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | + | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | + | ;;; GNU Affero General Public License for more details. | |
15 | + | ;;; | |
16 | + | ;;; You should have received a copy of the GNU Affero General Public License | |
17 | + | ;;; along with the Nani Project website. If not, see <http://www.gnu.org/licenses/>. | |
18 | + | ||
19 | + | (define-module (nani kanji kanjivg) | |
20 | + | #:use-module (ice-9 binary-ports) | |
21 | + | #:use-module (ice-9 match) | |
22 | + | #:use-module (nani encoding huffman) | |
23 | + | #:use-module (nani encoding serialize) | |
24 | + | #:use-module (nani encoding trie) | |
25 | + | #:use-module (rnrs bytevectors) | |
26 | + | #:use-module (srfi srfi-9) | |
27 | + | #:use-module (sxml simple) | |
28 | + | #:export (make-kanji | |
29 | + | kanji? | |
30 | + | kanji-position kanji-position-set! | |
31 | + | kanji-kanji | |
32 | + | kanji-elements | |
33 | + | kanji-strokes | |
34 | + | ||
35 | + | xml->kanji | |
36 | + | serialize-stroke stroke-size | |
37 | + | serialize-kanji kanji-size | |
38 | + | serialize-kanjivg | |
39 | + | kanjivg-entry-count)) | |
40 | + | ||
41 | + | (define-record-type <kanji> | |
42 | + | (make-kanji position kanji elements strokes) | |
43 | + | kanji? | |
44 | + | (position kanji-position kanji-position-set!) | |
45 | + | (kanji kanji-kanji) | |
46 | + | (elements kanji-elements) | |
47 | + | (strokes kanji-strokes)) | |
48 | + | ||
49 | + | (define-record-type <stroke> | |
50 | + | (make-stroke x y command) | |
51 | + | stroke? | |
52 | + | (x stroke-x) | |
53 | + | (y stroke-y) | |
54 | + | (command stroke-command)) | |
55 | + | ||
56 | + | (define (strokes->elements strokes) | |
57 | + | "collect only top-level elements" | |
58 | + | (match strokes | |
59 | + | (() '()) | |
60 | + | ((('http://www.w3.org/2000/svg:g ('@ attr ...) _ ...) strokes ...) | |
61 | + | (let loop ((attr attr)) | |
62 | + | (match attr | |
63 | + | (() (strokes->elements strokes)) | |
64 | + | ((('kvg:element element) _ ...) | |
65 | + | (cons element (strokes->elements strokes))) | |
66 | + | ((_ attr ...) (loop attr))))) | |
67 | + | (((_ ...) strokes ...) | |
68 | + | (strokes->elements strokes)))) | |
69 | + | ||
70 | + | (define (find-stroke kvg id) | |
71 | + | (match kvg | |
72 | + | (() #f) | |
73 | + | ((('http://www.w3.org/2000/svg:path ('@ attr ...)) kvg ...) | |
74 | + | (if (equal? (car (assoc-ref attr 'id)) id) | |
75 | + | (car (assoc-ref attr 'd)) | |
76 | + | (find-stroke kvg id))) | |
77 | + | ((('http://www.w3.org/2000/svg:g ('@ _ ...) content ...) kvg ...) | |
78 | + | (or (find-stroke content id) (find-stroke kvg id))) | |
79 | + | (((? string? _) kvg ...) | |
80 | + | (find-stroke kvg id)))) | |
81 | + | ||
82 | + | (define (get-strokes strokes label id) | |
83 | + | (match label | |
84 | + | (() '()) | |
85 | + | ((('http://www.w3.org/2000/svg:text ('@ ('transform transform)) num) label ...) | |
86 | + | (let* ((xy (substring transform 15 (- (string-length transform) 1))) | |
87 | + | (xy (string-split xy #\ )) | |
88 | + | (x (car xy)) | |
89 | + | (y (cadr xy))) | |
90 | + | (cons (make-stroke x y (find-stroke strokes (string-append id "-s" num))) | |
91 | + | (get-strokes strokes label id)))) | |
92 | + | (((? string? _) label ...) | |
93 | + | (get-strokes strokes label id)))) | |
94 | + | ||
95 | + | (define (kvg-ref kvg elem) | |
96 | + | (assoc-ref kvg (symbol-append 'http://www.w3.org/2000/svg: elem))) | |
97 | + | ||
98 | + | (define (xml->kanji port) | |
99 | + | (match (xml->sxml port #:namespaces '((kvg . "kvg"))) | |
100 | + | (('*TOP* _ ('http://www.w3.org/2000/svg:svg ('@ _ ...) svg ...)) | |
101 | + | (match (filter pair? svg) | |
102 | + | ((('http://www.w3.org/2000/svg:g ('@ _ ...) strokes ...) | |
103 | + | ('http://www.w3.org/2000/svg:g ('@ _ ...) labels ...)) | |
104 | + | (let* ((elements (strokes->elements (filter pair? (kvg-ref strokes 'g)))) | |
105 | + | (kanji (assoc-ref (assoc-ref (kvg-ref strokes 'g) '@) 'kvg:element)) | |
106 | + | (kanji (if kanji (car kanji) #f)) | |
107 | + | (id (car (assoc-ref (assoc-ref (kvg-ref strokes 'g) '@) 'id))) | |
108 | + | (strokes (get-strokes strokes labels id))) | |
109 | + | (make-kanji 0 kanji elements strokes))))))) | |
110 | + | ||
111 | + | (define (serialize-stroke command-huffman-code) | |
112 | + | (lambda (stroke pos bv) | |
113 | + | (when (not (stroke? stroke)) (throw 'not-stroke stroke)) | |
114 | + | (let* ((pos ((serialize-huffman-string command-huffman-code) (stroke-command stroke) pos bv)) | |
115 | + | (pos ((serialize-huffman-string command-huffman-code) (stroke-x stroke) pos bv)) | |
116 | + | (pos ((serialize-huffman-string command-huffman-code) (stroke-y stroke) pos bv))) | |
117 | + | pos))) | |
118 | + | (define (stroke-size command-huffman-code) | |
119 | + | (lambda (stroke) | |
120 | + | (when (not (stroke? stroke)) (throw 'not-stroke stroke)) | |
121 | + | (+ ((huffman-string-size command-huffman-code) (stroke-command stroke)) | |
122 | + | ((huffman-string-size command-huffman-code) (stroke-x stroke)) | |
123 | + | ((huffman-string-size command-huffman-code) (stroke-y stroke))))) | |
124 | + | ||
125 | + | (define (serialize-kanji command-huffman-code) | |
126 | + | (lambda (kanji pos bv) | |
127 | + | (when (not (kanji? kanji)) (throw 'not-kanji kanji)) | |
128 | + | (kanji-position-set! kanji pos) | |
129 | + | (let* ((pos ((serialize-list serialize-string) (kanji-elements kanji) pos bv)) | |
130 | + | (pos ((serialize-list (serialize-stroke command-huffman-code)) | |
131 | + | (kanji-strokes kanji) pos bv))) | |
132 | + | pos))) | |
133 | + | (define (kanji-size command-huffman-code) | |
134 | + | (lambda (kanji) | |
135 | + | (when (not (kanji? kanji)) (throw 'not-kanji kanji)) | |
136 | + | (+ ((list-size string-size) (kanji-elements kanji)) | |
137 | + | ((list-size (stroke-size command-huffman-code)) (kanji-strokes kanji))))) | |
138 | + | ||
139 | + | (define (update-trie-pos! trie kanji) | |
140 | + | (let* ((vals (trie-vals trie)) | |
141 | + | (vals (match vals | |
142 | + | ((pos) (kanji-position (array-ref kanji pos))) | |
143 | + | ((pos1 pos2) ; alias between ??? and ???, maybe others? | |
144 | + | (kanji-position (array-ref kanji pos1))) | |
145 | + | (() 0)))) | |
146 | + | (trie-vals-set! trie vals)) | |
147 | + | (for-each | |
148 | + | (match-lambda | |
149 | + | ((char . child) | |
150 | + | (update-trie-pos! child kanji))) | |
151 | + | (trie-transitions trie))) | |
152 | + | ||
153 | + | (define (make-key key) | |
154 | + | (apply append | |
155 | + | (map (lambda (c) | |
156 | + | (list (quotient c 16) (modulo c 16))) | |
157 | + | (bytevector->u8-list (string->utf8 key))))) | |
158 | + | ||
159 | + | (define (make-kanji-trie kanji) | |
160 | + | (let ((trie (make-empty-trie))) | |
161 | + | (let loop ((kanji kanji) (i 0)) | |
162 | + | (if (null? kanji) | |
163 | + | (compress-trie trie) | |
164 | + | (begin | |
165 | + | (add-to-trie! trie (make-key (kanji-kanji (car kanji))) i) | |
166 | + | (loop (cdr kanji) (+ i 1))))))) | |
167 | + | ||
168 | + | (define (serialize-kanjivg results) | |
169 | + | (define command-huffman | |
170 | + | (let* ((strokes (apply append (map kanji-strokes results))) | |
171 | + | (commands (map stroke-command strokes)) | |
172 | + | (x (map stroke-x strokes)) | |
173 | + | (y (map stroke-y strokes))) | |
174 | + | (create-huffman (append commands x y)))) | |
175 | + | (define command-huffman-code (huffman->code command-huffman)) | |
176 | + | ||
177 | + | (let* ((header (string->utf8 "NANI_KANJIVG001")) | |
178 | + | (header-size (bytevector-length header)) | |
179 | + | (command-huffman-bv (serialize-huffman command-huffman)) | |
180 | + | (command-huffman-size (bytevector-length command-huffman-bv)) | |
181 | + | (serialize-trie (serialize-trie-single serialize-int int-size)) | |
182 | + | (trie-size (trie-size-single int-size)) | |
183 | + | (kanji-trie (make-kanji-trie results)) | |
184 | + | (kanji-trie-size (trie-size kanji-trie)) | |
185 | + | (results-size | |
186 | + | ((list-size (kanji-size command-huffman-code) | |
187 | + | #:size? #f) | |
188 | + | results)) | |
189 | + | (bv (make-bytevector (+ header-size 4 command-huffman-size | |
190 | + | kanji-trie-size results-size)))) | |
191 | + | (format #t "Number of kanji: ~a~%" (length results)) | |
192 | + | ((serialize-list (serialize-kanji command-huffman-code) | |
193 | + | #:size? #f) | |
194 | + | results (+ header-size 4 command-huffman-size kanji-trie-size) bv) | |
195 | + | (let ((results (list->array 1 results))) | |
196 | + | (update-trie-pos! kanji-trie results)) | |
197 | + | (bytevector-copy! header 0 bv 0 header-size) | |
198 | + | (serialize-int (length results) (+ header-size) bv) | |
199 | + | (bytevector-copy! command-huffman-bv 0 bv (+ header-size 4) | |
200 | + | command-huffman-size) | |
201 | + | (serialize-trie kanji-trie (+ header-size 4 command-huffman-size) bv) | |
202 | + | bv)) | |
203 | + | ||
204 | + | (define (kanjivg-entry-count file) | |
205 | + | (call-with-input-file file | |
206 | + | (lambda (port) | |
207 | + | (let* ((header (get-bytevector-n port 15)) | |
208 | + | (size (get-bytevector-n port 4))) | |
209 | + | (bytevector-u32-ref size 0 (endianness big)))))) |
po/nani.pot
8 | 8 | msgstr "" | |
9 | 9 | "Project-Id-Version: PACKAGE VERSION\n" | |
10 | 10 | "Report-Msgid-Bugs-To: \n" | |
11 | - | "POT-Creation-Date: 2021-07-21 14:25+0200\n" | |
11 | + | "POT-Creation-Date: 2021-07-29 21:50+0200\n" | |
12 | 12 | "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" | |
13 | 13 | "Last-Translator: FULL NAME <EMAIL@ADDRESS>\n" | |
14 | 14 | "Language-Team: LANGUAGE <LL@li.org>\n" | |
… | |||
102 | 102 | msgid "JMdict" | |
103 | 103 | msgstr "" | |
104 | 104 | ||
105 | - | #: tools/list.scm:64 | |
105 | + | #: tools/list.scm:71 | |
106 | 106 | msgid "" | |
107 | 107 | "Japanese/Dutch dictionary from the Electronic Dictionary Research and " | |
108 | 108 | "Development Group." | |
109 | 109 | msgstr "" | |
110 | 110 | ||
111 | - | #: tools/list.scm:63 | |
111 | + | #: tools/list.scm:70 | |
112 | 112 | msgid "" | |
113 | 113 | "Japanese/English dictionary from the Electronic Dictionary Research and " | |
114 | 114 | "Development Group." | |
115 | 115 | msgstr "" | |
116 | 116 | ||
117 | - | #: tools/list.scm:65 | |
117 | + | #: tools/list.scm:72 | |
118 | 118 | msgid "" | |
119 | 119 | "Japanese/French dictionary from the Electronic Dictionary Research and " | |
120 | 120 | "Development Group." | |
121 | 121 | msgstr "" | |
122 | 122 | ||
123 | - | #: tools/list.scm:54 | |
123 | + | #: tools/list.scm:61 | |
124 | 124 | msgid "Japanese/French dictionary from the Jibiki project." | |
125 | 125 | msgstr "" | |
126 | 126 | ||
127 | - | #: tools/list.scm:38 | |
127 | + | #: tools/list.scm:45 | |
128 | 128 | msgid "Japanese/German dictionary from Wadoku." | |
129 | 129 | msgstr "" | |
130 | 130 | ||
131 | - | #: tools/list.scm:66 | |
131 | + | #: tools/list.scm:73 | |
132 | 132 | msgid "" | |
133 | 133 | "Japanese/German dictionary from the Electronic Dictionary Research and " | |
134 | 134 | "Development Group." | |
135 | 135 | msgstr "" | |
136 | 136 | ||
137 | - | #: tools/list.scm:67 | |
137 | + | #: tools/list.scm:74 | |
138 | 138 | msgid "" | |
139 | 139 | "Japanese/Hungarian dictionary from the Electronic Dictionary Research and " | |
140 | 140 | "Development Group." | |
141 | 141 | msgstr "" | |
142 | 142 | ||
143 | - | #: tools/list.scm:68 | |
143 | + | #: tools/list.scm:75 | |
144 | 144 | msgid "" | |
145 | 145 | "Japanese/Russian dictionary from the Electronic Dictionary Research and " | |
146 | 146 | "Development Group." | |
147 | 147 | msgstr "" | |
148 | 148 | ||
149 | - | #: tools/list.scm:69 | |
149 | + | #: tools/list.scm:76 | |
150 | 150 | msgid "" | |
151 | 151 | "Japanese/Slovenian dictionary from the Electronic Dictionary Research and " | |
152 | 152 | "Development Group." | |
153 | 153 | msgstr "" | |
154 | 154 | ||
155 | - | #: tools/list.scm:70 | |
155 | + | #: tools/list.scm:77 | |
156 | 156 | msgid "" | |
157 | 157 | "Japanese/Spanish dictionary from the Electronic Dictionary Research and " | |
158 | 158 | "Development Group." | |
159 | 159 | msgstr "" | |
160 | 160 | ||
161 | - | #: tools/list.scm:71 | |
161 | + | #: tools/list.scm:78 | |
162 | 162 | msgid "" | |
163 | 163 | "Japanese/Swedish dictionary from the Electronic Dictionary Research and " | |
164 | 164 | "Development Group." | |
165 | 165 | msgstr "" | |
166 | 166 | ||
167 | - | #: tools/list.scm:80 | |
167 | + | #: tools/list.scm:87 | |
168 | 168 | msgid "Kanji dictionary with English meanings." | |
169 | 169 | msgstr "" | |
170 | 170 | ||
171 | - | #: tools/list.scm:82 | |
171 | + | #: tools/list.scm:89 | |
172 | 172 | msgid "Kanji dictionary with French meanings." | |
173 | 173 | msgstr "" | |
174 | 174 | ||
175 | - | #: tools/list.scm:83 | |
175 | + | #: tools/list.scm:90 | |
176 | 176 | msgid "Kanji dictionary with Portuguese meanings." | |
177 | 177 | msgstr "" | |
178 | 178 | ||
179 | - | #: tools/list.scm:81 | |
179 | + | #: tools/list.scm:88 | |
180 | 180 | msgid "Kanji dictionary with Spanish meanings." | |
181 | 181 | msgstr "" | |
182 | 182 | ||
183 | + | #: tools/list.scm:39 | |
184 | + | msgid "Kanji writing visual help by the Kanjivg project." | |
185 | + | msgstr "" | |
186 | + | ||
183 | 187 | #: tools/theme.scm:59 | |
184 | 188 | msgid "Language" | |
185 | 189 | msgstr "" | |
… | |||
229 | 233 | msgid "Phone: " | |
230 | 234 | msgstr "" | |
231 | 235 | ||
232 | - | #: tools/list.scm:46 | |
236 | + | #: tools/list.scm:53 | |
233 | 237 | msgid "Pitch accent dictionary from Wadoku." | |
234 | 238 | msgstr "" | |
235 | 239 | ||
236 | - | #: tools/list.scm:31 | |
240 | + | #: tools/list.scm:32 | |
237 | 241 | msgid "" | |
238 | 242 | "Radical to Kanji dictionary from the Electronic Dictionary Research and " | |
239 | 243 | "Development Group." | |
… | |||
331 | 335 | "In the following sections we will see how to use them." | |
332 | 336 | msgstr "" | |
333 | 337 | ||
334 | - | #: tools/list.scm:48 | |
338 | + | #: tools/list.scm:55 | |
335 | 339 | msgid "" | |
336 | 340 | "This dictionary allows you to augment search results on the main view\n" | |
337 | 341 | " with pitch accent (pronunciation) information. Japanese is not " | |
… | |||
341 | 345 | " words better, with a standard Japanese pitch accent." | |
342 | 346 | msgstr "" | |
343 | 347 | ||
344 | - | #: tools/list.scm:56 | |
348 | + | #: tools/list.scm:63 | |
345 | 349 | msgid "" | |
346 | 350 | "This dictionary allows you to do searches on the main view of this app.\n" | |
347 | 351 | "\tFailing to download one of these dictionaries will make the app unusable\n" | |
… | |||
349 | 353 | "\tby kanji, reading (kana) and by French translation." | |
350 | 354 | msgstr "" | |
351 | 355 | ||
352 | - | #: tools/list.scm:40 | |
356 | + | #: tools/list.scm:47 | |
353 | 357 | msgid "" | |
354 | 358 | "This dictionary allows you to do searches on the main view of this app.\n" | |
355 | 359 | " Failing to download one of these dictionaries will make the app " | |
… | |||
359 | 363 | " by kanji, reading (kana) and by German translation." | |
360 | 364 | msgstr "" | |
361 | 365 | ||
362 | - | #: tools/list.scm:73 | |
366 | + | #: tools/list.scm:80 | |
363 | 367 | msgid "" | |
364 | 368 | "This dictionary allows you to do searches on the main view of this app.\n" | |
365 | 369 | " Failing to download one of these dictionaries will make the app " | |
… | |||
369 | 373 | " kanji, reading (kana) and by meaning in the languages you selected." | |
370 | 374 | msgstr "" | |
371 | 375 | ||
372 | - | #: tools/list.scm:33 | |
376 | + | #: tools/list.scm:34 | |
373 | 377 | msgid "" | |
374 | 378 | "This dictionary allows you to enter kanji by selecting some of its\n" | |
375 | 379 | " components. Tap the water component button on the bottom of the screen " | |
… | |||
377 | 381 | " access the kanji selection by component view" | |
378 | 382 | msgstr "" | |
379 | 383 | ||
380 | - | #: tools/list.scm:85 | |
384 | + | #: tools/list.scm:92 | |
381 | 385 | msgid "" | |
382 | 386 | "This dictionary allows you to search for kanji and view kanji information\n" | |
383 | 387 | " such as number of strokes, pronunciations and meanings." | |
384 | 388 | msgstr "" | |
385 | 389 | ||
390 | + | #: tools/list.scm:41 | |
391 | + | msgid "" | |
392 | + | "This dictionary allows you to see how a kanji is written, what it is\n" | |
393 | + | "composed of, and the order in which strokes are written." | |
394 | + | msgstr "" | |
395 | + | ||
386 | 396 | #: pages/documentation.scm:30 | |
387 | 397 | msgid "" | |
388 | 398 | "This documentation will guide you in some of the most important\n" |
tools/kanjivg.scm unknown status 1
1 | + | ;;; Nani Project website | |
2 | + | ;;; Copyright ?? 2021 Julien Lepiller <julien@lepiller.eu> | |
3 | + | ;;; | |
4 | + | ;;; This file is part of the Nani Project website. | |
5 | + | ;;; | |
6 | + | ;;; The Nani Project website is free software; you can redistribute it and/or modify it | |
7 | + | ;;; under the terms of the GNU Affero General Public License as published by | |
8 | + | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
9 | + | ;;; your option) any later version. | |
10 | + | ;;; | |
11 | + | ;;; The Nani Project website is distributed in the hope that it will be useful, but | |
12 | + | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | + | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | + | ;;; GNU Affero General Public License for more details. | |
15 | + | ;;; | |
16 | + | ;;; You should have received a copy of the GNU Affero General Public License | |
17 | + | ;;; along with the Nani Project website. If not, see <http://www.gnu.org/licenses/>. | |
18 | + | ||
19 | + | (use-modules (nani kanji kanjivg)) | |
20 | + | (use-modules (ice-9 match)) | |
21 | + | (use-modules (ice-9 binary-ports)) | |
22 | + | ||
23 | + | (define (get-files directory) | |
24 | + | (let loop ((dir (opendir (string-append directory "/kanji/"))) (svgs '())) | |
25 | + | (let ((entry (readdir dir))) | |
26 | + | (cond | |
27 | + | ((eof-object? entry) svgs) | |
28 | + | ((string-contains entry "-") (loop dir svgs)) | |
29 | + | ((string-prefix? "000" entry) (loop dir svgs)) | |
30 | + | ((string-suffix? ".svg" entry) | |
31 | + | (loop dir (cons (string-append directory "/kanji/" entry) svgs))) | |
32 | + | (else (loop dir svgs)))))) | |
33 | + | ||
34 | + | (match (command-line) | |
35 | + | ((_ cmd kanjivg-dir output) | |
36 | + | (cond | |
37 | + | ((equal? cmd "build") | |
38 | + | (let* ((results | |
39 | + | (map | |
40 | + | (lambda (file) | |
41 | + | (call-with-input-file file | |
42 | + | (lambda (port) | |
43 | + | (let ((r (xml->kanji port))) | |
44 | + | (unless (kanji-kanji r) | |
45 | + | (pk 'no-kanji file)) | |
46 | + | r)))) | |
47 | + | (sort (get-files kanjivg-dir) string<?)))) | |
48 | + | (call-with-output-file output | |
49 | + | (lambda (port) | |
50 | + | (put-bytevector port | |
51 | + | (serialize-kanjivg (filter | |
52 | + | (lambda (r) (kanji-kanji r)) | |
53 | + | results))))))) | |
54 | + | (else (format #t "Unknown cmd ~a.~%" cmd))))) |
tools/list.scm
18 | 18 | ||
19 | 19 | (use-modules (tools i18n)) | |
20 | 20 | (use-modules (nani kanji kanjidic)) | |
21 | - | (use-modules (nani kanji radk)) | |
21 | + | (use-modules ((nani kanji radk) #:prefix radk:)) | |
22 | + | (use-modules (nani kanji kanjivg)) | |
22 | 23 | (use-modules (nani result result)) | |
23 | 24 | (use-modules (nani pitch pitch)) | |
24 | 25 | (use-modules (gcrypt hash)) | |
… | |||
34 | 35 | components. Tap the water component button on the bottom of the screen to | |
35 | 36 | access the kanji selection by component view")) | |
36 | 37 | ||
38 | + | (define ksvg-synopsis | |
39 | + | `(_ "Kanji writing visual help by the Kanjivg project.")) | |
40 | + | (define ksvg-description | |
41 | + | `(_ "This dictionary allows you to see how a kanji is written, what it is | |
42 | + | composed of, and the order in which strokes are written.")) | |
43 | + | ||
37 | 44 | (define wadoku-synopsis | |
38 | 45 | `(_ "Japanese/German dictionary from Wadoku.")) | |
39 | 46 | (define wadoku-description | |
… | |||
91 | 98 | (if long? | |
92 | 99 | radk-description | |
93 | 100 | radk-synopsis)) | |
101 | + | ((equal? (dico-type dico) "ksvg") | |
102 | + | (if long? | |
103 | + | ksvg-description | |
104 | + | ksvg-synopsis)) | |
94 | 105 | ((equal? (dico-type dico) "kanjidic") | |
95 | 106 | (let ((dico-lang (substring dico 9))) | |
96 | 107 | (if long? | |
… | |||
133 | 144 | (define (dico-type file) | |
134 | 145 | (cond | |
135 | 146 | ((equal? file "radicals") "radk") | |
147 | + | ((equal? file "kanjivg") "ksvg") | |
136 | 148 | ((and (> (string-length file) 8) (equal? (substring file 0 8) "kanjidic")) | |
137 | 149 | "kanjidic") | |
138 | 150 | ((and (> (string-length file) 6) (equal? (substring file 0 6) "JMdict")) | |
… | |||
144 | 156 | (define (entries file) | |
145 | 157 | (cond | |
146 | 158 | ((equal? (dico-type (dico-name file)) "radk") | |
147 | - | (kanji-count file)) | |
159 | + | (radk:kanji-count file)) | |
160 | + | ((equal? (dico-type (dico-name file)) "ksvg") | |
161 | + | (kanjivg-entry-count file)) | |
148 | 162 | ((equal? (dico-type (dico-name file)) "kanjidic") | |
149 | 163 | (kanjidic-entry-count file)) | |
150 | 164 | ((member (dico-type (dico-name file)) '("jmdict" "wadoku" "jibiki")) | |
… | |||
158 | 172 | (define (dico-lang name) | |
159 | 173 | (cond | |
160 | 174 | ((equal? name "radicals") "") | |
161 | - | ((equal? name "kanjidic") "") | |
175 | + | ((equal? name "kanjivg") "") | |
162 | 176 | ((equal? name "wadoku_pitch") "") | |
177 | + | ((and (> (string-length name) 8) (equal? (substring name 0 8) "kanjidic")) | |
178 | + | (substring name 9)) | |
163 | 179 | ((and (> (string-length name) 6) (equal? (substring name 0 6) "JMdict")) | |
164 | 180 | (let ((lang (substring name 7))) | |
165 | 181 | (match lang |