#! /usr/bin/perl -w
#
# usage: tategaki [-p] [--page] [-t TT] [-y YY] [--tate=TT] [--yoko=YY]
#
# tategaki v1.0 - a simple tategaki typesetter [1999-03-16]
#
# Copyright (C) 1999 Satoru Takabayashi <satoru-t@is.aist-nara.ac.jp>
#     All rights reserved.
#     This is free software with ABSOLUTELY NO WARRANTY.
#
# You can redistribute it and/or modify it under the terms of 
# the GNU General Public License version 2.
#
# ACKNOWLEDGEMENT:
#   * Tamakoshi Hiroki <hiroki-t@is.aist-nara.ac.jp>
#     this program is just a imitation of tategaki.el created by him.
#   * maeda@src.ricoh.co.jp (Kaoru MAEDA)
#     he gaves me great advice on kerning technic at fj.comp.lang.perl.
#
# This file must be encoded in EUC-JP encoding
#

require 5.005;
use strict;
use Getopt::Long;
# use NKF;

my $Version  = "1.0";
my $KANJI    = "[\xa1-\xfe][\xa1-\xfe]";
my $Column   = 20;
my $Line     = 20;
my $Page     = 0;
my %Tateyoko = ();
my %Hanzen   = ();
my %Offset   = ();

main();

sub main () {
    make_hash_table();
    parse_commandline();
    my $content = read_content();
    do_tategaki($content);
}

sub parse_commandline () {
    return unless @ARGV > 0;  # no option are given

    my $help    = 0;
    my $version = 0;
    Getopt::Long::Configure('bundling');
    GetOptions('t|tate=i'  => \$Column,
	       'y|yoko=i'  => \$Line,
	       'h|help'    => \$help,
	       'p|page'    => \$Page,
	       'v|version' => \$version,
	       );
    if ($help) {
	die "usage: tategaki [-p] [--page] [-t TT] [-y YY] [--tate=TT] [--yoko=YY]\n";
    }
    if ($version) {
	die "tategaki v$Version\n";
    }
}

sub read_content () {
    my $content = join '', <>;
#    $content = nkf("-e", $content);
    $content =~ s/^[ \t]+//mg;
    $content =~ s/\r\n/\n/g;  # DOS
    $content =~ s/\r/\n/g;    # Mac
    $content =~ s/($KANJI)\n($KANJI)/$1$2/go;
    $content =~ s/(\w)\n(\w)/$1 $2/g;
    $content =~ s/(?<=.)\n\n(?=.)/\n/g;  # using positive look behind :-)
    $content =~ s/(\n+)\n/$1/g;
    $content =~ s/\t/ /g;

    return $content;
}

sub do_tategaki ($) {
    my ($content) = @_;

    my @matrix = ();
    my $full = $Column * $Line - 1;
    for (my $i = 0; $content =~ /($KANJI|([\n\x20-\x7e]))/go;) {
	my $char = $1;
	if ($char eq "\n") {
	    $i = $Column * int($i / $Column + 1) - 1;
	} else {
	    $char = $Hanzen{$char}   if defined $2;
	    $char = $Tateyoko{$char} if defined $Tateyoko{$char};
	    $matrix[$i / $Column][$i % $Column] = $char;
	}
	if ($i == $full) {
	    print_tategaki(@matrix);
	    $i = 0;
	    @matrix = ();
	} else {
	    $i++;
	}
    }
    if (@matrix) {
	print_tategaki(@matrix);
    }
}

sub print_tategaki (@) {
    my @matrix = @_;
    for (my $x = 0; $x < $Column; $x++) {
        my @buf = (" ") x ($Line * 3 + 1);
        my $p = 1;
        for (my $y = $Line - 1; $y >= 0; $y--) {
            if (defined $matrix[$y][$x]) {
		my $char = $matrix[$y][$x];
                my $off  = defined $Offset{$char} ? $Offset{$char} : 0;
                $off = 0 unless $buf[$p + $off] eq ' ';
                splice(@buf, $p + $off, 2, ($char, ''));
            }
            $p += 3;
        }
        print @buf, "\n";
    }
    if ($Page) {
 	print "\n", " " x ($Line * 3 / 2 - 2), "- ", $Page++, " -\n\n";
    } else {
 	print "\n";
    }
}



sub make_hash_table () {
%Tateyoko =
    (
     "¡£" => "¡¬",
     "¡¥" => "¡¬",
     "¡¢" => "¡®",
     "¡¤" => "¡®",
     "¡¼" => "¡Ã",
     "¨¡" => "¡Ã",
     "¡Ý" => "¡Ã",
     "¡²" => "¡Ã",
     "¡Ã" => "¡½",
     "¢ª" => "¢­",
     "¢«" => "¢¬",
     "¢¬" => "¢ª",
     "¢­" => "¢«",
     "¡Ö" => "¨¤",
     "¡×" => "¨¦",
     "¡Ø" => "¨¯",
     "¡Ù" => "¨±",
     "¡ã" => "¢Ê",
     "¡ä" => "¢Ë",
     "¡Ò" => "¢Ê",
     "¡Ó" => "¢Ë",
     "¡§" => "¡Å",
     "¡Å" => "¡§",
     "¡Ä" => "¡§",
     "¡á" => "||",
     "¡Á" => "¢é",
     "¡Ê" => "¢Á",
     "¡Ë" => "¢À",
     "¡Å" => "¡§"
     );

%Offset = 
    (
     "¨¦" => -1,
     "¨±" => -1,
     "¡¬" => 1,
     "¡®" => 1,
     "¨¤" => 1,
     "¨¯" => 1,
     );

%Hanzen = 
    (
     " " => "¡¡",
     "!" => "¡ª",
     '"' => "¡É", # "
     "#" => "¡ô",
     "\$" => "¡ð",
     "%" => "¡ó",
     "&" => "¡õ",
     "'" => "¡Ç",
     "(" => "¡Ê",
     ")" => "¡Ë",
     "*" => "¡ö",
     "+" => "¡Ü",
     "," => "¡¤",
     "-" => "¡Ý",
     "." => "¡¦",  # "¡¥",
     "/" => "¡¿",
     "0" => "£°",
     "1" => "£±",
     "2" => "£²",
     "3" => "£³",
     "4" => "£´",
     "5" => "£µ",
     "6" => "£¶",
     "7" => "£·",
     "8" => "£¸",
     "9" => "£¹",
     ":" => "¡§",
     ";" => "¡¨",
     "<" => "¡ã",
     "=" => "¡á",
     ">" => "¡ä",
     "?" => "¡©",
     '@' => "¡÷",
     "A" => "£Á",
     "B" => "£Â",
     "C" => "£Ã",
     "D" => "£Ä",
     "E" => "£Å",
     "F" => "£Æ",
     "G" => "£Ç",
     "H" => "£È",
     "I" => "£É",
     "J" => "£Ê",
     "K" => "£Ë",
     "L" => "£Ì",
     "M" => "£Í",
     "N" => "£Î",
     "O" => "£Ï",
     "P" => "£Ð",
     "Q" => "£Ñ",
     "R" => "£Ò",
     "S" => "£Ó",
     "T" => "£Ô",
     "U" => "£Õ",
     "V" => "£Ö",
     "W" => "£×",
     "X" => "£Ø",
     "Y" => "£Ù",
     "Z" => "£Ú",
     "[" => "¡Î",
     "\\" => "¡ï",
     "]" => "¡Ï",
     "^" => "¡°",
     "_" => "¡²",
     "`" => "¡Æ",
     "a" => "£á",
     "b" => "£â",
     "c" => "£ã",
     "d" => "£ä",
     "e" => "£å",
     "f" => "£æ",
     "g" => "£ç",
     "h" => "£è",
     "i" => "£é",
     "j" => "£ê",
     "k" => "£ë",
     "l" => "£ì",
     "m" => "£í",
     "n" => "£î",
     "o" => "£ï",
     "p" => "£ð",
     "q" => "£ñ",
     "r" => "£ò",
     "s" => "£ó",
     "t" => "£ô",
     "u" => "£õ",
     "v" => "£ö",
     "w" => "£÷",
     "x" => "£ø",
     "y" => "£ù",
     "z" => "£ú",
     "{" => "¡Ð",
     "|" => "¡Ã",
     "}" => "¡Ñ",
     "~" => "¡±",
     );
}