#!/usr/bin/perl -w

# $Id: netboggle.pl,v 1.7 2001/03/09 18:19:35 jelson Exp $

use IO::Socket;
use strict;
use FileHandle;

use CGI;
my $q = new CGI;

#use CGI::Pretty;
#my $q = new CGI::Pretty;

$| = 1;

print $q->header(-type => 'text/html'),
    $q->start_html(-bgcolor => '#ffffff', -title => 'Online Boggle/Wordracer Solver');

my $op = $q->param('op') || "unspecified";
my $board;
my $i;
my %mode_labels;
my %format_labels;

print $q->h1("Online Boggle/Wordracer Solver");

if ($op eq "solve") {

    my ($remote, $line);

    $remote = IO::Socket::INET->new(
				    Proto    => "tcp",
				    PeerAddr => "localhost",
				    PeerPort => "12345",
				    )
	or die "sorry - cannot connect to boggle server.  try again later.";

    $remote->autoflush(1);

    # collapse the entire board into one line
    $board = "";
    foreach $i (split /\W+/, $q->param('board')) {
	$board .= $i;
    }

    # set min length to 3 if the mode is a wordracer mode
    if ($q->param('mode') ne "normal" && $q->param('minlength') eq "Default") {
	$q->param('minlength' => 3);
    }

    my $message = "";
    $message .= sprintf "minlength=" . $q->param('minlength') . "\n";
    $message .= sprintf "mode=" . $q->param('mode') . "\n";
#    $message .= sprintf "format=" . $q->param('format') . "\n";
    $message .= sprintf "board=$board\n";
    $message .= sprintf "%%\n";

    my $date = `date`;
    chomp $date;
    open(BOGLOG, ">>/home/jelson/projects/boggle/boglog");
    print BOGLOG "$date:\n$message\n\n";
    close BOGLOG;

    print $remote "$message";

    print qw!<pre>!;
    while ($line = <$remote>) {
	print $line;
    }
    print qw!</pre>!;
    $q->param('board' => "");
}

print $q->p, $q->hr, $q->p;

print $q->p("Just enter your desired boggle board in the box " .
"below, press 'solve', and all possible boggle responses will be" .
" displayed!");

my $boglog = "<b>Click <a href=\"boglog.pl\">here</a> for a list of recent uses of this solver</b>";

print $q->p($boglog);
print $q->p("Use 'Q' (capital Q) for the 'Qu' combination");
print $q->p("Use 'q' (lowercase q) for plain 'q'");

%mode_labels = ('normal' => 'Normal (square)',
		'wr1' => 'Wordracer Round 1 (4x4 square)',
		'wr2' => 'Wordracer Round 2 (diamond)',
		'wr3' => 'Wordracer Round 3 (double square)',
		'wr4' => 'Wordracer Round 4 (picture frame)');

#%format_labels=('plain' => 'Plain Word List',
#		'augmented' => 'With definitions and word locations',
#		'irc' => 'Formatted for IRC Boggle');

print $q->start_form( -method => 'POST', -action => $q->url()) ,
    $q->textarea ( -name => 'board', -rows => '8', -columns => '12',
		   -default=> "" ),
    $q->submit( -name => 'op', -value => 'solve'),

    $q->p,
    "Minimum Word Length: ",
    $q->popup_menu( -name=> 'minlength',
		    -values=>['Default','1','2','3','4','5','6','7','8']),

    $q->p,
    "Board shape: ",
    $q->popup_menu( -name => 'mode',
		    -values =>['normal', 'wr1', 'wr2', 'wr3', 'wr4'],
		    -labels => \%mode_labels),
    $q->p,
#    "Output format: ",
#    $q->popup_menu( -name => 'format',
#		    -values =>['plain', 'augmented', 'irc'],
#		    -labels => \%format_labels),

    $q->end_form();

print $q->p, $q->hr, $q->p("You can find out " .
      $q->a({href=>"http://www.circlemud.org/~jelson/software/boggle.html"},
	  "more information about this program") . ", or its " .
      $q->a({href=>"http://www.circlemud.org/~jelson"}, "creator") . ".");


print $q->p("UPDATED 24 Feb 2001 - Added usage log because of cheating complaints");
print $q->p("UPDATED 16 July 2000 - I fixed a bug that sometimes ".
"caused some words to be cut off from the end of the list");
print $q->p("UPDATED 21 August 2000 - You can now pick the minimum word length");
print $q->p("UPDATED 21 August 2000 - The 'Qu' combination now works.");
print $q->p("UPDATED 21 August 2000 - The server now understands the Wordracer-shaped boards.");


print $q->p, $q->address("Last modified: 21 August 2000");

print $q->end_html();