#!/usr/bin/perl -w
# spellai 0.4.2
# 
# Skriptukas naujiems lietuvikiems ispell odynams sudarinti. Skaito odius,
# ir jeigu neapibrti jokie flagai, isiaikina, koki reikia.
#
# Vartojimas:
# spellai                       # skaito odius i klaviatros, veda  ekran
# spellai odynas               # skaito i failo odynas, veda i ekran
# spellai odynas > geresnis    # skaito i 'odynas', rao  'geresnis'
#
# daniausiai turt bti naudojamas 3 atvejis - su ispell'u surinktiems
# neinomiems odiams sutvarkyti. Kiekvienkart  asmenin odyn djs
# odi, kad turtum gerai veikiant odyn, paleisk 
#  
# spellai ~/.ispell_default > sutvarkyti ; mv sutvarkyti ~/.ispell_default
#
# Para Gediminas Paulauskas <menesis@delfi.lt>, patobulins skriptus i
# Alberto Agejevo <alga@uosis.mif.vu.lt> bei Mariaus Gedmino <mgedmin@delfi.lt>.
#
# TODO:
# * daugiau intelekto atspjant odi formas
# * parametrais nurodomos vesties/ivesties bylos 
# * naudoti ispell' patikrinimui, gal jau toks odis yra odyne 
#   reikia tam, jei atnaujinant odynus i kitur, tie patys odiai buvo
#   vartotojo asmeniniam odyne.
# * --help

#             api ati
#             ap  at   i nu pa par per pra pri su u
# be nieko     a   b  c  d  e  f  g   h   i   j   k  l
# su sangra  m   n  o	 p  q  r  s   t   u   v   w  x

%prefix = (
     c => "",		d => "i",		e => "nu",
     f => "pa",		g => "par",		h => "per",
     i => "pra",	j => "pri",		k => "su",
     l => "u",		m => "apsi",	n => "atsi",
     o => "si",	p => "isi",	q => "nusi",
     r => "pasi",	s => "parsi",	t => "persi",
     u => "prasi",	v => "prisi",	w => "susi",
     x => "usi"
);

sub jeigu
{
    my ($q, $def) = @_;
    my $question;
    if (defined $def) {
	    $def = $def ? "t" : "n";
    	$question = "$q (t/n) [$def]: ";
    } else {
	    $question = "$q (t/n): ";
    }
    my $answer = "";
    while ($answer !~ /[ntNT]/) {
        print $question;
        chomp($answer = <>);
	    if ($answer eq "" and defined $def) {
    	    $answer = $def;
	    }
    };
    return $answer ne "n";
}

local $flags;

sub veiksmazodis {
    print "=== Veiksmaodis ===\n";
    print "veskite pagrindines formas, be joki priedli ir sangros dalelyi.\n";
    my ($bend, $es, $but);
    $es = $_[0];
    print "Bendratis [$es]: ";
    chomp ($bend = <STDIN>);
    $bend = $es if $bend eq "";
    while ($bend !~ /ti$/)  {
    	print "*** Tai ne bendratis!\n vesk bendrat: ";
        chomp ($bend = <STDIN>);
    }

    print "Esamasis laikas (k daro?): ";
    chomp ($es = <STDIN>);
    print "Btasis kartinis (k dar?): ";
    chomp ($but = <STDIN>);
    
    foreach $i (keys (%prefix), 'a[pt]', 'a[pt]i') {
        $prefix = ($i =~ /^a\[/) ? $i : $prefix{$i};
        next unless ($bend =~ /^$prefix(.*)/); 
        local $sb = $1;
        next unless ($es =~ /^$prefix(.*)/); 
        local $se = $1;
        next unless ($but =~ /^$prefix(.*)/); 
        local $su = $1;
        if (jeigu ("\n*** O gal visgi $sb, $se, $su?", 1)) {
	        print "*** nagrinjam veiksmaod $sb\n";
	    	$bend = $sb; $es = $se; $but = $su;
			last;
		}
    }
    
    $flags .= jeigu ("${bend}s, ${es}si, ${but}si?", 1) ? 'SX' : 'NX';

    $pref = ($bend =~ /^[bpBP]/) ? 'api' : 'ap';
    $flags .= 'a' if jeigu ("$pref$bend, $pref$es, $pref$but?", 1);
    
    $pref = ($bend =~ /^[dtDT]/) ? 'ati' : 'at';
    $flags .= 'b' if jeigu ("$pref$bend, $pref$es, $pref$but?", 1);
    
    foreach $i (sort keys %prefix) {
        $pref = $prefix{$i};
        $flags .= $i if jeigu ("$pref$bend, $pref$es, $pref$but?", 1);
    }

    if ($bend =~ /[y]ti$/ and
        $es =~ /[y].a$/ and
        $but =~ /[ui].o$/) {
        $bf = "U";
    } else {
        $bf = "T";
    }
    
    select STDOUT;
    print "$bend/$bf$flags\n";
    print "$es/E$flags\n";
    if ($bend =~ /yti$/){
        print "$but/Y$flags\n";
    } else {
        print "$but/P$flags\n";
    }
    if ($flags =~ /S/) {
        print "${bend}s/$bf\n";
        print "${es}si/E\n";
        if ($bend =~ /yti$/){
            print "${but}si/Y\n";
        } else {
    	    print "${but}si/P\n";
        }
    }
    select STDERR;
    print "====================\n";
}    # veiksmaodio pabaiga

sub daiktavardis {
    $word = $_[0];
    print "=== Daiktavardis ===\n";
    print "veskite vardinink [$word]: ";
    chomp ($_ = <STDIN>);
    $word = $_ if $_;

    if ($word !~ /(.*)(is|uo)$/i) {
        $flags = 'D'
    } else {
        my ($sak, $gal) = ($1, $2);
	    $sak =~ s/t$//;
    	$sak =~ s/d$/d/;
        if ($gal eq 'is' and
            jeigu ("Ar vienaskaitos ko? atsakymas yra ${sak}io?", 1)) {
	        $flags = 'D'
    	} else {
            $flags = jeigu ("Ar vyrikos gimins?", 1) ? 'V' : 'M';
            $flags .= jeigu ("Ar galn minkta (${sak}i)?", 1) ? 'I' : 'K';
    	}
    }

    $flags .= 'N' if jeigu ("Ar yra toks daiktas ne$word?", 0);

    print STDOUT "$word/$flags\n";
    print "====================\n";

}    # daiktavardio pabaiga

sub budvardis {
    my ($kokyb, $ivardz);
    $word = $_[0];
    print "==== Bdvardis =====\n";
    print "veskite vardinink [$word]: ";
    chomp ($_ = <STDIN>);
    $word = $_ if $_;

    $word =~ /(.*)(.)s$/i;
	$kokyb = $2 ne 'i';
    if (jeigu ("Ar tai kokybinis bdvardis (kaip $1$2; ${word}is; turi laipsnius)?", $kokyb))
    {
        $flags = 'AQ';
    } else {
        my ($sak, $gal) = ($1, $2);
        $sak =~ s/t$//;
	    $sak =~ s/d$/d/;
        $flags = jeigu ("Ar tai santykinis bdvardis (kokiems - ${sak}iams)?", 1) ? 'B' : 'A' 
    }
    
    $flags .= 'N' if jeigu ("ar gali bti ne$word?", $kokyb);
    print STDOUT "$word/$flags\n";
    print "====================\n";

}    # bdvardio pabaiga

select STDERR;
print "Programa, generuojanti reikalingus raus  ispell'o odyn\n";
print "I jos ieinama, kai paklausus odio dalies, vedi 'q'\n";
print "====================\n";

if (@ARGV) {
    $ARGV = shift;
} else {
    $ARGV = '-';   # STDIN
}
$KLAUSTI = $ARGV eq '-';
open (BYLA, $ARGV) or warn "Negaliu atidaryti $ARGV: $!\n";

print "veskite od (^D baigti): " if $KLAUSTI;
while ($word = <BYLA>) {
    if ($word =~ /^[\s#]+/         # komentarai ir tuios eiluts
        or $word =~ /.\/./) {       # jau turi flagus, nenagrinti
        print STDOUT $word;
    	next;
    }
    print $word;
    chomp $word;
    $flags = '';

    do  {
    	print "Tai daiktavardis, veiksmaodis, bdvardis ar nekaitomas odis? (d/v/b/n) [n] ";
        chomp ($_ = <STDIN>);
	    $_ = 'n' if $_ eq '';
    } until /^[dvbnqr]$/i;

    if    (/v/i) { veiksmazodis ($word) }
    elsif (/d/i) { daiktavardis ($word) }
    elsif (/b/i) { budvardis    ($word) }
    elsif (/q/i) { 
        print "Baigiam darb... Suliek rezultatus ir duomenis  vien byl\n";
    	last 
    }
    elsif (/r/i) { 
        print "Itrinu od $word\n";
        print "====================\n";
	    next
    }
    else {
        print "==== Nekaitomas ====\n";
        print STDOUT $word, "\n";
        print "====================\n";
    }
    print "veskite od (^D baigti): " if $KLAUSTI;
}

print "\nIki!\n";

# vim: ts=4 sw=4 expandtab
# EOF
