#!/usr/bin/perl
#-*-Perl-*-

#--------------------------------------------------------#
$description =
"Syntax: tex2dn [options] [file...]

Tex2dn converts TeX files containing passages in Indian
languages using accented Roman script to follow the DN
Devanagari script conventions used by Frans Velthuis's
devnag and John Smith's jtex. By default it operates only
on passages beginning with `{\\dn' or `{\\jp' and ending
with a balancing `}', but it can be run `raw' on whole
files. If no input file is specified, tex2dn reads from
standard input.

-h option prints this help.
-r option invokes `raw' mode, i.e. processes the entire
          file rather than only passages inside {\\dn ... }
          or {\\jp ... }.
-s option removes spaces (but not newlines) between words
          when appropriate for printing Sanskrit text.
	  Suitable for verse.
-S option removes spaces and newlines between words
          when appropriate for printing Sanskrit text,
	  and attempts to re-wrap the text to avoid
	  excessively long lines. Suitable for prose.
";
#--------------------------------------------------------#

require 'getopts.pl';
Getopts(':rsSh');
if ($opt_h) {
    print STDERR $description;
    exit 1;
}

$nagari = 0;
$bracelevel = 0;

if ($opt_r) {
    while (<>) {
	print &tex2dn($_);
    }
}
else {
    while (<>) {
	&unpackage($_);
    }
}
exit 0;

sub unpackage {
    my ($string) = $_[0];
    if ($nagari) {
	if ($string !~ /[%}{\\]/) {
	    print &tex2dn($string);
	}
	elsif ($string =~ /^([^%}{\\]*)(\\[a-zA-Z]+)($|[^a-zA-Z])/) {
	    print &tex2dn($1);
	    print $2;
	    &unpackage ($3.$');
	}
	elsif ($string =~ /^[^%}{]*\\[^a-zA-Z][a-zA-Z] ?/) {
	    print &tex2dn($&);
	    &unpackage ($');
	}
	elsif ($string =~ /^([^}{%]*\{)/) {
	    print &tex2dn($&);
	    $bracelevel += 1;
	    &unpackage($');
	}
	elsif ($string =~ /^([^%}{]*\})/) {
	    print &tex2dn($&);
	    $bracelevel -= 1;
	    if ($bracelevel > 0) {
		&unpackage($');
	    }
	    else {
		$nagari = 0;
		&unpackage($');
	    }
	}
	elsif ($string =~ /^([^%}{]*)(%)/) {
	    print &tex2dn($1);
	    print $2 . $';
	}
	else {
	    print &tex2dn($string);
	}
    }
    else {
	if ($string =~ /^(.*?)(\{\\(dn|jp))($|[^a-zA-Z])/) {
	    print $1.$2;
	    $nagari = 1;
	    $bracelevel += 1;
	    &unpackage($4.$');
	}
	else {
	    print $string;
	}
    }
}

sub tex2dn {
    my ($string) = $_[0];
    $string = &nl($string) if $opt_S;
    $string = &sanskrit($string) if $opt_s;
    return $string if $string eq "";
    $string =~ tr/A-Z/a-z/;
    #
    # Now separate consecutive vowels with "{}". The key line
    # has to be repeated to catch all cases.
    #
    $string =~ s/(^|[^=!])ai/$1E/g;
    $string =~ s/(^|[^=!])au/$1O/g;
    $string =~ s/\\"([iu])/$1/g;
    $string =~ s/([aiueoEO])((\\[!=])?[aiueoEO])/$1\{\}$2/g;
    $string =~ s/([aiueoEO])((\\[!=])?[aiueoEO])/$1\{\}$2/g;
    $string =~ s/E/ai/g;
    $string =~ s/O/au/g;
    #
    # Sort out anusvara/avagraha combination
    #
    $string =~ s/([eo])( ?')\\\.m/$1\\.m$2/g;
    #
    $string =~ s/\\=([rl])/.\u$1/g;
    $string =~ s/\\=(.)/$1$1/g;
    $string =~ s/([aiueo]|\\\.m)\\\.([rl])/$1\u$2/g;
    $string =~ s/\\\././g;
    $string =~ s/\\:n/\"n/g;
    $string =~ s/\\~n/~n/g;
    $string =~ s/\\:m/\//g;
    $string =~ s/\\~(.)/$1.m/g unless $opt_s;
    $string =~ s/\\\'s/\"s/g;
    $string =~ s/\\!(.)/$1$1.m/g unless $opt_s;
    $string =~ s/ ?\'/.a/g;
    return $string;
}

sub sanskrit {
    #
    # Eliminate spaces after words that end in consonants
    #
    my ($string) = $_[0];
    return $string if $string eq "";
    my ($a, $b, $c, $d);
    if ($string =~ /(^[^\\]*)(\\[a-zA-Z]+)([^a-zA-Z])/) {
	($a, $b, $c, $d) = ($1, $2, $3, $');
	($string = $a) =~ s/([b-df-gj-lnp-tv-z]|[^.][mh]) +/$1/g;
	($string = $a) =~ s/(^[mh]) +/$1/g;
	$string .= $b . &sanskrit($c.$d);
    }
    else {
	$string =~ s/([b-df-gj-lnp-tv-z]|[^.][mh]) +/$1/g;
	$string =~ s/(^[mh]) +/$1/g;
    }
    return $string;
}

sub nl {
    #
    # Eliminate newlines and spaces after words that end in consonants
    #
    my ($string) = $_[0];
    my $nextline;
    return $string if $string eq "";
    if ($string =~ /([b-df-gj-lnp-tv-z]|[^.][mh])\n/m) {
	do {
	    $nextline = <>;
	    if ($nextline =~ /^[a-zA-Z\\]/) { chop $string }
	    $string .= $nextline;
	}
	until ($string !~ /([b-df-gj-lnp-tv-z]|[^.][mh])\n$/m);
    }
    $string = &sanskrit($string);
    return $string;
}
