modules/nani/jmdict/entities.scm modules/nani/frequency.scm \

        modules/nani/serialize.scm

include radicals.mk

  #:use-module (nani serialize)

;;; Nani Project website

;;; Copyright ?? 2020 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 radk)

  #:use-module (ice-9 match)

  #:use-module (ice-9 peg)

  #:use-module (ice-9 rdelim)

  #:use-module (nani serialize)

  #:use-module (rnrs bytevectors)

  #:use-module (sxml simple)

  #:export (parse-radk

            get-kanji-stroke

            get-rad-kanji

            get-rad-stroke

            serialize-radk))

(define-peg-pattern comment none (and "#" (* (or "\t" (range #\x20 #\x10ffff))) "\n"))

(define-peg-pattern space none " ")

(define-peg-pattern return none "\n")

(define-peg-pattern entry all

  (and (ignore "$") space char space num (? (and space name)) (ignore "\n")

       (+ (or char (ignore "\n")))))

(define-peg-pattern num all (+ (or (range #\0 #\9))))

(define-peg-pattern name none (+ (or (range #\0 #\9) (range #\a #\z) (range #\A #\Z))))

(define-peg-pattern char all (and (range #\xff #\x10ffff)))

(define-peg-pattern radk-doc body (* (or return comment entry)))

(define (parse-radk file)

  (peg:tree (match-pattern radk-doc (call-with-input-file file read-string))))

(define (get-rad-kanji content)

  (let loop ((result '()) (content content))

    (match content

      (() result)

      ((('entry ('char radical) ('num stroke) (('char kanji) ...)) content ...)

       (loop (cons (cons radical kanji) result)

             content)))))

(define (get-rad-stroke content)

  (let loop ((result '()) (content content))

    (match content

      (() result)

      ((('entry ('char radical) ('num stroke) (('char kanji) ...)) content ...)

       (loop (cons (cons radical (string->number stroke)) result)

             content)))))

(define (get-kanji-stroke file)

  (define strokes (xml->sxml (call-with-input-file file read-string)))

  (match strokes

    (('*TOP* _ ('kanjidic2 content ...))

     (map

       (lambda (entry)

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

                (misc (assoc-ref entry 'misc))

                (misc (filter list? misc))

                (stroke (car (assoc-ref misc 'stroke_count))))

           (cons literal (string->number stroke))))

       (filter

         (lambda (entry)

           (and

             (list? entry)

             (equal? (car entry) 'character)))

         content)))))

(define (serialize-radk rad-kanji rad-stroke kanji-stroke)

  (define (serialize-rad-kanji-element element pos bv)

    (match element

      ((radical kanji ...)

       (let* ((pos (serialize-string radical pos bv)))

         (serialize-list kanji serialize-string pos bv)))))

  (define (rad-kanji-element-size element)

    (match element

      ((radical kanji ...)

       (+ (string-size radical) (list-size kanji string-size)))))

  (define (serialize-rad-kanji rad-kanji pos bv)

    (serialize-list rad-kanji serialize-rad-kanji-element pos bv))

  (define (rad-kanji-size rad-kanji)

    (list-size rad-kanji rad-kanji-element-size))

  (define (serialize-rad-stroke-element element pos bv)

    (match element

      ((radical . stroke)

       (let ((pos (serialize-string radical pos bv)))

         (serialize-char stroke pos bv)))))

  (define (rad-stroke-element-size element)

    (match element

      ((radical . stroke)

       (+ (string-size radical) (char-size stroke)))))

  (define (serialize-rad-stroke rad-stroke pos bv)

    (serialize-list rad-stroke serialize-rad-stroke-element pos bv))

  (define (rad-stroke-size rad-stroke)

    (list-size rad-stroke rad-stroke-element-size))

  (define serialize-kanji-stroke serialize-rad-stroke)

  (define kanji-stroke-size rad-stroke-size)

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

         (header-size (bytevector-length header))

         (bv (make-bytevector (+ header-size 12

                                 (rad-kanji-size rad-kanji)

                                 (rad-stroke-size rad-stroke)

                                 (kanji-stroke-size kanji-stroke)))))

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

    (let* ((pos header-size)

           (pos (serialize-rad-kanji rad-kanji pos bv))

           (pos (serialize-rad-stroke rad-stroke pos bv))

           (pos (serialize-kanji-stroke kanji-stroke pos bv)))

      bv)))

;;; Nani Project website

;;; Copyright ?? 2020 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 serialize)

  #:use-module (rnrs bytevectors)

  #:export (merge-bvs

            serialize-list list-size

            serialize-pointer

            serialize-char char-size

            serialize-int int-size

            serialize-boolean boolean-size

            serialize-string string-size))

(define (merge-bvs bvs)

  (let* ((size (apply + (map bytevector-length bvs)))

         (bv (make-bytevector size 0)))

    (let loop ((bvs bvs) (pos 0))

      (unless (null? bvs)

        (let ((sz (bytevector-length (car bvs))))

          (bytevector-copy! (car bvs) 0 bv pos sz)

          (loop (cdr bvs) (+ pos sz)))))

    bv))

(define* (serialize-list lst serialize pos bv #:key (size? #t))

  (when (not (list? lst)) (throw 'not-list lst))

  (when size?

    (bytevector-u16-set! bv pos (length lst) (endianness big)))

  (let loop ((lst lst) (pos (+ pos (if size? 2 0))))

    (if (null? lst)

      pos

      (loop (cdr lst) (serialize (car lst) pos bv)))))

(define* (list-size lst size #:key (size? #t))

  (when (not (list? lst)) (throw 'not-list lst))

  (apply + (if size? 2 0) (map size lst)))

(define (serialize-pointer ptr pos bv)

  (bytevector-u8-set! bv pos (car ptr))

  (bytevector-u32-set! bv (+ pos 1) (trie-position (cdr ptr)) (endianness big))

  (+ pos 5))

(define (serialize-char int pos bv)

  (bytevector-u8-set! bv pos int)

  (+ pos 1))

(define char-size (const 1))

(define (serialize-int int pos bv)

  (bytevector-u32-set! bv pos int (endianness big))

  (+ pos 4))

(define int-size (const 4))

(define (serialize-boolean bool pos bv)

  (bytevector-u8-set! bv pos (if bool 1 0))

  (+ pos 1))

(define boolean-size (const 1))

(define (serialize-string str pos bv)

  (let ((sbv (string->utf8 str)))

    (bytevector-copy! sbv 0 bv pos (bytevector-length sbv))

    (bytevector-u8-set! bv (+ pos (bytevector-length sbv)) 0)

    (+ pos 1 (bytevector-length sbv))))

(define (string-size str)

  (let ((sbv (string->utf8 str)))

    (+ 1 (bytevector-length sbv))))

RADK_MODULES=tools/radk.scm modules/nani/radk.scm modules/nani/serialize.scm

dictionaries/kradzip.zip:

	wget ftp://ftp.monash.edu/pub/nihongo/kradzip.zip -O $@

dictionaries/radkfilex: dictionaries/kradzip.zip

	unzip $^ $$(basename $@) -d $$(dirname $@)

	touch $@

dictionaries/radkfilex.utf8: dictionaries/radkfilex

	iconv -f euc-jp -t utf-8 $^ > $@

dictionaries/kanjidic2.xml.gz:

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

dictionaries/kanjidic2.xml: dictionaries/kanjidic2.xml.gz

	gunzip $^

dicos/radicals.nani: tools/radk.scm dictionaries/radkfilex.utf8 dictionaries/kanjidic2.xml $(RADK_MODULES)

	guile -L modules tools/radk.scm build dictionaries/radkfilex.utf8 dictionaries/kanjidic2.xml $@

(define (print word dict)

  ())

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

  ((_ "print" word input)

   (print word input)))

;;; Nani Project website

;;; Copyright ?? 2019 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 radk))

(use-modules (ice-9 match))

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

(match (command-line)

  ((_ cmd radk-file kanjidic-file output)

   (cond

    ((equal? cmd "build")

     (let* ((radk (parse-radk radk-file))

            (rad-stroke (get-rad-stroke radk))

            (rad-kanji (get-rad-kanji radk))

            (kanji-stroke (get-kanji-stroke kanjidic-file)))

       (call-with-output-file output

         (lambda (port)

           (put-bytevector port

             (serialize-radk rad-kanji rad-stroke kanji-stroke))))))

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