#!/usr/bin/perl
# hiragana-0.1.1 by Ed Halley <ed@halley.cc> under Artistic License

package Hiragana;

=head1 NAME

hiragana - practice reading and writing the Hiragana Japanese characte
+rs

=head1 SYNOPSIS

To practice writing the hiragana, when you know the romaji syllables:

    %  hiragana  --write

To practice reading the hiragana:

    %  hiragana  --read

=head1 DOCUMENTATION

Grab a pad of paper and a pencil.  Run this script in C<--read> or
C<--write> mode, in any shell where C<Image::Magick> can use its
C<Display()> functionality (X, Win32, some framebuffer consoles, and
other environments.)

In C<--read> mode, you should read the randomly-selected hiragana
presented, and write down the romaji sounds they represent.  (You can 
+use
this opportunity to practice copying the hiragana themselves, too.)
Close the first window and the romaji will be shown to check your work
+.

In C<--write> mode, you should read the randomly-selected romaji
syllables, and write down the hiragana that represent those sounds.
Close the first window and the romaji and hiragana will be shown
together.

=cut

use utf8;
use strict;
use warnings;
use Image::Magick;

# Select from a number of installed fonts.
#
my $Font = 'futo mincho';
my %Fonts =
    (
      'futo gyosho' => 'epgyobld.ttf',
      'gyosho' => 'epgyosho.ttf',
      'kaisho' => 'epkaisho.ttf',
      'futo kakugo' => 'epkgobld.ttf',
      'kyokasho' => 'epkyouka.ttf',
      'marugo' => 'epmarugo.ttf',
      'futo mincho' => 'epminbld.ttf',
     );

# Unicode numbers for the various hiragana characters, selected by the
+ir
# romaji equivalents.  (Romaji are the same phonetic syllables spelled
# with Roman letters.  Some are not unique and some have multiple
# phonetic equivalences, due to the historic phonemes of the Japanese
# language.  The varieties in parentheses are smaller glyph versions u
+sed
# for stressing or altering the sounds of syllables.
#
my %Hiragana =
    ( 
      'a' => "\x{3042}", '(a)' => "\x{3041}",
      'i' => "\x{3044}", '(i)' => "\x{3043}",
      'u' => "\x{3046}", '(u)' => "\x{3045}",
      'e' => "\x{3048}", '(e)' => "\x{3047}",
      'o' => "\x{304A}", '(o)' => "\x{3049}",

      'ka' => "\x{304B}", 'ga' => "\x{304C}",
      'ki' => "\x{304D}", 'gi' => "\x{304E}",
      'ku' => "\x{304F}", 'gu' => "\x{3050}",
      'ke' => "\x{3051}", 'ge' => "\x{3052}",
      'ko' => "\x{3053}", 'go' => "\x{3054}",

      'sa' => "\x{3055}", 'za' => "\x{3056}", 'ja' => "\x{3056}",
      'shi' => "\x{3057}", 'zi' => "\x{3058}", 'ji' => "\x{3058}",
      'su' => "\x{3059}", 'zu' => "\x{305A}", 'ju' => "\x{305A}",
      'se' => "\x{305B}", 'ze' => "\x{305C}", 'je' => "\x{305C}",
      'so' => "\x{305D}", 'zo' => "\x{305E}", 'jo' => "\x{305E}",

      'ta' => "\x{305F}", 'da' => "\x{3060}",
      'chi' => "\x{3061}", 'di' => "\x{3062}",
      'tsu' => "\x{3064}", 'du' => "\x{3065}", '(tsu)' => "\x{3063}",
      'te' => "\x{3066}", 'de' => "\x{3067}",
      'to' => "\x{3068}", 'do' => "\x{3069}",

      'na' => "\x{306A}",
      'ni' => "\x{306B}",
      'nu' => "\x{306C}",
      'ne' => "\x{306D}",
      'no' => "\x{306E}",

      'ha' => "\x{306F}", 'ba' => "\x{3070}", 'pa' => "\x{3071}",
      'hi' => "\x{3072}", 'bi' => "\x{3073}", 'pi' => "\x{3074}",
      'hu' => "\x{3075}", 'bu' => "\x{3076}", 'pu' => "\x{3077}", 'fu'
+ => "\x{3075}",
      'he' => "\x{3078}", 'be' => "\x{3079}", 'pe' => "\x{307A}",
      'ho' => "\x{307B}", 'bo' => "\x{307C}", 'po' => "\x{307D}",

      'ma' => "\x{307E}",
      'mi' => "\x{307F}",
      'mu' => "\x{3080}",
      'me' => "\x{3081}",
      'mo' => "\x{3082}",

      'ya' => "\x{3084}", '(ya)' => "\x{3083}",
      'yu' => "\x{3086}", '(yu)' => "\x{3085}",
      'yo' => "\x{3088}", '(yo)' => "\x{3087}",

      'ra' => "\x{3089}",
      'ri' => "\x{308A}",
      'ru' => "\x{308B}",
      're' => "\x{308C}",
      'ro' => "\x{308D}",

      'wa' => "\x{308F}",
      'wi' => "\x{3090}",
      'we' => "\x{3091}",
      'wo' => "\x{3092}",

      'n' => "\x{3093}",
  );

# $utf8 = hiragana($romaji)
#
# Does a crude romaji->hiragana swap through the string.  Could handle
# more cases for general text, but works for this practice application
+.
#
sub hiragana
{
    my $text = shift;

    my @k = sort { length($b) <=> length($a) } keys %Hiragana;
    for (@k)
    {
        if ($text =~ /\Q$_\E/)
        {
            $text =~ s/\Q$_\E/$Hiragana{$_}/g;
            #{ no warnings; print "$_: $text\n"; }
        }
    }

    return $text;
}

#---------------------------------------------------------------------
+-------

# $image = plaque($text);
#
# Takes a UTF-8 string, returns a new Image::Magick image with black
# lettering on white, trimmed to the minimum fit with a small margin.
# Assumes ~/.fonts is where it can find the TTF files.  (Uses the
# filenames and not the font family, because some TTF font files use
# UTF-8 in fields which should not contain extended characters.)
#
sub plaque
{
    my $text = shift;
    my $font = shift || $Font;
    $font = $Fonts{$font} if exists $Fonts{$font};
    $font = "$ENV{HOME}/.fonts/$font" if -f "$ENV{HOME}/.fonts/$font";

    my $image = new Image::Magick;
    $image->Set(size => '1200x500');
    $image->Read('xc:white');
    $image->Set(fill => 'black');
    $image->Annotate(text => $text,
                     font => $font,
                     gravity => 'center',
                     pointsize => 30,
                     antialias => 'true',
                     encoding => 'UTF-8');
    $image->Crop(geometry => '0x0');
    $image->Frame(geometry => '10x10', fill => 'white');

    return $image;
}

# $image = stack( @images );
#
# Take a number of Image::Magick images and make a simple vertical sta
+ck
# of them all.  Finds the widest one and makes the target fit it.
#
sub stack
{
    my %placement = ();
    my $total = 0;
    my $widest = 0;
    my $count = 0;
    for (@_)
    {
        $placement{$count++} = [ $total, $_ ];
        $total += $_->Get('height');
        my $width = $_->Get('width');
        $widest = $width if $width > $widest;
    }

    my $image = new Image::Magick;
    $image->Set('size' => "${widest}x${total}");
    $image->Read('xc:white');
    for (sort { $a <=> $b } keys %placement)
    {
        $image->Composite(compose => 'Over',
                          image => $placement{$_}[1],
                          x => 0, y => $placement{$_}[0],
                          geometry => 'NorthWest');
    }

    return $image;
}

sub main
{
    # practice with just simple syllables
    my @syllables = grep { not /\W/ } keys %Hiragana;

    # pick a few 
    my @romaji = map { splice(@syllables, int(rand @syllables), 1) } 1
+..25;
    my $romaji = plaque("@romaji");
    my $hiragana = plaque(hiragana("@romaji"));

    if (grep { /read|romaji/ } @_)
    {
        $_ = stack(plaque("Read these hiragana, and " .
                          "write the romaji on paper:"),
                   $hiragana,
                   plaque("(close window to check your work)"));
        $_->Display();

        $_ = stack($hiragana, $romaji);
        $_->Display();
    }
    else
    {
        $_ = stack(plaque("Read these romaji, and " .
                          "write the hiragana on paper:"),
                   $romaji,
                   plaque("(close window to check your work)"));
        $_->Display();

        $_ = stack($romaji, $hiragana);
        $_->Display();
    }

    return 0;
}

exit(main(@ARGV));

__END__

=head1 LINKS

The ImageMagick tool suite, including Perl bindings, has a homepage:

http://www.imagemagick.org/

I found a series of suitable Unicode-ready TrueType fonts which will h
+elp
the practice.  Also nice to try practicing with a number of fonts to g
+et
used to the fancy brush styles and the more austere, gothic strokes.

http://www.travelphrases.info/gallery/Fonts_Japanese.html

Ippei Ukai also has a nice web-form Romaji/Kana converter that works i
+n
both directions.  This assumes your browser can use UTF-8 properly and
you have fonts that cover the proper character ranges.

http://homepage.mac.com/ippei_ukai/software/romaji/index.html

=head1 COPYRIGHT AND LICENSE

Copyright 1998-2005 by Ed Halley

This script is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

Even though this is a quick and dirty script, and every line is cruder
than I like, please offer your comments, criticisms, bug fixes, langua
+ge
corrections, etc.

=cut
[download]