#! /usr/local/bin/perl --	# -*-Perl-*-
    eval "exec /usr/local/bin/perl -S $0 $*"
	if $running_under_some_shell;
#
#
# $Header$
#

@flagchars = 
    ("
", "", "", "", "", "", "", "",
     "", "", "", "", "", "", "", "", "", "", "",
     "", "", "", "", "", "", "", "!", "$", "%", "&",
      "'", "(", ")", "+", "/", "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", "{", "|", "}", "~" );


open (PFILE, "< paradigms");

while (<PFILE>) {		# läs paradigm filen
    if (/Nummer:\s+(\d+), paradigm:\s+(\d+), modellord: (.*)-(.*)/) {
	$nummer = $1;
	$pnummer = $2;
	$stam = $3;
	$suffix = $4;
	$suftab{$nummer} = $suffix;
    }
    elsif (/\s+(\S+)\s+(\S+)/) {
	$ord2 = $2;
	&ord($1);
	&ord($ord2);
    }
    elsif (/\s+(\S+)/) {
	&ord($1);
    }
}

while ( ($ord, $regler) = each %tabben ) {
    print "$regler:$ord\n";
    push(@listan, "$regler:$ord");
}

@listan = sort (@listan);

# listan är en sorterad lista på formen
#  ,paradigmnr1,paradigmnr2,...:transformation
#

# producera regler
system ("cat swedish.affh > swedish.aff");
open (RFILE, ">> swedish.aff");
select (RFILE);

$nr = 0;
$oldlist = "";

foreach (@listan) {
    /(.*):(.*)/;
    $regel = $2;
    if ($oldlist ne $1) {
	$oldlist = $1;
	++$nr;
	printf ("flag %s:\n", &flagga($nr));
	&ptabba($1);
    }
    printf ("  .  >  %s\n", $regel);
}

select (STDOUT);

print "Antal klasser $nr\n";

close (RFILE);

# Skriv ut översättnings tabellen  paradigmnr => flaggor
while ( ($p,$l) = each %ptabb ) {
    print ("$p: $l\n");
}

open (OFILE, "> swedish.0");
select (OFILE);

# översätt ordlistor
while (<>) {
    if (/(.*):(.*)/) {
	$flags = $ptabb{$2};
	$suffix = $suftab{$2};
	print ("$1$suffix/$flags\n");
    }
    else {
	print;
    }
}

close(OFILE);


## Subrutiner

sub ptabba {			# addera flagga $ne till paradigmen i @_
    local ($nlist) = @_;
    foreach ( split (/,/, $nlist) ) {
	$ptabb{$_} .= &flagga($nr) unless ($_ eq "");
    }
}

sub ord {			# addera ordet $ord till regel tabbelen
    local ($ord) = @_;
    if ( $ord =~ /-/ ) {
	return;
    }
    if ($ord =~ /(.*)\(s\)/) {
	$ord = $1;
	&ord($ord . "s");
    }
    if ( $ord =~ /^$stam$suffix/ ) {
	&tabba("\"$'\"") unless ($' eq "");

    }
    elsif ( $ord =~ /^$stam/ ) {
	$rest = $';
	$suff = $suffix;
	if ( substr($suffix, 0, 1) eq substr($rest, 0 ,1) ) {
	    $rest = substr($rest, 1);
	    $suff = substr($suffix, 1);
	}
	&tabba("-\"" . $suff . "\"," . ($rest eq "" ? "-" : "\"$rest\""));
    }
    elsif ( $ord eq "" ) {
	printf ("Blank\n");
    }
    else {
	printf ("Konstigt fall %s %s\n", $stam, $ord);
    }
}

sub tabba {			# addera paradigmnr till regel
    local ($regel) = @_;
    $tabben{$regel} .= ",$nummer";
}

sub flagga {
    $flagchars[@_[0]];
}