#!/usr/bin/perl -w
# spellai 0.4.2
# 
# Skriptukas naujiems lietuviškiems ispell žodynams sudarinėti. Skaito žodžius,
# ir jeigu neapibrėžti jokie flagai, išsiaiškina, kokių reikia.
#
# Vartojimas:
# spellai                       # skaito žodžius iš klaviatūros, veda į ekraną
# spellai žodynas               # skaito iš failo žodynas, veda i ekraną
# spellai žodynas > geresnis    # skaito iš 'žodynas', rašo į 'geresnis'
#
# dažniausiai turėtų būti naudojamas 3 atvejis - su ispell'u surinktiems
# nežinomiems žodžiams sutvarkyti. Kiekvienąkart į asmeninį žodyną įdėjęs
# žodžių, kad turėtum gerai veikiantį žodyną, paleisk 
#  
# spellai ~/.ispell_default > sutvarkyti ; mv sutvarkyti ~/.ispell_default
#
# Parašė Gediminas Paulauskas <menesis@delfi.lt>, patobulinęs skriptus iš
# Alberto Agejevo <alga@uosis.mif.vu.lt> bei Mariaus Gedmino <mgedmin@delfi.lt>.
#
# TODO:
# * daugiau intelekto atspėjant žodžių formas
# * parametrais nurodomos įvesties/išvesties bylos 
# * naudoti ispell'ą patikrinimui, gal jau toks žodis yra žodyne 
#   reikia tam, jei atnaujinant žodynus iš kitur, tie patys žodžiai 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 sangrąža  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 => "išsi",	q => "nusi",
     r => "pasi",	s => "parsi",	t => "persi",
     u => "prasi",	v => "prisi",	w => "susi",
     x => "užsi"
);

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 "=== Veiksmažodis ===\n";
    print "Įveskite pagrindines formas, be jokių priešdėlių ir sangrąžos dalelyčių.\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 "Būtasis 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 "*** nagrinėjam veiksmažodį $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";
}    # veiksmažodžio 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 vyriškos giminės?", 1) ? 'V' : 'M';
            $flags .= jeigu ("Ar galūnė minkšta (${sak}ių)?", 1) ? 'I' : 'K';
    	}
    }

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

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

}    # daiktavardžio pabaiga

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

    $word =~ /(.*)(.)s$/i;
	$kokyb = $2 ne 'i';
    if (jeigu ("Ar tai kokybinis būdvardis (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 būdvardis (kokiems - ${sak}iams)?", 1) ? 'B' : 'A' 
    }
    
    $flags .= 'N' if jeigu ("ar gali būti ne$word?", $kokyb);
    print STDOUT "$word/$flags\n";
    print "====================\n";

}    # būdvardžio pabaiga

select STDERR;
print "Programa, generuojanti reikalingus įrašus į ispell'o žodyną\n";
print "Iš jos išeinama, kai paklausus žodžio 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 tuščios eilutės
        or $word =~ /.\/./) {       # jau turi flagus, nenagrinėti
        print STDOUT $word;
    	next;
    }
    print $word;
    chomp $word;
    $flags = '';

    do  {
    	print "Tai daiktavardis, veiksmažodis, būdvardis 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 "Ištrinu ž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
