#!/usr/bin/perl

use strict;
use IO::File;

$|=1;

my $grid;
my $size = shift || 20;

#my @words = qw(Aldrin Apollo Armstrong astronaut button boots contact craft crater danger dust eagle engine fun gloves gravity hatch hot landing light map moon oxygen photograph rocks rocket space sun Tranquility);

#my $dict = Dict->new; #(filter => '/gram/');
#my @words = $dict->get_words(40);

my @words = <>;
chomp for @words;

my $word_search = WordSearch->new(words=>\@words, size => $size);
$word_search->build or die "sorry, too hard for me to make it!!\n\n";
print STDERR `clear`;
$word_search->grid;
print "\n\n";
$word_search->word_list;

exit 0;

package Dict;

sub new {
	my $package = shift;
	my %args = @_;
	my $dict_file = $args{source} || -f "/usr/share/dict/words" ? "/usr/share/dict/words" : -f "/usr/dict/words" ? "/usr/dict/words" : die "cannot find default dict/words list";
	my $filter;
	if ($filter = $args{filter}) {
		$filter = eval "sub { $filter }" unless ref $filter;
	}
	
	my $file = IO::File->new($dict_file) or die "cannot open dict/words file";
	my @words;
	while (<$file>) { chomp; push @words, $_ if !$filter || &$filter($_); }
	bless {words => \@words}, $package;
}

sub get_words {
	my $this = shift;
	my $dict = $this->{words};
	my $n_words = shift || 1;

	die "sorry, only have ", 0+@$dict, " words available" if $n_words > @$dict;

	my @words;
	my %used = ();

	for (1..$n_words) {
		my $word;
		TRY: {
			my $i = int rand(@$dict);
			redo TRY if $used{$i};
			$word = $dict->[$i];
			$used{$i} = 1;
		}
		push @words, $word;
	}

	return wantarray ? @words : \@words;
}

package WordSearch;

sub new {
	my $package = shift;
	my %args = @_;
	my $words = $args{words} or die "no words specified";
	bless {size => $args{size} || 20, words => scalar(cisort($words)), grid => undef}, $package;
}

sub cisort {
	my $ary = @_ == 1 && ref $_[0] ? $_[0] : \@_;
	my @sorted = map {$_->[1]} sort {$a->[0] cmp $b->[0]} map {[lc $_, $_]} @$ary;
	return wantarray ? @sorted : \@sorted;
}

sub word_list {
	my $this = shift;
	my $words = $this->{words};
	my $column = IO::File->new("| column -c 70");
	for (@$words) {
		print $column "$_\n";
	}
}

sub grid {
	my $this = shift;
	my $out = shift || \*STDOUT;
	my $grid = $this->{grid} ||= $this->new_grid;
	for my $row (@$grid) {
		for my $char (@$row) {
			print $out $char eq "" ? "  " : "$char ";
		}
		print $out "\n";
	}
}

sub random_chars {
	my $this = shift;
	my $grid = $this->{grid} ||= $this->new_grid;
	for my $row (@$grid) {
		for my $char (@$row) {
			$char ||= chr(ord('a') + int rand(26));
		}
	}
}

sub build {
	my $this = shift;

	my $try = 10;
	
	TRY: { $this->new_grid;
		unless ($this->add_words) {
			if (--$try == 0) {
				return 0;
			}
			redo TRY;
		}
	}

	$this->random_chars;

	return 1;
}

sub new_grid {
	my $this = shift;
	my $size = $this->{size};
	my @rows = ();
	for (1..$size) {
		push @rows, [(undef) x $size];
	}
	$this->{grid} = \@rows;
}

sub add_words {
	my $this = shift;

	my $i = 1;
	for (shuffle(@{$this->{words}})) {
		unless ($this->add_word($_)) {
			print STDERR "gave up on word $i : $_\n";
			return 0;
		}
		$i++;
	}
	
	return 1;
}

sub shuffle {
	my $ary = (@_ == 1 && ref $_[0]) ? $_[0] : \@_;
	my @out;
	while (@$ary) {
		my $i = int rand(@$ary);
		push @out, splice @$ary, $i, 1;
	}
	return wantarray ? @out : \@out;
}

sub add_word {
	my $this = shift;
	my $grid = $this->{grid};
	my $word = lc shift;
	my @places;
	my $len = length $word;
	my $size = $this->{size};

	my $total_rating = 0;

#	print "$len $size\n";
	
	for my $o ([1,0], [1,1], [0,1], [-1,1], [-1,0], [-1,-1], [0,-1], [1,-1]) {
#	for my $o ([1,0], [0,1], [-1,0], [0,-1]) {
#	for my $o ([1,0], [0,1]) {
		my ($dx, $dy) = @$o;
		my ($xs, $xe, $ys, $ye);
		
		if ($dx == 0) {
			$xs = 0;
			$xe = $size - 1;
		} elsif ($dx == 1) {
			$xs = 0;
			$xe = $size - $len;
		} else {
			$xs = $len - 1;
			$xe = $size - 1;
		}

		if ($dy == 0) {
			$ys = 0;
			$ye = $size - 1;
		} elsif ($dy == 1) {
			$ys = 0;
			$ye = $size - $len;
		} else {
			$ys = $len - 1;
			$ye = $size - 1;
		}

		for my $x ($xs .. $xe) {
			for my $y ($ys .. $ye) {
				if (my $rating = $this->word_fits($word, $x, $y, $dx, $dy)) {
					push @places, [$rating, $x, $y, $dx, $dy];
					$total_rating += $rating;
				}
			}
		}
	}

	if (@places == 0) { return 0; }

	my $choice = rand($total_rating);
	for (@places) {
		if (($choice -= $_->[0]) < 0) {
			$choice = $_;
			last;
		}
	}
	die "could not choose" unless ref $choice;

	$this->put_word($word, @$choice[1..4]);

	return 1;
}

sub word_fits {
	my $this = shift;
	my $grid = $this->{grid};

	my ($word, $x, $y, $dx, $dy) = @_;
	
	my $rating = 1;

	for (split //, $word) {
		my $c = $grid->[$x][$y];
		if ($c eq $_) {
			$rating *= 100;
		} elsif ($c ne "") {
			return 0;
		}
		$x += $dx; $y += $dy;
	}
	return $rating;
}

sub put_word {
	my $this = shift;
	my $grid = $this->{grid};

	my ($word, $x, $y, $dx, $dy) = @_;

#	print "$word, $x, $y, $dx, $dy\n";
	
	for (split //, $word) {
		my $c = $grid->[$x][$y];
		if ($c eq $_) {}
		elsif ($c eq "") {
			$grid->[$x][$y] = $_;
		} else {
			die "cannot put word, other letter/s in the way";
		}
		$x += $dx; $y += $dy;
	}
#	print "\n\n";
	print STDERR `clear`;
	$this->grid(\*STDERR);
#	print "\n\n";
}