#! /usr/bin/perl -w

#use encoding "iso-8859-1";
#use Encode;

sub mergestring ($$) {
    my @b = split(//,$_[0]);
    my @i = split(//,$_[1]);
    my @o = ();

    foreach $n (0..$#b) {
	if($n <= $#i) {
	    if($b[$n] eq $i[$n]) {
		$o[$n]=$b[$n];
	    } else {
		$o[$n]="$b[$n]:$i[$n]";
	    }
	} else {
	    $o[$n]="$b[$n]:<>";
	}
    }
    $n = $#b;
    if($n < $#i) {
	foreach $n ($#b+1 .. $#i) {
	    $o[$n]="<>:$i[$n]";
	}
    }
    return join('',@o);
}

sub parseline ($) {
    my $l = $_[0];
    my $t = "";
    
    if(/^\#/) {
	$t = "comment";
	
    } elsif(/^ *$/) {
	$t = "blank";
	
    } elsif(/^([0-9]*)r[0-9]*(<[a-zäåö ]*>)(.*)/) {
	$t = "entry"; # Main entry with base form and inflected forms
	($x, $y, $z) = ($1, $2, $3);
	$y =~ s/[åä]/a/;
	$y =~ s/[ö]/o/;
	
    } elsif(/^C?USTOM: ([yn]) ([yn])(.*)/) {
	$t = "custom"; # Hyphenation allowed? Compounding allowed? Compounding prefix forms
	($x, $y, $z) = ($1, $2, $3);
	
    } elsif(/^COMPOUND[(](.*)[)]: (.*)/) {
	$t = "compound"; # The compound parts and their indexes in the wordlist
	($x, $y, $z) = ($1, $2, "");
	
    } elsif(/^DEFINITION ([0-9]*): (.*)/) {
	$t = "definition"; # A semantic definition of the word
	($x, $y, $z) = ($1, $2, "");
	
    } elsif(/^STATUS: (OK|NOK)/) {
	$t = "status"; # Some status info (seems to be out of use)
	($x, $y, $z) = ($1, "", "");
	
    } elsif(/^BASEWORDS: (.*)/) {
	$t = "basewords"; # The compounding prefixes (Seems to be out of use)
	($x, $y, $z) = ($1, "", "");
	
    } else {
	$t = "unknown"; # Information of unexpected format
	print STDERR; print STDERR " <====\n";
    }
    
    return ($t,$x,$y,$z);
    ($t,$x,$y,$z) = ("","","","");

}

sub printwords ($$$) {
    my @bases=split(/, /,$_[0]);
    my @variants=split(/, /,$_[1]);
    my $t=$_[2];

    $t=~s/>/>:<>/g;
    foreach $base (@bases) {
	my $m="";
	foreach $vari (@variants) {
	    $m=mergestring($base,$vari);
	    print "$m$t\n";
	}
    }
}    

sub is_ok ($) {
    return defined $_[0] && $_[0] ne "" && $_[0] ne "!";
}


$id=0;
while(<>) {
    chomp;
    # s/ *$//;
    
    @l=parseline($_);
    $id++;

    if($l[0] eq "entry"){
	$wordclass=$l[2];
	@word=split(/:/,$l[3]);
	$word=$word[0];

	if(is_ok($word[0])) {
	    if($wordclass !~ /<adjektiv>|<substantiv>|<verb>|<deponens>|<egennamn>/) {
		printwords($word[0],$word[1],$wordclass) if(is_ok($word[1]));
		
	    } elsif($wordclass eq "<egennamn>") {
		printwords($word[0],$word[1],$wordclass."<nom>") if(is_ok($word[1]));
		printwords($word[0],$word[2],$wordclass."<gen>") if(is_ok($word[2]));
		
	    } elsif($wordclass eq "<deponens>") {
		printwords($word[0],$word[1],$wordclass."<infinitiv>") if(is_ok($word[1]));
		printwords($word[0],$word[2],$wordclass."<preteritum>") if(is_ok($word[2]));
		printwords($word[0],$word[3],$wordclass."<supinum>") if(is_ok($word[3]));
		printwords($word[0],$word[4],$wordclass."<presens>") if(is_ok($word[4]));
		printwords($word[0],$word[5],$wordclass."<imperativ>") if(is_ok($word[5]));
		
	    } elsif($wordclass eq "<verb>") {
		printwords($word[0],$word[1],$wordclass."<infinitiv><aktiv>") if(is_ok($word[1]));
		printwords($word[0],$word[2],$wordclass."<preteritum><aktiv>") if(is_ok($word[2]));
		printwords($word[0],$word[3],$wordclass."<supinum><aktiv>") if(is_ok($word[3]));
		printwords($word[0],$word[4],$wordclass."<presens><aktiv>") if(is_ok($word[4]));
		printwords($word[0],$word[5],$wordclass."<imperativ><aktiv>") if(is_ok($word[5]));
		printwords($word[0],$word[6],$wordclass."<infinitiv><passiv>") if(is_ok($word[6]));
		printwords($word[0],$word[7],$wordclass."<preteritum><passiv>") if(is_ok($word[7]));
		printwords($word[0],$word[8],$wordclass."<supinum><passiv>") if(is_ok($word[8]));
		printwords($word[0],$word[9],$wordclass."<presens><passiv>") if(is_ok($word[9]));
		printwords($word[0],$word[10],$wordclass."<perfekt_particip><utrum>") if(is_ok($word[10]));
		printwords($word[0],$word[11],$wordclass."<perfekt_particip><neutrum>") if(is_ok($word[11]));
		printwords($word[0],$word[12],$wordclass."<perfekt_particip><best/pl>") if(is_ok($word[12]));
		printwords($word[0],$word[13],$wordclass."<presens_particip>") if(is_ok($word[13]));
		printwords($word[0],$word[14],$wordclass."<konjunktiv>") if(is_ok($word[14]));
		
	    } elsif($wordclass eq "<adjektiv>") {
		printwords($word[0],$word[1],$wordclass."<pos><sg><utrum>") if(is_ok($word[1]));
		printwords($word[0],$word[2],$wordclass."<pos><sg><neutrum>") if(is_ok($word[2]));
		printwords($word[0],$word[3],$wordclass."<pos><sg><best>") if(is_ok($word[3]));
		printwords($word[0],$word[4],$wordclass."<pos><pl>") if(is_ok($word[4]));
		printwords($word[0],$word[5],$wordclass."<komp>") if(is_ok($word[5]));
		printwords($word[0],$word[6],$wordclass."<sup><obest>") if(is_ok($word[6]));
		printwords($word[0],$word[7],$wordclass."<sup><best>") if(is_ok($word[7]));
		printwords($word[0],$word[8],$wordclass."<mask>") if(is_ok($word[8]));

	    } elsif($wordclass eq "<substantiv>") {
		if(is_ok($word[3])) {
		    $genus = ($word[3] =~ /t$/) ? "<ne" : "<"; $genus .= "utrum>";
		} else {
		    $genus = "";
		};
		printwords($word[0],$word[1],$wordclass.$genus."<sg><obest><nom>") if(is_ok($word[1]));
		printwords($word[0],$word[2],$wordclass.$genus."<sg><obest><gen>") if(is_ok($word[2]));
		printwords($word[0],$word[3],$wordclass.$genus."<sg><best><nom>") if(is_ok($word[3]));
		printwords($word[0],$word[4],$wordclass.$genus."<sg><best><gen>") if(is_ok($word[4]));
		printwords($word[0],$word[5],$wordclass.$genus."<pl><obest><nom>") if(is_ok($word[5]));
		printwords($word[0],$word[6],$wordclass.$genus."<pl><obest><gen>") if(is_ok($word[6]));
		printwords($word[0],$word[7],$wordclass.$genus."<pl><best><nom>") if(is_ok($word[7]));
		printwords($word[0],$word[8],$wordclass.$genus."<pl><best><gen>") if(is_ok($word[8]));
	    }
	}
    } elsif($l[0] eq "custom"){
	# if($l[2] eq "y") {
	if(is_ok($l[3])) {
	    $wordclass="<prefix>";
	    $l[3]=~s/^ *//;
	    $l[3]=~s/ *$//;
	    @prefixes=split(/ /,$l[3]);
	    if($#prefixes >= 0) {
		foreach $prefix (@prefixes) {
		    printwords($prefix,$prefix,$wordclass);
		}
	    # } else {
	    #	printwords($word,$word,$wordclass) if(is_ok($word));
	    };
	}
    }
};
