# -*- encoding: utf-8 -*-
#
# Copyright (C) 2016 Tomash Brechko.  All rights reserved.
#
# This file is part of GeekJDict.
#
# GeekJDict is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# GeekJDict 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 General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with GeekJDict.  If not, see <http://www.gnu.org/licenses/>.
#
package GeekJDict::Romaji;
use parent "Exporter";

use strict;
use warnings qw(all);
use utf8;


BEGIN {
    our @EXPORT_OK = qw(jconvert jconvert_last);
}


my @map = \my (%romaji, %hiragana, %katakana);


sub jconvert {
    my ($map, $text) = @_;

    $map = $map[$map];
    $text =~ s/(.{1,4})(?(?{ exists $map->{$1} })|(*FAIL))/ $map->{$1} /eg;

    return $text;
}


sub jconvert_last {
    my ($map, $text) = @_;

    $map = $map[$map];
    $text =~ s/(.{1,4})$(?(?{ exists $map->{$1} })|(*FAIL))/ $map->{$1} /e;

    return $text;
}


BEGIN {
    # Since we need lossless conversions romaji-hiragana-katakana both
    # ways we use Hepburn romanization
    # (https://en.wikipedia.org/wiki/Hepburn_romanization) mixed with
    # Nihon-shiki romanization
    # (https://en.wikipedia.org/wiki/Nihon-shiki_romanization), with
    # the following exceptions:
    #
    #   „Å¢ => dji (ji in Hepburn, di in Nihon-shiki)
    #   „Å• => dzu (zu in Hepburn, du in Nihon-shiki)
    #
    # We support „Çê (U+3090, wi), „Çë (U+3091, we), and „Çî (U+3094,
    # vu).  We do not support digraphs „Çü (U+309f, yori) and „Éø
    # (U+30ff, koto), as well as archaic õÄÅ (U+1b001, ye).
    %romaji = (
        # Plain.
        „ÅÇ =>  "a", „ÅÑ =>   "i", „ÅÜ =>   "u", „Åà =>  "e", „Åä =>  "o",
        „Åã => "ka", „Åç =>  "ki", „Åè =>  "ku", „Åë => "ke", „Åì => "ko",
        „Åï => "sa", „Åó => "shi", „Åô =>  "su", „Åõ => "se", „Åù => "so",
        „Åü => "ta", „Å° => "chi", „Å§ => "tsu", „Å¶ => "te", „Å® => "to",
        „Å™ => "na", „Å´ =>  "ni", „Å¨ =>  "nu", „Å≠ => "ne", „ÅÆ => "no",
        „ÅØ => "ha", „Å≤ =>  "hi", „Åµ =>  "fu", „Å∏ => "he", „Åª => "ho",
        „Åæ => "ma", „Åø =>  "mi", „ÇÄ =>  "mu", „ÇÅ => "me", „ÇÇ => "mo",
        „ÇÑ => "ya",              „ÇÜ =>  "yu",             „Çà => "yo",
        „Çâ => "ra", „Çä =>  "ri", „Çã =>  "ru", „Çå => "re", „Çç => "ro",
        „Çè => "wa", „Çê =>  "wi",              „Çë => "we", „Çí => "wo",
        „Çì => "n",

        # Voiced.
        „Åå => "ga", „Åé =>  "gi", „Åê =>  "gu", „Åí => "ge", „Åî => "go",
        „Åñ => "za", „Åò =>  "ji", „Åö =>  "zu", „Åú => "ze", „Åû => "zo",
        „Å† => "da", „Å¢ => "dji", „Å• => "dzu", „Åß => "de", „Å© => "do",
        „Å∞ => "ba", „Å≥ =>  "bi", „Å∂ =>  "bu", „Åπ => "be", „Åº => "bo",
                                 „Çî =>  "vu",

        # Plosive.
        „Å± => "pa", „Å¥ =>  "pi", „Å∑ =>  "pu", „Å∫ => "pe", „ÅΩ => "po",

        # Obsolete but occasionally seen.
        „Åè„Çé => "kwa",
        „Åê„Çé => "gwa",

        # Prolonged sound mark.
        „Éº => "--"
    );
    # Diphthongs.
    foreach my $mora (qw(„Åç       „Å´ „Å≤ „Åø „Çä „Åé       „Å≥ „Å¥)) {
        $romaji{"${mora}„ÇÉ"} = substr($romaji{$mora}, 0, -1) . "ya";
        $romaji{"${mora}„ÇÖ"} = substr($romaji{$mora}, 0, -1) . "yu";
        $romaji{"${mora}„Çá"} = substr($romaji{$mora}, 0, -1) . "yo";
    }
    foreach my $mora (qw(   „Åó „Å°                „Åò „Å¢      )) {
        $romaji{"${mora}„ÇÉ"} = substr($romaji{$mora}, 0, -1) . "a";
        $romaji{"${mora}„ÇÖ"} = substr($romaji{$mora}, 0, -1) . "u";
        $romaji{"${mora}„Çá"} = substr($romaji{$mora}, 0, -1) . "o";
    }
    # „Çì„ÅÇ => n'a, etc.
    foreach my $vowel (qw(„ÅÇ „ÅÑ „ÅÜ „Åà „Åä  „ÇÑ „ÇÜ „Çà)) {
        $romaji{"„Çì$vowel"} = "n'$romaji{$vowel}";
    }

    # Initialize hiragana.
    %hiragana = reverse %romaji;
    # „Çìa => „Å™, but „Çì'a => „Çì„ÅÇ, etc.
    foreach my $vowel (qw(a i u e o  ya yu yo)) {
        $hiragana{"„Çì$vowel"} = $hiragana{"n$vowel"};
        $hiragana{"„Çì'$vowel"} = "„Çì$hiragana{$vowel}";
    }

    # Initialize katakana.
    while (my ($romaji, $mora) = each %hiragana) {
        # In conversion from hiragana to katakana we depend on Unicode
        # layout, see http://www.unicode.org/charts/PDF/U3040.pdf and
        # http://www.unicode.org/charts/PDF/U30A0.pdf .
        $romaji =~ tr/\x{3041}-\x{3096}/\x{30a1}-\x{30f6}/;
        $mora =~   tr/\x{3041}-\x{3096}/\x{30a1}-\x{30f6}/;
        $katakana{$romaji} = $mora;
    }

    # Katakana digraphs from
    # https://en.wikipedia.org/wiki/Hepburn_romanization#Extended_katakana
    # (blue takes precedence over beige).
    $katakana{yi}   = "„Ç§„Ç£";
    $katakana{ye}   = "„Ç§„Çß";
    #$katakana{wa}   = "„Ç¶„Ç°";  # JMdict seems to use original wa and wo.
    $katakana{wi}   = "„Ç¶„Ç£";
    $katakana{wu}   = "„Ç¶„Ç•";
    $katakana{we}   = "„Ç¶„Çß";
    #$katakana{wo}   = "„Ç¶„Ç©";  # JMdict seems to use original wa and wo.
    $katakana{wyu}  = "„Ç¶„É•";
    $katakana{va}   = "„É¥„Ç°";
    $katakana{vi}   = "„É¥„Ç£";
    #$katakana{vu}   = "„É¥";  # This will come from hiragana conversion.
    $katakana{ve}   = "„É¥„Çß";
    $katakana{vo}   = "„É¥„Ç©";
    $katakana{vya}  = "„É¥„É£";
    $katakana{vyu}  = "„É¥„É•";
    $katakana{vye}  = "„É¥„Ç£„Çß";
    $katakana{vyo}  = "„É¥„Éß";
    $katakana{kye}  = "„Ç≠„Çß";
    $katakana{gye}  = "„ÇÆ„Çß";
    $katakana{kwa}  = "„ÇØ„Ç°";  # Hiragana table has different spelling („Åè„Çé).
    $katakana{kwi}  = "„ÇØ„Ç£";
    $katakana{kwe}  = "„ÇØ„Çß";
    $katakana{kwo}  = "„ÇØ„Ç©";
    $katakana{gwa}  = "„Ç∞„Ç°";  # Hiragana table has different spelling („Åê„Çé).
    $katakana{gwi}  = "„Ç∞„Ç£";
    $katakana{gwe}  = "„Ç∞„Çß";
    $katakana{gwo}  = "„Ç∞„Ç©";
    $katakana{she}  = "„Ç∑„Çß";
    $katakana{je}   = "„Ç∏„Çß";
    $katakana{si}   = "„Çπ„Ç£";
    $katakana{zi}   = "„Ç∫„Ç£";
    $katakana{che}  = "„ÉÅ„Çß";
    $katakana{tsa}  = "„ÉÑ„Ç°";
    $katakana{tsi}  = "„ÉÑ„Ç£";
    $katakana{tse}  = "„ÉÑ„Çß";
    $katakana{tso}  = "„ÉÑ„Ç©";
    $katakana{tsyu} = "„ÉÑ„É•";
    $katakana{ti}   = "„ÉÜ„Ç£";
    $katakana{tu}   = "„Éà„Ç•";
    $katakana{tyu}  = "„ÉÜ„É•";
    $katakana{di}   = "„Éá„Ç£";
    $katakana{du}   = "„Éâ„Ç•";
    $katakana{dyu}  = "„Éá„É•";
    $katakana{nye}  = "„Éã„Çß";
    $katakana{hye}  = "„Éí„Çß";
    $katakana{bye}  = "„Éì„Çß";
    $katakana{pye}  = "„Éî„Çß";
    $katakana{fa}   = "„Éï„Ç°";
    $katakana{fi}   = "„Éï„Ç£";
    $katakana{fe}   = "„Éï„Çß";
    $katakana{fo}   = "„Éï„Ç©";
    $katakana{fya}  = "„Éï„É£";
    $katakana{fyu}  = "„Éï„É•";
    $katakana{fye}  = "„Éï„Ç£„Çß";
    $katakana{fyo}  = "„Éï„Éß";
    $katakana{hu}   = "„Éõ„Ç•";
    $katakana{mye}  = "„Éü„Çß";
    $katakana{rye}  = "„É™„Çß";
    # Following five are not used in JMdcit (well, some of the above
    # too).  The problem with them is that fullwidth plosive mark
    # looks ugly, but halfwidth version is normalized not to fullwidth
    # version, but to combining version (U+309a), see
    # http://www.unicode.org/cldr/charts/latest/supplemental/character_fallback_substitutions.html
    #$katakana{la}   = "„É©„Çú"; # "„É©Ôæü";
    #$katakana{li}   = "„É™„Çú"; # "„É™Ôæü";
    #$katakana{lu}   = "„É´„Çú"; # "„É´Ôæü";
    #$katakana{le}   = "„É¨„Çú"; # "„É¨Ôæü";
    #$katakana{lo}   = "„É≠„Çú"; # "„É≠Ôæü";

    # Add small „Éµ and „É∂ as a special case.
    $katakana{xka}  = "„Éµ";
    $katakana{xke}  = "„É∂";

    # Add katakana to romaji map.
    while (my ($romaji, $mora) = each %katakana) {
        $romaji{$mora} = $romaji unless $romaji =~ /^[„Çì„É≥]/;
    }

    # Finally add hiragana and katakana geminates.
    my %geminate;
    while (my ($mora, $romaji) = each %romaji) {
        if ($romaji =~ /^([kstcgzjdhfbp])/) {
            my $geminate = "$1$romaji";
            if ($mora =~ /^\p{Hiragana}/) {
                $hiragana{$geminate} = "„Å£$mora";
                $geminate{"„Å£$mora"} = $geminate;
            } else {
                $katakana{$geminate} = "„ÉÉ$mora";
                $geminate{"„ÉÉ$mora"} = $geminate;
            }
        }
    }
    @romaji{keys %geminate} = values %geminate;
}


1
