#!/bin/sh -- # A comment mentioning perl, indented for bash's sake.
eval 'exec perl -S $0 ${1+"$@"}'
        if 0;

require 5.000;

$Dict{'base'} = '/usr/dict/words';
$Dict{'scrabble'} = '/usr/local/lib/xscrabble/OSPD3.gz';

if ( $ARGV[0] eq '-d' ) {
	shift;
	$Dict = shift;
} else {
	$Dict = 'B';
}

select(STDERR); $| = 1;
select(STDOUT); $| = 1;

foreach $x (split(/,/, $Dict)) {
	
	if ( $x eq 'B' ) {
		$dict = $Dict{'base'};
	} elsif ( $x eq 'S' ) {
		$dict = $Dict{'scrabble'};
	} else {
		$dict = $x;
	}

	if ( $dict =~ /\|\s*$/ ) {
		;
	} elsif ( ! -f $dict ) {
		print STDERR "No file: $dict, $!";
		exit 1;
	}

	if ( $dict =~ /\.(Z|gz)$/ ) {
		open(DICT, "zcat $dict |") || die "$!";
	} else {
		open(DICT, "$dict") || die "$!";
	}

	print STDERR "loading dictionary [$x] ";

	while (<DICT>) {
		print "." if $i++ % 4000 == 0;
		$word = &trim($_);
		$word =~ y/A-Z/a-z/;

		next if $Words{$word};
		$Words{$word} = 1;

		$sort = &sortletters($word);
		push(@{$Cubby{$sort}}, $word);
	}
	print STDERR  " done.\n";
}

$Usage1 = "\nEnter words to un-jumble. blank or \"quit\" to exit. \"?\" for help.\n";
$Usage2 = <<"END";

Examples:

word>  abcdefghi	# permute all into words.
word>  3 abcdefghi	# find 3 letter words in the list.
word>  3,4 abcdefghi	# find 3 and then 4 letter words in the list.
word>  * abcdefghi	# find all letter words in the list.
word>  s3,2 abcdefghi	# find simlutaneously 3 and 2 letter words.
END
		
print STDERR $Usage1;

while (1) {
	if ( @ARGV ) {
		print STDERR "\n";
		$jumble = shift;
	} else {
		print STDERR "\nword> ";
		$jumble = <STDIN>;
	}
	$jumble = &trim($jumble);

	if ( $jumble =~ /^[?h]$/i ) {
		print $Usage1 . $Usage2;
		next;
	}
	
	last if $jumble =~ /^(q|x|quit|exit|)$/i;
	&try($jumble);
}
exit 0;
#######################################################################
sub try {
	my ($jum, $mode) = @_;
	$jum =~ y/A-Z/a-z/;

	if ( $jum =~ /^\s*([\d\*]\S*)\s+/ ) {
		&do_num($1, $');
		return;
	} elsif ( $jum =~ /^\s*s(\d+\S*)\s+/i ) {
		&do_simultaneous($1, $');
		return;
	}
	my $sort = &sortletters($jum);

	my $got = 0;
	my @list;
	if ( defined($Cubby{$sort}) ) {
		foreach $try (@{$Cubby{$sort}}) {
			if ( $mode == 2 ) {
				push(@list, "$jum -> $try");
			} else {
				print "$jum -> $try\n";
			}
			$got++;
		}
	}
	return @list if $mode == 2;
	print "$jum: no matches\n" if ! $got && $mode == 0;
}

sub do_num {
	my ($n, $word) = @_;
	$word =~ s/\W//g;
	$word =~ y/A-Z/a-z/;
	my @results = &get_results($n, $word);

	if ( ! @results ) {
		print "no matches.\n";
		return;
	}
	my ($cnt, $res, $len, $patt, $find, %stash);
	foreach $res ( @results ) {
		($patt, $find) = split(/\s*->\s*/, $res);
		$len = length($find);
		$stash{$len}{$find} = $patt;
	}
	foreach $len (sort {$a <=> $b} keys(%stash) ) {
		print "#$len \(", scalar(keys( %{$stash{$len}} )), "\):\n";
		foreach $find (sort keys( %{$stash{$len}} ) ) {
			print "$stash{$len}{$find}\t-> $find\n";
			$cnt++;
		}
	}
	print "#total: $cnt\n";
}

sub do_simultaneous {
	my ($n, $word) = @_;
	$word =~ s/\W//g;
	$word =~ y/A-Z/a-z/;

	if ( $n =~ /\*/ ) {
		print STDERR "Cannot have \"*\" in s-mode: $n\n";
		exit 1;
	}

	my @results = &get_results($n, $word);

	if ( ! @results ) {
		print "no matches.\n";
		return;
	}

	my ($cnt, $res, $len, $patt, $find, %stash, %sstash);
	foreach $res ( @results ) {
		($patt, $find) = split(/\s*->\s*/, $res);
		$len = length($find);
		$stash{$len}{$find} = $patt;
	}

	foreach $len (keys(%stash)) {
		foreach $find (sort keys(%{$stash{$len}}) ) {
			push(@{$sstash{$len}}, $find);
		}
	}

	my @letts = split(//, $word);
	my ($c, %pool, %pool0);
	foreach $c (@letts) {
		$pool0{$c}++;
	}

	my @len = split(/,/, $n);
	$len = @len;

	%pool = %pool0;
	my ($top_code, $mid_code, $bot_code);

	my (@w, @neg);

	$top_code = <<'END';
	foreach $w%N ( @{$sstash{$len[%N]}} ) {
		$w[%N] = $w%N;
		$neg[%N] = 0;
		foreach $c%N (split(//, $w[%N]))  {
			$pool{$c%N}--;
			if ( $pool{$c%N} < 0 ) {
				$neg[%N] = 1;
			}
		}
		if ( $neg[%N] == 0 ) {

			#+++++++++++++++++++++++++++++++++++++++
END

	$mid_code = <<'END';
				#-*****
				print "FOUND: ";
				for ($k=0; $k< $len; $k++) {
					print "$w[$k] ";
				}
				print "\n";
				#-*****
END
			
	$bot_code = <<'END';
			#=======================================
		}
		foreach $c%N (split(//, $w[%N]))  {
			$pool{$c%N}++;
		}
	}
END

	my ($code, $tmp, $i);
	$code = '';
	for ($i=0; $i < $len; $i++) {
		$tmp = $top_code;
		$tmp =~ s/%N/$i/g;
		$code .= $tmp;
	}

	$code .= $mid_code;

	for ($i=$len-1; $i >= 0; $i--) {
		$tmp = $bot_code;
		$tmp =~ s/%N/$i/g;
		$code .= $tmp;
	}

	# print STDERR "CODE:\n$code";

	eval($code);
	print STDERR "RC:$@\n" if $@;
}

sub get_results {
	my ($n, $word) = @_;
	

	my (%saw, $sort, $j);
	my $width = length($word);

	if ( $width > 32 ) {
		print STDERR "currently cannot handle more than 32 letters!\n";
		exit 1;
	}

	my $list = join(',', split(//, $word));
	print STDERR "trying match of $n letter words from the list $list \($width letters)\n";

	my @results = ();
	my @numbers = split(/,/, $n);
	my @letters = split(//, $word);
	for ($i=0; $i < 2 ** $width; $i++) {
		$use = &extract(\@numbers, $i, $width, \@letters);
		next if $use eq '';
		print STDERR "." if $j++ % 1000 == 0;
		$sort = &sortletters($use);
		next if $saw{$sort};
		$saw{$sort} = 1;
		push( @results, &try($sort, 2) ) ;
	}
	print STDERR "\n";

	return @results;
}

sub extract {
	my ($nref, $i , $w, $letterref) = @_;

	my $y = unpack("B*", pack("N", $i) );
	$y = substr($y, length($y) - $w);

	my ($bit, $c, $str, $cnt, $idx, $m); 

	foreach $bit (split(//, $y))  {
		$c = $letterref->[$idx++]; 
		next if $bit == 0;  
		$cnt++;
		$str .= $c;
	}
	
	return $str if $nref->[0] eq '*';

	my $ok = 0;
	foreach $m (@{$nref}) {
		$ok = 1 if $cnt == $m;
	}
	return '' if ! $ok;
	return $str;
}

sub sortletters {
	my ($word) = @_; 
	return join('', sort(split(//, $word)));
}

sub trim {
	my ($x) = @_;
	$x =~ s/^\s*//;
	$x =~ s/\s*$//;
	return $x;
}