include jibiki.mk

include jmdict.mk

include kanjidic.mk

	rm -f $@

KANJIDIC_LANGS=en es fr pt

KANJIDIC_MODULES=tools/kanjidic.scm

DICOS+=$(addprefix dicos/kanjidic_, $(addsuffix .nani, $(KANJIDIC_LANGS)))

DOWNLOADS+=dictionaries/kanjidic2.xml

dictionaries/kanjidic2.xml:

	wget http://www.edrdg.org/kanjidic/kanjidic2.xml.gz -O $@.gz

	gunzip $@.gz

dicos/kanjidic_%.nani: dictionaries/kanjidic2.xml tools/kanjidic.scm $(RADK_MODULES)

	guile -L modules tools/kanjidic.scm build $< $(shell basename $@ .nani | sed 's|^kanjidic_||g') $@

;;; Nani Project website

;;; Copyright ?? 2021 Julien Lepiller <julien@lepiller.eu>

;;;

;;; This file is part of the Nani Project website.

;;;

;;; The Nani Project website is free software; you can redistribute it and/or modify it

;;; under the terms of the GNU Affero General Public License as published by

;;; the Free Software Foundation; either version 3 of the License, or (at

;;; your option) any later version.

;;;

;;; The Nani Project website is distributed in the hope that it will be useful, but

;;; WITHOUT ANY WARRANTY; without even the implied warranty of

;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

;;; GNU Affero General Public License for more details.

;;;

;;; You should have received a copy of the GNU Affero General Public License

;;; along with the Nani Project website.  If not, see <http://www.gnu.org/licenses/>.

(define-module (nani kanji kanjidic)

  #:use-module (ice-9 binary-ports)

  #:use-module (ice-9 match)

  #:use-module (ice-9 rdelim)

  #:use-module (nani encoding huffman)

  #:use-module (nani encoding parse)

  #:use-module (nani encoding serialize)

  #:use-module (nani encoding trie)

  #:use-module (rnrs bytevectors)

  #:use-module (srfi srfi-1)

  #:use-module (srfi srfi-9)

  #:use-module (sxml simple)

  #:export (make-kanji

            kanji?

            kanji-position

            kanji-kanji

            kanji-strokes

            kanji-senses

            kanji-kun

            kanji-on

            kanji-nanori

            get-kanji-info

            serialize-kanji kanji-size

            serialize-kanjidic

            kanjidic-entry-count))

(define-record-type <kanji>

  (make-kanji position kanji strokes senses kun on nanori)

  kanji?

  (position kanji-position kanji-position-set!)

  (kanji    kanji-kanji)

  (strokes  kanji-strokes)

  (senses   kanji-senses)

  (kun      kanji-kun)

  (on       kanji-on)

  (nanori   kanji-nanori))

(define (sxml->on sxml)

  (match sxml

    (('reading ('@ ('r_type "ja_on")) reading) reading)

    (_ #f)))

(define (sxml->kun sxml)

  (match sxml

    (('reading ('@ ('r_type "ja_kun")) reading) reading)

    (_ #f)))

(define (sxml->nanori sxml)

  (match sxml

    (('nanori nanori) nanori)

    (_ #f)))

(define (sxml->sense lang)

  (lambda (sxml)

    (match sxml

      (('meaning meaning) (if (equal? lang "en") meaning #f))

      (('meaning ('@ ('m_lang m_lang)) meaning)

       (if (equal? lang m_lang) meaning #f))

      (_ #f))))

(define (sxml->kanji lang)

  (lambda (entry)

    (let* ((literal (car (assoc-ref entry 'literal)))

           (misc (assoc-ref entry 'misc))

           (misc (filter list? misc))

           (strokes (string->number (car (assoc-ref misc 'stroke_count))))

           (rm (assoc-ref entry 'reading_meaning)))

      (if rm

          (let* ((rm (filter list? rm))

                 (rmgroup (assoc-ref rm 'rmgroup))

                 (rmgroup (filter list? rmgroup))

                 (on (filter-map sxml->on rmgroup))

                 (kun (filter-map sxml->kun rmgroup))

                 (senses (filter-map (sxml->sense lang) rmgroup))

                 (nanori (filter-map sxml->nanori rm)))

            (make-kanji 0 literal strokes senses kun on nanori))

          #f))))

(define (get-kanji-info file lang)

  (let* ((dic (xml->sxml (call-with-input-file file read-string)))

         (kanjis (match dic (('*TOP* _ ('kanjidic2 content ...)) content))))

    (filter-map (sxml->kanji lang)

                (filter

                  (match-lambda

                    (('character _ ...) #t)

                    (_ #f))

                  kanjis))))

(define (serialize-kanji sense-huffman reading-huffman)

  (lambda (kanji pos bv)

    (kanji-position-set! kanji pos)

    (let* ((pos (serialize-char (kanji-strokes kanji) pos bv))

           (pos ((serialize-list (serialize-huffman-string sense-huffman))

                 (kanji-senses kanji) pos bv))

           (pos ((serialize-list (serialize-huffman-string reading-huffman))

                 (kanji-kun kanji) pos bv))

           (pos ((serialize-list (serialize-huffman-string reading-huffman))

                 (kanji-on kanji) pos bv))

           (pos ((serialize-list (serialize-huffman-string reading-huffman))

                 (kanji-nanori kanji) pos bv)))

      pos)))

(define (kanji-size sense-huffman reading-huffman)

  (lambda (kanji)

    (+ (char-size (kanji-strokes kanji))

       ((list-size (huffman-string-size sense-huffman))

        (kanji-senses kanji))

       ((list-size (huffman-string-size reading-huffman))

        (kanji-kun kanji))

       ((list-size (huffman-string-size reading-huffman))

        (kanji-on kanji))

       ((list-size (huffman-string-size reading-huffman))

        (kanji-nanori kanji)))))

(define (update-trie-pos! trie kanji)

  (let* ((vals (trie-vals trie))

         (vals (map (lambda (i) (kanji-position (array-ref kanji i))) vals)))

    (trie-vals-set! trie vals))

  (for-each

    (match-lambda

      ((char . child)

       (update-trie-pos! child kanji)))

    (trie-transitions trie)))

(define (make-key key)

  (apply append

    (map (lambda (c)

           (list (quotient c 16) (modulo c 16)))

         (bytevector->u8-list (string->utf8 key)))))

(define (make-kanji-trie kanji)

  (let ((trie (make-empty-trie)))

    (let loop ((kanji kanji) (i 0))

      (if (null? kanji)

          (compress-trie trie)

          (begin

            (add-to-trie! trie (make-key (kanji-kanji (car kanji))) i)

            (loop (cdr kanji) (+ i 1)))))))

(define (serialize-kanjidic kanji)

  (define sense-huffman

    (let* ((senses (apply append (map kanji-senses kanji))))

      (create-huffman senses)))

  (define sense-huffman-code (huffman->code sense-huffman))

  (define reading-huffman

    (let* ((kun (apply append (map kanji-kun kanji)))

           (on (apply append (map kanji-on kanji)))

           (nanori (apply append (map kanji-nanori kanji))))

      (create-huffman (append kun on nanori))))

  (define reading-huffman-code (huffman->code reading-huffman))

  (let* ((header (string->utf8 "NANI_KANJIDIC001"))

         (header-size (bytevector-length header))

         (sense-huffman-bv (serialize-huffman sense-huffman))

         (sense-huffman-size (bytevector-length sense-huffman-bv))

         (reading-huffman-bv (serialize-huffman reading-huffman))

         (reading-huffman-size (bytevector-length reading-huffman-bv))

         (serialize-trie (serialize-trie serialize-int int-size))

         (trie-size (trie-size int-size))

         (kanji-trie (make-kanji-trie kanji))

         (kanji-trie-size (trie-size kanji-trie))

         (results-size

           ((list-size (kanji-size sense-huffman-code reading-huffman-code)

                       #:size? #f)

            kanji))

         (huffman-size (+ sense-huffman-size reading-huffman-size))

         (bv (make-bytevector (+ header-size 4 huffman-size kanji-trie-size

                                 results-size))))

    (format #t "Number of kanji: ~a~%" (length kanji))

    ((serialize-list (serialize-kanji sense-huffman-code reading-huffman-code)

                     #:size? #f)

     kanji (+ header-size 4 huffman-size kanji-trie-size) bv)

    (let ((kanji (list->array 1 kanji)))

      (update-trie-pos! kanji-trie kanji))

    (bytevector-copy! header 0 bv 0 header-size)

    (serialize-int (length kanji) (+ header-size) bv)

    (bytevector-copy! sense-huffman-bv 0 bv (+ header-size 4)

                      sense-huffman-size)

    (bytevector-copy! reading-huffman-bv 0 bv (+ header-size 4 sense-huffman-size)

                      reading-huffman-size)

    (serialize-trie kanji-trie (+ header-size 4 huffman-size) bv)

    bv))

(define (kanjidic-entry-count file)

  (call-with-input-file file

    (lambda (port)

      (let* ((header (get-bytevector-n port 16))

             (size (get-bytevector-n port 4)))

        (bytevector-u32-ref size 0 (endianness big))))))

RADK_MODULES=tools/radk.scm

DOWNLOADS+=dictionaries/radkfilex.utf8

;;; Nani Project website

;;; Copyright ?? 2021 Julien Lepiller <julien@lepiller.eu>

;;;

;;; This file is part of the Nani Project website.

;;;

;;; The Nani Project website is free software; you can redistribute it and/or modify it

;;; under the terms of the GNU Affero General Public License as published by

;;; the Free Software Foundation; either version 3 of the License, or (at

;;; your option) any later version.

;;;

;;; The Nani Project website is distributed in the hope that it will be useful, but

;;; WITHOUT ANY WARRANTY; without even the implied warranty of

;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

;;; GNU Affero General Public License for more details.

;;;

;;; You should have received a copy of the GNU Affero General Public License

;;; along with the Nani Project website.  If not, see <http://www.gnu.org/licenses/>.

(use-modules (nani kanji kanjidic))

(use-modules (ice-9 match))

(use-modules (ice-9 binary-ports))

(match (command-line)

  ((_ cmd kanjidic-file lang output)

   (cond

    ((equal? cmd "build")

     (let* ((kanji (get-kanji-info kanjidic-file lang)))

       (call-with-output-file output

         (lambda (port)

           (put-bytevector port

             (serialize-kanjidic kanji))))))

    (else (format #t "Unknown cmd ~a.~%" cmd)))))

(use-modules (nani kanji kanjidic))

  (define (kanjidic-synopsis lang)

    (match lang

      ("en" `(_ "Kanji dictionary with English meanings."))

      ("es" `(_ "Kanji dictionary with Spanish meanings."))

      ("fr" `(_ "Kanji dictionary with French meanings."))

      ("pt" `(_ "Kanji dictionary with Portuguese meanings."))))

  (define (kanjidic-description lang)

    `(_ "This dicitonary allows you to search for kanji and view kanji information

such as number of strokes, pronunciations and meanings."))

            ((equal? (dico-type dico) "kanjidic")

             (let ((dico-lang (substring dico 9)))

               (if long?

                   (kanjidic-description dico-lang)

                   (kanjidic-synopsis dico-lang))))

    ((equal? file "kanjidic") "kanjidic")

    ((equal? (dico-type (dico-name file)) "kanjidic")

     (kanjidic-entry-count file))

(define (dico-lang name)

  (cond

    ((equal? name "radicals") "")

    ((equal? name "kanjidic") "")

    ((equal? name "wadoku_pitch") "")

    ((and (> (string-length name) 6) (equal? (substring name 0 6) "JMdict"))

     (let ((lang (substring name 7)))

       (match lang

         ("e" "en")

         ("dut" "nl")

         ("fre" "fr")

         ("ger" "de")

         ("hun" "hu")

         ("rus" "ru")

         ("slv" "sl")

         ("spa" "es")

         ("swe" "sv"))))

    ((equal? name "jibiki_fre") "fr")

    ((equal? name "wadoku_ger") "de")))

                  (lang (dico-lang name))

             (format #t "lang=~a~%" lang)