#!/usr/bin/perl

$desc=<<EOD;
Intransitive: Tnx0V
Ergative: TEnx1V
Transitive: Tnx0Vnx1
Ditransitive: Tnx0Vnx2nx1
Ditransitive with PP: Tnx0Vnx1pnx2
Multiple anchor ditransitive with PP: Tnx0Vnx1Pnx2
Sentential Complement with NP: Tnx0Vnx1s2
Intransitive Verb Particle: Tnx0Vpl
Transitive Verb Particle: Tnx0Vplnx1
Ditransitive Verb Particle: Tnx0Vplnx2nx1
Intransitive with PP: Tnx0Vpnx1
Multiple anchor PP complement: Tnx0VPnx1
Sentential Complement: Tnx0Vs1
Intransitive with Adjective: Tnx0Vax1
Transitive Sentential Subject: Ts0Vnx1
Light Verbs: Tnx0lVN1
Ditransitive Light Verbs with PP Shift: Tnx0lVN1Pnx2
NP It-Cleft: TItVnx1s2
PP It-Cleft: TItVpnx1s2
Adverb It-Cleft: TItVad1s2
Adjective Small Clause Tree: Tnx0Ax1
Adjective Small Clause with Sentential Complement: Tnx0A1s1
Adjective Small Clause with Sentential Subject: Ts0Ax1
Equative BE: Tnx0BEnx1
NP Small Clause: Tnx0N1
NP Small Clause with Sentential Complement: Tnx0N1s1
NP Small Clause with Sentential Subject: Ts0N1
PP Small Clause: Tnx0Pnx1
Exhaustive PP Small Clause: Tnx0Px1
PP Small Clause with Sentential Subject: Ts0Pnx1
Intransitive Sentential Subject: Ts0V
Sentential Subject with `to' complement: Ts0Vtonx1
PP Small Clause, with Adv and Prep anchors: Tnx0ARBPnx1
PP Small Clause, with Adj and Prep anchors: Tnx0APnx1
PP Small Clause, with Noun and Prep anchors: Tnx0NPnx1
PP Small Clause, with Prep anchors: Tnx0PPnx1
PP Small Clause, with Prep and Noun anchors: Tnx0PNaPnx1
PP Small Clause with Sentential Subject, and Adv and Prep anchors: Ts0ARBPnx1
PP Small Clause with Sentential Subject, and Adj and Prep anchors: Ts0APnx1
PP Small Clause with Sentential Subject, and Noun and Prep anchors: Ts0NPnx1
PP Small Clause with Sentential Subject, and Prep anchors: Ts0PPnx1
PP Small Clause with Sentential Subject, and Prep and Noun anchors: Ts0PNaPnx1
Sentential Subject with Small Clause Complement: Ts0Vs1
Locative Small Clause with Ad anchor: Tnx0nx1ARB
Exceptional Case Marking: TXnx0Vs1
Idiom with V, D, and N anchors: Tnx0VDN1
Idiom with V, D, A, and N anchors: Tnx0VDAN1
Idiom with V and N anchors: Tnx0VN1
Idiom with V, A, and N anchors: Tnx0VAN1
Idiom with V, D, A, N, and Prep anchors: Tnx0VDAN1Pnx2
Idiom with V, A, N, and Prep anchors: Tnx0VAN1Pnx2
Idiom with V, N, and Prep anchors: Tnx0VN1Pnx2
Idiom with V, D, N, and Prep anchors: Tnx0VDN1Pnx2
Resultatives with V (transitive and intransitive), A anchors: TRnx0Vnx1A2
Resultatives with V (transitive and intransitive), P anchors: TRnx0Vnx1Pnx2
Resultatives with V (ergative), A anchors: TREnx1VA2
EOD

foreach $k (split("\n", $desc)) {
   ($d, $f) = split(':', $k);
   $f =~ s/^\s*//; 
   $f =~ s/\s*$//; 
   $desc{$f} = $d;
}

$num = -1;
if ($ARGV[0] =~ /^-/) {
   $num = $1 if ($ARGV[0] =~ /^-n(.*)$/);
   shift(@ARGV);
}
print STDERR "num=$num\n";
sub member
{   my ($refl, $x) = @_;
    foreach (@{$refl}) { if ($_ eq $x) { return(1); } }
    return(0);
}
while (<>) {
    chomp;
    s/ /\201/g;
    s/</ /g;
    s/>/ /g;
    @line = split;
    @entry = ();
    $sz = $#line +1;
    for (my $i = 0; $i < $sz; $i++) {
	if ($line[$i] eq 'ENTRY') { push (@entry, $line[$i+1]); }
	if ($line[$i] eq 'FAMILY') { $family = $line[$i+1]; }

    }
    if ($#entry > 0) {
	foreach $f (split("\201", $family)) {
	    $t{$f} = [] if (!defined $t{$f});
	    if (! member($t{$f}, join(' ', @entry))) {
		push(@{$t{$f}}, join(' ', @entry));    
	    }
	}
    }
}
foreach $f (keys %t) {
    print "family=$f\n";
    print "desc=$desc{$f}\n";
    @e = @{$t{$f}}; $sz = ($#e <= $num) ? $#e+1 : $num+1;
    for ($i = 0; $i < $sz; $i++) {
	print "\t", $e[rand($#e+1)], "\n";
    }
    print "\n";
}