#!/usr/bin/perl -w
use strict;

##
## plasticgame
## a script to play tom's game
##
## Game designed by Tom Coates <tom@plasticbag.org>
## Code designed by Cal Henderson <cal@iamcal.com>
## Optimized (a lot) by Benjamin Trott <ben@rhumba.pair.com>
##
## This code is free for public (mis)use
##

## CONFIG ##

my $DICT = "/usr/dict/words";
use vars qw( @CLUES );
@CLUES = (
	'my first is in %s but not in %s',
	'my second is not in %s but in %s',
	'my third is in both %s and %s',
	'my fourth is in neither %s nor %s',
);

## END CONFIG ##

my @perms;
if (@ARGV && $ARGV[0] eq '-p'){
	shift @ARGV;
	my $perm = shift @ARGV;
	die "usage: <perm> must contain only 0, 1, 2, and 3.\n" unless $perm =~ /[0123]{4}/;
	push @perms, [ split //, $perm ];
}else{
	@perms = permute([0, 1, 2, 3], []);
}

my($one, $two) = @ARGV or die "usage: $0 [-p <perm>] <word one> <word two>";

use vars qw( %DICT );
%DICT = %{ buildDict($DICT) };

local $| = 1;
findComb($one, $two, \@perms);

####################################################################

sub findComb {
	my($word1, $word2, $perms) = @_;
	my @letters;

	for my $e ('a'..'z'){
		my $in1 = index($word1, $e) == -1 ? 0 : 1;
		my $in2 = index($word2, $e) == -1 ? 0 : 2;
		push @{ $letters[ $in1+$in2 ] }, $e;
	}

	for my $perm (@$perms) {
		my @myelms;
		print "-----------------------------------------\nquestion:\n";
		my $pt = 0;
		for my $elm ( @$perm ) {
			push @myelms, $letters[$elm];
			printf "\t$CLUES[$pt++]\n", $word1, $word2;
		}
		print "answer(s):\n";
		print map "\t$_\n", getWords(@myelms);
	}
}

####################################################################

sub getWords {
	my ($a,$b,$c,$d) = @_;
	my @words;
	for $a(@$a){
		for $b(@$b){
			for $c(@$c){
				for $d(@$d){
					push @words, "$a$b$c$d" if exists $DICT{"$a$b$c$d"};
				}
			}
		}
	}
	@words;
}

####################################################################

sub permute{
	my @items = @{ $_[0] };
	my @perms = @{ $_[1] };
	return [ @perms ] unless @items;
	my(@newitems,@all,@newperms,$i);
	foreach $i (0 .. $#items) {
		@newitems = @items;
		@newperms = @perms;
		unshift(@newperms, splice(@newitems, $i, 1));
		push @all, permute([@newitems], [@newperms]);
	}
	@all;
}

####################################################################

sub buildDict {
	my($dict) = @_;
	my %dict;
	local($/, $_) = ("\n");
	local *FH;
	open FH, $dict or die "Can't open dictionary $dict: $!";
	chomp, $dict{$_}++ while <FH>;
	close FH or die "Can't close dictionary $dict: $!";
	\%dict;
}

####################################################################