kanjivg.scm
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))))) |
55 |