Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
Here's the actual script:
use strict; use Tk; use Tk::DialogBox; use Tk::FileDialog; use Tk::Checkbutton; use Tk::OptionMenu; use File::Glob; #My custom class. use Skrabbel; #Our Important Globals my $MW; #MainWindow my $VERSION = '0.1'; my $scrabble; #Our class object that maintains the game my $board_frame; #Frame for Scrabble Board my $entry_frame; #Frame for all entries my @square_frames; #1-D Array of Frames my @squares; #2-D Array of Labels (15x15) my $entry_word; #Word to enter onto board my $x_pt; #X coordinate point on board my $y_pt; #Y coordinate point on board my $orientation; #Direction of new word (Horizontal,Vertical) my $my_letters; #Current letters you have to play my $num_results; #Number of results we want when finding best my $value; #current value of word being shown my $best_moves; #reference to array of best moves my $preview_showing; #which preview in array we are showing my $search_time; #time it took to run search #Set up the mainwindow $MW = MainWindow->new( -title => "Scrabbler - v$VERSION" ); $MW->resizable(0,0); $MW->withdraw(); #Set up our board_frame $board_frame = $MW->Frame( )->pack( -side => 'left', ); my $top_axis_frame = $board_frame->Frame( )->pack( -side => 'top', -fill => 'x' ); $top_axis_frame->Label( -text => " # ", -width => 2, -font => [ -weight => 'bold', -size => 12 ], -relief => 'flat', -borderwidth => 1 )->pack( -side => 'left', -padx => 1 ); for (my $x = 0; $x < 15; $x++) { $top_axis_frame->Label( -text => " $x ", -width => 2, -font => [ -weight => 'bold', -size => 12 ], -relief => 'flat', -borderwidth => 1 )->pack( -side => 'left', -padx => 1, -pady => 1 ); } for (my $x = 0; $x < 15; $x++) { $square_frames[$x] = $board_frame->Frame( )->pack( -side => 'top', -fill => 'x', -expand => 1 ); $square_frames[$x]->Label( -text => " $x ", -width => 2, -font => [ -weight => 'bold', -size => 12 ], -relief => 'flat', -borderwidth => 1 )->pack( -side => 'left', -padx => 1 ); for (my $y = 0; $y < 15; $y++) { $squares[$x][$y] = $square_frames[$x]->Label( -text => " ", -width => 2, -font => [ -weight => 'bold', -size => 12 ], -relief => 'sunken', -borderwidth => 1 )->pack( -side => 'left', -padx => 1 ); } } #Color our squares on board_frame #make the 3W (Triple Word) squares foreach my $x (0,7,14) { foreach my $y (0,7,14) { $squares[$x][$y]->configure( -background => 'red' ); } } #make the 2W (Double Word) squares foreach my $x (1,2,3,4,7) { $squares[$x][$x]->configure( -background => 'orange' ); $squares[$x][14 - $x]->configure( -background => 'orange' ); $squares[14 - $x][$x]->configure( -background => 'orange' ); $squares[14 - $x][14 - $x]->configure( -background => 'orange' ); } #make the 3L (Triple Letter) squares foreach my $x (5,9) { foreach my $y (5,9) { $squares[$x][$y]->configure( -background => 'blue' ); } } foreach my $x (1,13) { foreach my $y (1,5) { $squares[$x][$y]->configure( -background => 'blue' ); $squares[$x][14 - $y]->configure( -background => 'blue' ); } } #make the 2L (Double Letter) squares foreach my $x (0,7,14) { foreach my $y (3,11) { $squares[$x][$y]->configure( -background => 'yellow' ); $squares[$y][$x]->configure( -background => 'yellow' ); } } foreach my $x (2,12,6,8) { foreach my $y (6,8) { $squares[$x][$y]->configure( -background => 'yellow' ); $squares[$y][$x]->configure( -background => 'yellow' ); } } #set our Entries frame $entry_frame = $MW->Frame( )->pack( -side => 'right', -fill => 'both', -expand => 1 ); #Our "Place Move" title $entry_frame->Label( -text => "Place Move", -font => [ -size => 12, -weight => 'bold', -underline => 1 ] )->pack( -side => 'top' ); #Our Word-Entry frame my $word_frame = $entry_frame->Frame( )->pack( -side => 'top', -fill => 'x', -pady => 5 ); my $word_entry = $word_frame->Entry( -textvariable => \$entry_word, -width => 18, -font => [ -size => 10, -weight => 'bold' ], )->pack( -side => 'right' ); $word_frame->Label( -text => "Word: ", -font => [ -size => 10, -weight => 'bold' ], )->pack( -side => 'right' ); #Our Coordinate Entry Frame my $location_frame = $entry_frame->Frame( )->pack( -side => 'top', -fill => 'x', -pady => 5 ); $location_frame->Entry( -textvariable => \$x_pt, -width => 2, -font => [ -size => 10, -weight => 'bold' ], )->pack( -side => 'right' ); $location_frame->Label( -text => " col:", -font => [ -size => 10 ] )->pack( -side => 'right' ); $location_frame->Entry( -textvariable => \$y_pt, -width => 2, -font => [ -size => 10, -weight => 'bold' ], )->pack( -side => 'right' ); $location_frame->Label( -text => "row:", -font => [ -size => 10 ] )->pack( -side => 'right' ); $location_frame->Label( -text => "Starting Point: ", -font => [ -size => 10, -weight => 'bold' ], )->pack( -side => 'right' ); #Our Direction Entry Frame my $direction_frame = $entry_frame->Frame( )->pack( -side => 'top', -fill => 'x', -pady => 5 ); $direction_frame->Optionmenu( -variable => \$orientation, -options => [ "Horizontal", "Vertical" ], -font => [ -size => 10, -weight => 'bold' ] )->pack( -side => 'right' ); $direction_frame->Label( -text => "Orientation: ", -font => [ -size => 10, -weight => 'bold' ] )->pack( -side => 'right' ); #Our button to activate place-move $entry_frame->Button( -text => "Add Word", -font => [ -size => 10, -weight => 'bold' ], -command => [\&add_word], -background => 'orange', -activebackground => 'green' )->pack( -side => 'top', -anchor => 'e', -pady => 5 ); #A little separator $entry_frame->Frame( )->pack( -side => 'top', -fill => 'x', -pady => 10 ); #Our "Find Best Move" title $entry_frame->Label( -text => "Find Best Move(s)", -font => [ -size => 12, -weight => 'bold', -underline => 1 ], )->pack( -side => 'top' ); #our "My Letters" frame my $letters_frame = $entry_frame->Frame( )->pack( -side => 'top', -fill => 'x', -pady => 5 ); $letters_frame->Entry( -textvariable => \$my_letters, -width => 15, -font => [ -size => 10, -weight => 'bold' ] )->pack( -side => 'right', -padx => 5 ); $letters_frame->Label( -text => "My Letters: ", -font => [ -size => 10, -weight => 'bold' ] )->pack( -side => 'right', -padx => 5 ); #Our "Number of Results" frame my $results_frame = $entry_frame->Frame( )->pack( -side => 'top', -fill => 'x', -pady => 5 ); $results_frame->Entry( -textvariable => \$num_results, -width => 3, -font => [ -size => 10, -weight => 'bold' ] )->pack( -side => 'right', -padx => 5 ); $results_frame->Label( -text => "Num of Results: ", -font => [ -size => 10, -weight => 'bold' ] )->pack( -side => 'right', -padx => 5 ); #Our frame for controlling scrolling results my $scroll_frame = $entry_frame->Frame( )->pack( -side => 'top', -fill => 'x', -pady => 5 ); $scroll_frame->Button( -text => "next", -font => [ -size => 10, -weight => 'bold' ], -activebackground => 'green', -command => sub { $preview_showing++ if ($preview_showing < scalar(@{$best_m +oves}) - 1); preview($$best_moves[$preview_showing]); } )->pack( -side => 'right', -padx => 5 ); $scroll_frame->Button( -text => "prev", -height => .5, -font => [ -size => 10, -weight => 'bold' ], -activebackground => 'green', -command => sub { $preview_showing-- if ($preview_showing > 0); preview($$best_moves[$preview_showing]); } )->pack( -side => 'right', -padx => 5 ); $scroll_frame->Label( -text => "Value: ", -font => [ -size => 10, -weight => 'bold', ] )->pack( -side => 'left', -padx => 2 ); $scroll_frame->Label( -textvariable => \$value, -font => [ -size => 10, -weight => 'bold' ] )->pack( -side => 'left' ); #Our buttons for finding or clearing results my $clear_frame = $entry_frame->Frame( )->pack( -side => 'top', -fill => 'x', -pady => 5 ); my $find_button = $clear_frame->Button( -text => "Find", -font => [ -size => 10, -weight => 'bold' ], -activebackground => 'green', -command => [\&find_results] )->pack( -side => 'right', -padx => 5 ); $clear_frame->Button( -text => "Clear", -font => [ -size => 10, -weight => 'bold' ], -activebackground => 'green', -command => [\&clear_results] )->pack( -side => 'right', -padx => 5 ); $clear_frame->Label( -text => "Time:", -font => [ -size => 10, -weight => 'bold' ] )->pack( -side => 'left', -padx => 3 ); $clear_frame->Label( -textvariable => \$search_time, -font => [ -size => 10, -weight => 'bold', ], -width => 6 )->pack( -side => 'left', -padx => 3 ); #our bottom button frame my $button_frame = $entry_frame->Frame( )->pack( -side => 'bottom', -fill => 'x', -pady => 5 ); $button_frame->Button( -text => "Save Board", -command => [\&save_select], -font => [ -size => 10, -weight => 'bold' ], -background => 'orange', -activebackground => 'green' )->pack( -side => 'right', -padx => 5 ); $button_frame->Button( -text => "Load Board", -command => [\&load_select], -font => [ -size => 10, -weight => 'bold' ], -background => 'orange', -activebackground => 'green' )->pack( -side => 'right', -padx => 5 ); #configure file browsing object my $dictionary_window = $MW->FileDialog( -Title => 'Select Word List', -SelHook => \&start, -ShowAll => 1, -Create => 0 ); my $load_window = $MW->FileDialog( -Title => 'Select Board to Load', -SelHook => \&load_board, -ShowAll => 1, -Create => 0 ); my $save_window = $MW->FileDialog( -Title => 'Where to Save Board', -SelHook => \&save_board, -ShowAll => 1, -Create => 1 ); #Pop up our window to get word list $dictionary_window->Show(); #This function creates our scrabble class #and gets things started sub start($) { my ($word_list) = @_; my $dir = $word_list; while (chop($dir) ne '/') {} #bring down this window $dictionary_window->destroy(); $load_window->configure( -Path => $dir ); $save_window->configure( -Path => $dir ); #load module and board unless ($scrabble = Skrabbel->new($word_list)) { pop_message("Constructor Failed",1); } $MW->geometry('+100+100'); $MW->Popup(); MainLoop(); exit; } #This just updates the values of our displayed board #based on the 2-D array-ref argument sub update_board($) { my ($new_board) = @_; for (my $x = 0; $x < 15; $x++) { for (my $y = 0; $y < 15; $y++) { my $txt = $$new_board[$x][$y]; $squares[$x][$y]->configure( -text => "$txt" ); } } } #This function previews an additional word on our board sub preview($) { my ($move) = @_; my $val_buffer = $$move{'value'}; $value = $val_buffer; #breaking word into array of chars my @word_array = split(//,uc($$move{'word'})); #first update to actual board update_board($scrabble->curr_board()); #if horiz we preview here if($$move{'orientation'} eq "Horizontal") { for(my ($x,$tmp_x) = (0,$$move{'x_pt'}); $x < length($$move{'w +ord'}); $x++,$tmp_x++) { $squares[$$move{'y_pt'}][$tmp_x]->configure( -text => "$word_array[$x]" ); } } #if vertical then here elsif($$move{'orientation'} eq "Vertical") { for(my ($y,$tmp_y) = (0,$$move{'y_pt'}); $y < length($$move{'w +ord'}); $y++,$tmp_y++) { $squares[$tmp_y][$$move{'x_pt'}]->configure( -text => "$word_array[$y]" ); } } } #this function just clears all our fields #and resets our board sub clear_results() { $num_results = ''; $my_letters = ''; $value = ''; update_board($scrabble->curr_board()); } #This function gathers the data in entry_frame #And tries to add a word to our board! sub add_word() { #Some basic error-checking if ($x_pt =~ /\D/ || $y_pt =~ /\D/ || $x_pt > 14 || $x_pt < 0 || $y_pt > 14 || $y_pt < 0 || $y_pt eq "" || $x_pt eq "") { pop_message("Coordinates Are Improper",0); return 0; } #have our object add this word if($scrabble->add_word($entry_word, $x_pt, $y_pt, $orientation)) { update_board($scrabble->curr_board()); return 1; } else { pop_message("New Word Won't Fit On Board",0); return 0; } } #Here we pop our filedialog to select file to load sub load_select() { $load_window->raise(); $load_window->Show(); } #Here we load the board in the functions first and only argument sub load_board($) { my ($file) = @_; #let's have our filedialog pop up in this dir next time my $dir = $file; while (chop($dir) ne "/") {}; $load_window->configure( -Path => $dir ); #Now we call our class and get it done if($scrabble->load_board($file)) { update_board($scrabble->curr_board()); return 1; } else { pop_message("Couldn't Load Board At: $file",0); return 0; } } #Here we pop up our filedialog to select file to save board to sub save_select() { $save_window->raise(); $save_window->Show(); } #Here we save our board to the file in the functions first #and only argument sub save_board($) { my ($file) = @_; #let's have our filedialog pop up in this dir next time my $dir = $file; while (chop($dir) ne "/") {}; $save_window->configure( -Path => $dir ); #Now we call our class and get it done if($scrabble->save_board($file)) { pop_message("Board Saved Successfully",0); return 1; } else { pop_message("Couldn't Save Board To: $file",0); return 0; } } #Here we ask our object to do it's thing and we find #the top results. sub find_results() { my $time = time(); $best_moves = $scrabble->find_results($my_letters, $num_results); $time = time() - $time; my $min = int($time/60); my $sec = $time - ($min * 60); $search_time = "$min" . "m " . "$sec" . "s"; if($best_moves) { preview($$best_moves[0]); $preview_showing = 0; pop_message("Move Search Complete",0); } else { pop_message("Find Request Failed",0); } } #This function replaces our Win32 MsgBox's. We pop #up message and then whether it's a program ender #or just a message. sub pop_message($$) { my ($msg,$death) = @_; #Create our toplevel object my $PW = $MW->Toplevel( -title => "Message For Ya", -takefocus => 1 ); $PW->resizable(0,0); $PW->protocol('WM_DELETE_WINDOW',sub {;}); $PW->withdraw(); #If it's the end we take away MW if ($death) { $MW->withdraw(); } #Now make our label and button $PW->Label( -text => "$msg", -font => [ -size => 10, -weight => 'bold' ] )->pack( -side => 'top', -pady => 5 ); my $button = $PW->Button( -text => "Ok", -font => [ -size => 10, -weight => 'bold' ], -activebackground => 'green', -width => 10, -command => [ sub { if ($death) { $MW->destroy(); } else { $PW->destroy(); } } ] )->pack( -side => 'top', -pady => 5 ); #Pop up our window $PW->Popup(); $button->focus(); }
This is the module. It should become Skrabbel.pm
package Skrabbel; use strict; #our letter values my %letter_values = ( "A" => 1, "B" => 3, "C" => 3, "D" => 2, "E" => 1, "F" => 4, "G" => 2, "H" => 4, "I" => 1, "J" => 8, "K" => 5, "L" => 1, "M" => 3, "N" => 1, "O" => 1, "P" => 3, "Q" => 10, "R" => 1, "S" => 1, "T" => 1, "U" => 1, "V" => 4, "W" => 4, "X" => 8, "Y" => 4, "Z" => 10 ); #our premium squares my @premium_squares; for(my $x = 0; $x < 15; $x++) { for(my $y = 0; $y < 15; $y++) { $premium_squares[$x][$y] = " "; } } #make the 3W (Triple Word) squares foreach my $x (0,7,14) { foreach my $y (0,7,14) { $premium_squares[$x][$y] = "3W"; } } #make the 2W (Double Word) squares foreach my $x (1,2,3,4,7) { $premium_squares[$x][$x] = "2W"; $premium_squares[$x][14 - $x] = "2W"; $premium_squares[14 - $x][$x] = "2W"; $premium_squares[14 - $x][14 - $x] = "2W"; } #make the 3L (Triple Letter) squares foreach my $x (5,9) { foreach my $y (5,9) { $premium_squares[$x][$y] = "3L"; } } foreach my $x (1,13) { foreach my $y (1,5) { $premium_squares[$x][$y] = "3L"; $premium_squares[$x][14 - $y] = "3L"; } } #make the 2L (Double Letter) squares foreach my $x (0,7,14) { foreach my $y (3,11) { $premium_squares[$x][$y] = "2L"; $premium_squares[$y][$x] = "2L"; } } foreach my $x (2,12,6,8) { foreach my $y (6,8) { $premium_squares[$x][$y] = "2L"; $premium_squares[$y][$x] = "2L"; } } 1; ################################################# #CLIENT FUNCTIONS ################################################# #Our constructor. Takes a file location #and loads the word-list in it sub new($$) { my ($self, $word_file) = @_; #Load our word list, if we have one my @word_list = (); if($word_file) { open(LST, '<', $word_file) or return 0; @word_list = <LST>; close(LST); } for(my $x = 0; $x < scalar(@word_list); $x++) { chomp($word_list[$x]); $word_list[$x] =~ s/\s+//g; $word_list[$x] = lc($word_list[$x]); } #Create our current board my @current_board; for(my $x = 0; $x < 15; $x++) { for(my $y = 0; $y < 15; $y++) { $current_board[$x][$y] = ' '; } } #Instantiate our object bless { word_list => \@word_list, current_board => \@current_board }, $self; } #This function takes a file-location #and loads the formatted board in it sub load_board($$) { my ($self, $file) = @_; open(BRD, '<', $file) or return 0; chomp(my @current_board = <BRD>); close(BRD); for(my $x = 0; $x < 15; $x++) { $current_board[$x] = [ split('-',$current_board[$x]) ]; } $self->{current_board} = \@current_board; return 1; } #This function saves our curr_board to the file #location in argument. sub save_board($$) { my ($self,$file) = @_; my $current_board = $self->curr_board(); #Open our file open(BRD, '>', $file) or return 0; #Now we print it out for(my $y = 0; $y < 14; $y++) { for(my $x = 0; $x < 14; $x++) { print BRD $$current_board[$y][$x],"-"; } print BRD $$current_board[$y][14],"\n"; } for(my $x = 0; $x < 14; $x++) { print BRD $$current_board[14][$x],"-"; } print BRD $$current_board[14][14]; #close our file close(BRD); #and return our success return 1; } #This function takes all data for adding #a new word to the board sub add_word($$$$$) { my ($self, $new_word, $x_pt, $y_pt, $orientation) = @_; my $current_board = $self->curr_board(); #Properly format our word $new_word = uc($new_word); $new_word =~ s/\s+//g; #Break our word up into an array of chars. my @word_array = split(//,$new_word); #checking that new addition is a valid move my $connection = 0; #whether the word is touching another #if true it must be our first move if ($self->board_empty()) { $connection = 1; } elsif($orientation eq "Horizontal") { for(my ($x,$tmp_x) = (0,$x_pt); $x < scalar(@word_array); $x++ +,$tmp_x++) { return 0 if ($tmp_x > 14); if($$current_board[$y_pt][$tmp_x] =~ /\S/) { return 0 if ($$current_board[$y_pt][$tmp_x] ne $word_a +rray[$x]); $connection = 1; } } } elsif($orientation eq "Vertical") { my $tmp_y = $y_pt; for(my ($y,$tmp_y) = (0,$y_pt); $y < scalar(@word_array); $y++ +,$tmp_y++) { return 0 if ($tmp_y > 14); if($$current_board[$tmp_y][$x_pt] =~ /\S/) { return 0 if ($$current_board[$tmp_y][$x_pt] ne $word_a +rray[$y]); $connection = 1; } } } else { return 0; } return 0 unless ($connection); #If we're still here than it must be valid so we add it if($orientation eq "Horizontal") { for(my ($x,$tmp_x) = (0,$x_pt); $x < scalar(@word_array); $x++ +,$tmp_x++) { $$current_board[$y_pt][$tmp_x] = $word_array[$x]; } } elsif($orientation eq "Vertical") { for(my ($y,$tmp_y) = (0,$y_pt); $y < scalar(@word_array); $y++ +,$tmp_y++) { $$current_board[$tmp_y][$x_pt] = $word_array[$y]; } } else { return 0; } #Got here without an error so we return success! return 1; } #This master function tries to find the best moves possible sub find_results($$$) { my ($self, $letters, $num) = @_; $letters = uc($letters); $letters =~ s/\s//g; #Verify our arguments to be valid unless($letters =~ /\S/) { return 0; } unless($num =~ /\d/) { return 0; } #Here's our array of hash-references of best moves #which we'll fill, sort, shorten, and finally return my @best_moves; #Let's look for horizontal entry positions first for(my $y = 0; $y < 15; $y++) { unless($self->row_empty($y)) { my $tmp_letters = $letters . $self->row_letters($y); my $words = $self->words_with($tmp_letters); foreach my $word (@{$words}) { for(my $x = 0; $x < 15; $x++) { my $tmp_move = $self->validate($letters, $word, $y +, $x, "Horizontal"); if($tmp_move) { my $value = $self->value($word, $y, $x, "Horiz +ontal"); my %tmp_move = ( "word" => $word, "orientation" => "Horizontal", "value" => $value, "y_pt" => $y, "x_pt" => $x ); push(@best_moves, \%tmp_move); } } } @best_moves = sort {$$b{"value"} <=> $$a{"value"}} @best_m +oves; while(scalar(@best_moves) > $num) { pop(@best_moves); } } } #now lets look for vertical entry positions for(my $x = 0; $x < 15; $x++) { unless($self->col_empty($x)) { my $tmp_letters = $letters . $self->col_letters($x); my $words = $self->words_with($tmp_letters); foreach my $word (@{$words}) { for(my $y = 0; $y < 15; $y++) { my $tmp_move = $self->validate($letters, $word, $y +, $x, "Vertical"); if($tmp_move) { my $value = $self->value($word, $y, $x, "Verti +cal"); my %tmp_move = ( "word" => uc($word), "orientation" => "Vertical", "value" => $value, "y_pt" => $y, "x_pt" => $x ); push(@best_moves, \%tmp_move); } } } @best_moves = sort {$$b{"value"} <=> $$a{"value"}} @best_m +oves; while(scalar(@best_moves) > $num) { pop(@best_moves); } } } close(BUG); return \@best_moves; } #This function returns the value of the move #given in the arguments sub value($$$$$) { my ($self, $word, $y_pt, $x_pt, $orientation) = @_; my $current_board = $self->curr_board(); my $word = uc($word); #Time to break our word into array of chars. my @word_array = split(//,$word); #Here's our full value we're going to add on to my $full_value = 0; my $double = 0; #whether to double our final value my $triple = 0; #whether to triple our final value my $letters_used = 0; #if 7 we can add all letters bonus #Time to value if it's horizontal if($orientation eq "Horizontal") { for(my ($x,$tmp_x) = (0,$x_pt); $x < scalar(@word_array); $x++ +,$tmp_x++) { #if letter already here we just add it's normal value if($$current_board[$y_pt][$tmp_x] =~ /\S/) { $full_value += $letter_values{$word_array[$x]}; next; } else{ if($premium_squares[$y_pt][$tmp_x] eq " ") { $full_value += $letter_values{$word_array[$x]}; } else{ if($premium_squares[$y_pt][$tmp_x] eq "2L") { $full_value += ($letter_values{$word_array[$x] +}) * 2; } elsif($premium_squares[$y_pt][$tmp_x] eq "3L") { $full_value += ($letter_values{$word_array[$x] +}) * 3; } elsif($premium_squares[$y_pt][$tmp_x] eq "2W") { $full_value += $letter_values{$word_array[$x]} +; $double = 1; } elsif($premium_squares[$y_pt][$tmp_x] eq "3W") { $full_value += $letter_values{$word_array[$x]} +; $triple = 1; } } $letters_used++; } #now if there's a letter above or below we want to add tha +t if(($$current_board[$y_pt-1][$tmp_x] =~ /\S/ && $y_pt > 0) || ($$current_board[$y_pt+1][$tmp_x] =~ /\S/ && $y_pt < 14 +)) { my $p = $y_pt - 1; while($$current_board[$p][$tmp_x] =~ /\S/ && $p >= 0) +{ $p--; } $p++; while($p < $y_pt) { $full_value += $letter_values{$$current_board[$p][ +$tmp_x]}; $p++; } $full_value += $letter_values{$word_array[$x]}; $p++; while($$current_board[$p][$tmp_x] =~ /\S/ && $p < 15) +{ $full_value += $letter_values{$$current_board[$p][ +$tmp_x]}; $p++; } } } } #now time to do it vertically elsif($orientation eq "Vertical") { for(my ($y,$tmp_y) = (0,$y_pt); $y < scalar(@word_array); $y++ +,$tmp_y++) { #if letter already here we just add it's normal value if($$current_board[$tmp_y][$x_pt] =~ /\S/) { $full_value += $letter_values{$word_array[$y]}; next; } else{ if($premium_squares[$tmp_y][$x_pt] eq " ") { $full_value += $letter_values{$word_array[$y]}; } else{ if($premium_squares[$tmp_y][$x_pt] eq "2L") { $full_value += ($letter_values{$word_array[$y] +}) * 2; } elsif($premium_squares[$tmp_y][$x_pt] eq "3L") { $full_value += ($letter_values{$word_array[$y] +}) * 3; } elsif($premium_squares[$tmp_y][$x_pt] eq "2W") { $full_value += $letter_values{$word_array[$y]} +; $double = 1; } elsif($premium_squares[$tmp_y][$x_pt] eq "3W") { $full_value += $letter_values{$word_array[$y]} +; $triple = 1; } } $letters_used++; } #now if there's a letter behind or in front we add this to +o if(($$current_board[$tmp_y][$x_pt-1] =~ /\S/ && $x_pt > 0) || ($$current_board[$tmp_y][$x_pt+1] =~ /\S/ && $x_pt < 14 +)) { my $p = $x_pt - 1; while($$current_board[$tmp_y][$p] =~ /\S/ && $p >= 0) +{ $p--; } $p++; while($p < $x_pt) { $full_value += $letter_values{$$current_board[$tmp +_y][$p]}; $p++; } $full_value += $letter_values{$word_array[$y]}; $p++; while($$current_board[$tmp_y][$p] =~ /\S/ && $p < 15) +{ $full_value += $letter_values{$$current_board[$tmp +_y][$p]}; $p++; } } } } #now whether to double or triple or boost our results $full_value *= 2 if ($double); $full_value *= 3 if ($triple); $full_value += 50 if ($letters_used == 7); #and now to return our result return $full_value; } #This function decides whether a move is legal #Using the current word-list. sub validate($$$$$$) { my ($self, $letters, $word, $y_pt, $x_pt, $orientation) = @_; my $current_board = $self->curr_board(); $word = uc($word); $letters = uc($letters); #Break our word up into an array of chars. my @word_array = split(//,$word); my $connection = 0; #whether the word is touching another my $use_letter = 0; #whether we use any of our letters #time to validate if horizontal if($orientation eq "Horizontal") { return 0 if ($x_pt > (15 - length($word))); #now to see if we made a runon-word with one behind or in fron +t of us return 0 if (($$current_board[$y_pt][$x_pt-1] =~ /\S/ && $x_pt + > 0) || ($$current_board[$y_pt][$x_pt+length($word)] =~ /\S/ && $x_pt +< (15 - length($word)))); for(my ($x,$tmp_x) = (0,$x_pt); $x < scalar(@word_array); $x++ +,$tmp_x++) { #if there's a letter here we make sure it matches if($$current_board[$y_pt][$tmp_x] =~ /\S/) { return 0 if ($$current_board[$y_pt][$tmp_x] ne $word_a +rray[$x]); $connection = 1; } #if no letter here we make sure we have this letter to pla +ce else { return 0 unless ($letters =~ s/$word_array[$x]//); $use_letter = 1; } } return 0 unless ($connection && $use_letter); #now we look up and down to see if we're touching, at each spo +t for(my ($x,$tmp_x) = (0,$x_pt); $x < scalar(@word_array); $x++ +,$tmp_x++) { next if ($$current_board[$y_pt][$tmp_x] =~ /\S/); if(($$current_board[$y_pt-1][$tmp_x] =~ /\S/ && $y_pt > 0) || ($$current_board[$y_pt+1][$tmp_x] =~ /\S/ && $y_pt < 14 +)) { my $vert_word; my $p = $y_pt - 1; while($$current_board[$p][$tmp_x] =~ /\S/ && $p >= 0) +{ $p--; } $p++; while($p < $y_pt) { $vert_word .= $$current_board[$p][$tmp_x]; $p++; } $vert_word .= $word_array[$x]; $p++; while($$current_board[$p][$tmp_x] =~ /\S/ && $p < 15) +{ $vert_word .= $$current_board[$p][$tmp_x]; $p++; } return 0 unless $self->word_in_dictionary($vert_word); } } } #now time to validate if vertical elsif($orientation eq "Vertical") { return 0 if ($y_pt > (15 - length($word))); #now to see if we made a runon-word with one below or above us return 0 if (($$current_board[$y_pt-1][$x_pt] =~ /\S/ && $y_pt + > 0) || ($$current_board[$y_pt+length($word)][$x_pt] =~ /\S/ && $y_pt +< (15 - length($word)))); for(my ($y,$tmp_y) = (0,$y_pt); $y < scalar(@word_array); $y++ +,$tmp_y++) { #if there's a letter here we make sure it matches if($$current_board[$tmp_y][$x_pt] =~ /\S/) { return 0 if ($$current_board[$tmp_y][$x_pt] ne $word_a +rray[$y]); $connection = 1; } #if no letter here we make sure we have this letter to pla +ce else { return 0 unless ($letters =~ s/$word_array[$y]//); $use_letter = 1; } } return 0 unless ($connection && $use_letter); #now we look left and right to see if we're touching, at each +spot for(my ($y,$tmp_y) = (0,$y_pt); $y < scalar(@word_array); $y++ +,$tmp_y++) { next if ($$current_board[$tmp_y][$x_pt] =~ /\S/); if(($$current_board[$tmp_y][$x_pt-1] =~ /\S/ && $x_pt > 0) || ($$current_board[$tmp_y][$x_pt+1] =~ /\S/ && $x_pt < 14 +)) { my $horiz_word; my $p = $x_pt - 1; while($$current_board[$tmp_y][$p] =~ /\S/ && $p >= 0) +{ $p--; } $p++; while($p < $x_pt) { $horiz_word .= $$current_board[$tmp_y][$p]; $p++; } $horiz_word .= $word_array[$y]; $p++; while($$current_board[$tmp_y][$p] =~ /\S/ && $p < 15) +{ $horiz_word .= $$current_board[$tmp_y][$p]; $p++; } return 0 unless $self->word_in_dictionary($horiz_word) +; } } } else { return 0; } #Well it must be good then, so we return true return 1; } #This function returns a reference to an array #of all words with given letters in our dictionary sub words_with($$) { my ($self, $letters) = @_; my $word_list = $self->word_list(); #now to build our array to return my @words; foreach my $word (@{$word_list}) { next unless (length($word) > 2); if ($self->match($letters, $word)) { push(@words, $word); } } #Now to return reference to our array return \@words; } #This bool function returns whether the second argument #string can be built with the first arguments letters sub match($$$) { my ($self, $letters, $word) = @_; return 0 if (length($word) > length($letters)); $letters = lc($letters); $word = lc($word); #Now we build our hashes my (%letter_hash); while($letters) { $letter_hash{chop($letters)}++; } while($word) { $letter_hash{chop($word)}--; } #Now to analyze my ($key,$value); while(($key,$value) = each(%letter_hash)) { return 0 if ($value < 0); } #Must be good return 1; } #This bool function just returns whether #given word is in dictionary. sub word_in_dictionary($$) { my ($self, $new_word) = @_; $new_word = lc($new_word); my $word_list = $self->word_list(); #now to check each word for equality foreach my $word (@{$word_list}) { return 1 if ($new_word eq $word); } return 0; } #This bool function returns whether or not #the given row on the board is empty. sub row_empty($$) { my ($self, $row) = @_; my $current_board = $self->curr_board(); #Now to check this row for(my $x = 0; $x < 15; $x++) { return 0 if ($$current_board[$row][$x] =~ /\S/); } #Well if they were all empty we return true return 1; } #This bool function returns whether or not #the given column on the board is empty. sub col_empty($$) { my ($self, $col) = @_; my $current_board = $self->curr_board(); #Now to check this column for(my $y = 0; $y < 15; $y++) { return 0 if ($$current_board[$y][$col] =~ /\S/); } #Well if all empty we return true return 1; } #This function returns all the letters on a given row sub row_letters($$) { my ($self, $row) = @_; my $current_board = $self->curr_board(); #So let's get all our letters my $row_letters; for(my $x = 0; $x < 15; $x++) { if($$current_board[$row][$x] =~ /\S/) { $row_letters .= $$current_board[$row][$x]; } } #And we return our letters return $row_letters; } #This function returns all the letters on a given column sub col_letters($$) { my ($self, $col) = @_; my $current_board = $self->curr_board(); #So let's get all our letters my $col_letters; for(my $y = 0; $y < 15; $y++) { if($$current_board[$y][$col] =~ /\S/) { $col_letters .= $$current_board[$y][$col]; } } #And we return our letters return $col_letters; } #This bool function just tells whether board is empty sub board_empty($) { my ($self) = @_; my $current_board = $self->curr_board(); for(my $y = 0; $y < 15; $y++) { for(my $x = 0; $x < 15; $x++) { return 0 if ($$current_board[$y][$x] =~ /\S/); } } return 1; } #This function just returns our object's #Current_board reference sub curr_board($) { my ($self) = @_; return $self->{current_board}; } #This just returns our word list sub word_list($) { my ($self) = @_; return $self->{word_list}; }

In reply to Skrabbel 2 by Anonymous Monk

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others making s'mores by the fire in the courtyard of the Monastery: (5)
    As of 2014-08-02 02:52 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      Who would be the most fun to work for?















      Results (53 votes), past polls