Category: | Fun Stuff |
Author/Contact Info | Anthony DeLorenzo ajdelore@cpan.org |
Description: | Lately I've been obsessed with playing boggle. So, why not whip up a web-based boggle game, I thought? A couple of days and a CPAN module later, this code is the result. You can check out a live demo on my website. Uses Games::Boggle::Board (which I wrote), Games::Boggle to check words, and HTML::Template for output. Next on my list is to develop code to find all possible words in a given board. |
#!/usr/local/bin/perl -w # Example script using Games::Boggle::Board # Play a game of cgi-Boggle use strict; use HTML::Template; my $template; use CGI qw(param header); if ( param('board') && param('words')) { $template = HTML::Template->new(filename=>'boggle-words.template') or die; my $brd = build_board_array(param('board')); $template->param( board => $brd ); use Games::Boggle; my $board = Games::Boggle->new(param('board')); my %scores = ( 3 => 1, 4 => 1, 5 => 2, 6 => 3, 7 => 5, 8 => 11, 9 => 11, 10 => 11, 11 => 11, 12 => 11, 13 => 11, 14 => 11, 15 => 11, 16 => 11 ); my (@good, @bad); my $total_score = 0; foreach my $word ( keys %{{ map {$_ => 1} split /\s+/, param('words') }} ) { next if $word =~ /\W/; # watch for nasties if ( length($word)>2 && $board->has_word($word) ## && grep( /^$word$/, `look $word`) ) { push (@good, {word=>$word}); $total_score += $scores{length($word)}; } else { push (@bad, {word => $word}) } } $template->param( good => \@good ); $template->param( bad => \@bad ); $template->param( score => $total_score ); } else { $template = HTML::Template->new(filename=>'boggle.template') or die; use Games::Boggle::Board; my $b = Games::Boggle::Board->new; $template->param( board_string => $b->as_string ); my $board = build_board_array($b->as_string); $template->param( board => $board ); } print header, $template->output(); # ++ to merlyn sub build_board_array { my @board = split //, shift; s/Q/Qu/ foreach @board; @board = map { +{ line => [map +{ letter => $_ }, splice @board, 0, 4 ]}; } 1..4; return \@board; } |
|
---|
Replies are listed 'Best First'. | |
---|---|
•Re: perl/cgi Boggle
by merlyn (Sage) on Aug 15, 2003 at 22:48 UTC | |
by ajdelore (Pilgrim) on Aug 15, 2003 at 23:28 UTC |
Back to
Code Catacombs