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

#---- Setup

BEGIN { # Set envariables for -T tainting.
  $ENV{'PATH'} = '';
  $ENV{'ENV'}  = '';
}
BEGIN { # Extract path and program name.
  use vars qw($path $prog);
  $0 =~ m%(.*)[/\\]([^/\\]*)%;
  ($path, $prog) = ($1 || '.', $2 || $0);
}

#---- Packages

use sigtrap qw(die normal-signals);

#---- Constants

# Version is extracted from CVS/RCS revision.
my $REVISION = '$Revision: 1.1 $';
use vars qw($VERSION);
($VERSION = $REVISION) =~ s%^\$.evision: (.*?) \$$%$1%;

warn "$prog v${VERSION}a\n\n";

# Command line arguments.
my $usage = "usage: $prog wordfile thirdword\n";
my $file  = shift || die $usage;;
my $third = shift || die $usage;

$| = 1;

# All whole words (this gets large and uses lots of memory).
my %words = ();

# Candidates for first and second words.
my @first = ();
my @second = ();

# Scan the word list.
open ( FILE, "< $file" ) || die "$prog: Unable to open $file: $!\n";
my $word;
while ( defined ($word = <FILE>) ) {
	$word =~ s#[\n\r]##g;
	$word = lc $word;

	# Only want words with letters (dump spaces, punctuation).
	next unless $word =~ m#^\w+$#;

	++ $words{$word};

	# Word 1 candidate
	# Third word must begin with at least two letters ending first word.
	# but both must have left over letters.
	if ( "$word $third" =~ m#^(.+)(..+) \2(..+)$#  ) {
		push @first, $word;
	}

	# Word 2 candidate
	# Third word must end with at least two letters beginning second word.
	# but both must have left over letters.
	if ( "$third $word" =~ m#^(..+)(..+) \2(.+)$#  ) {
		push @second, $word;
	}

}
close ( FILE );

# See if first and second words match third and create a valid fourth word.
my $first;
foreach $first ( @first ) {
	my $second;
	foreach $second ( @second ) {
		if ( "$first $third $second" =~ 
				m#^(.+)(..+) \2(..+) \3(.+)$#
		    && defined $words{$1.$4} ) {

			print "1. $first\n";
			print "2. ", " " x length($first), "$second\n";
			print "3. ", " " x length($1), "$third\n";
			print "4. $1", " " x length($third), "$4 ($1$4)\n";
			print "\n";
		}
	}
}

exit 0;

=head1 NAME

juxta - Generate JuxtaPosition word game

=head1 SYNOPSIS

juxta wordfile thirdword

Where 'wordfile' is a file containing one word per line, and
'thirdword' is the third or center word as in the example below.

=head1 DOWNLOAD

The juxta Perl script is available here:

	http://www.anvilon.com/software/download/juxta

=head1 DESCRIPTION

JuxtaPosition

The object of this compact word game is to solve clues to four words.
The third word is found intact amidst the letters of the first two
juxtaposed words.  The fourth word uses the letters remaining when the
third word is removed from the juxtaposition of words 1 and 2.

Example - provided by Adrian Hoad-Reddick <hoad@hoadworks.com>

	1. teeth
	2.      nice
	3.   ethnic
	4. te      e (tee)

Suggested word lists are available from:
http://www.bryson.demon.co.uk/wordlist.html

The output of this script is all possible solutions where the first
and third words--and the second and third words--overlap by at least
two letters.

=head1 EXAMPLES

This command:

	juxta /usr/share/dict/words cool

generates a list of possible puzzles which includes:

	1. waco
	2.     olives
	3.   cool
	4. wa    ives (waives)

=head1 SEE ALSO

This script is used by the Wordly Wise Word Games by HoadWorks:

	http://www.hoadworks.com/gamemenu.htm

to generate JuxtaPosition puzzles:

	http://www.hoadworks.com/juxtaposition.htm

If you like these kinds of word games, you can subscribe to a daily
word puzzle from HoadWorks:

	http://www.hoadworks.com/subscribe.htm

=head1 AUTHOR

Eric Hammond <ehammond@thinksome.com>

=cut