Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??

This is a word search program I wrote to generate word search grids interactively, which I then print out and give to my daughter, who loves them.

#! /usr/bin/perl ###################################################################### +## ## Program: wordsearch ## Description: Interactively queries the user for words to add, then ## adds and displays the modified grid. On completion, ## displays the grid and list of words within. ###################################################################### +## use strict; use warnings; use Getopt::Long; my $help; my $width = 20; my $height = 20; GetOptions ("help" => \$help, "width=i" => \$width, "height=i" => \$height); if ($help) { print <<EOHELP; Usage: ws [-width W] [-height H] [-help] EOHELP exit 1; } # Orientations are thus: # 7 0 1 # \ | / # 6 --.-- 2 # / | \ # 5 4 3 my @xdelta = (0, 1, 1, 1, 0, -1, -1, -1); my @ydelta = (-1, -1, 0, 1, 1, 1, 0, -1); # Initialize the grid. my @grid; my @words; initializeGrid (\@grid, $width, $height); displayGrid (\@grid); $| = 1; srand (time); my $command = ''; while (1) { $command = getCommand (); last if $command eq 'quit'; if ($command eq 'finish') { fillGapsInGrid (\@grid, $width, $height); displayGrid (\@grid); displayWords (\@words); last; } if ($command eq 'help' || $command eq '?') { print <<EOHELP; The folllowing commands are supported: add <word> adds the word to the grid, if possible help displays this message ? displays this message finish fills in the remains of the grid, prints out grid and wo +rds quit quits program EOHELP next; } my ($words) = $command =~ /^add (.+)$/; for my $word (split /\s+/, $words) { if (addWord (\@grid, $word)) { push @words, $word; displayGrid (\@grid); } else { print "Could not add '$word'\n"; } } } exit 0; ###################################################################### +## sub initializeGrid { my ($grid, $width, $height) = @_; for my $r (0 .. $height - 1) { $grid->[$r] = '.' x $width; } } ###################################################################### +## sub fillGapsInGrid { my ($grid, $width, $height) = @_; my @alphabet = ('a' .. 'z'); $_ =~ s/\./$alphabet[rand (26)]/eg for @$grid; } ###################################################################### +## sub displayGrid { my ($grid) = @_; print "\n"; for (@$grid) { my $row = $_; $row =~ s/(.)/ $1/g; print $row, "\n"; } print "\n"; } ###################################################################### +## sub displayWords { my ($words) = @_; print "\n", join (', ', @$words), "\n";; } ###################################################################### +## sub getCommand { my $input = ''; while (1) { print "> "; $input = lc <>; chomp $input; return $input if $input =~ /^(?:quit|finish|help|\?|add .+)$/; print "Command '$input' not recognized\n" if $input; } } ###################################################################### +## sub addWord { my ($grid, $word) = @_; # The random algorithm. for (0 .. $width * $height * 8) { my $x = int rand $width; my $y = int rand $height; my $dir = int rand 8; if (wordFits ($grid, $word, $x, $y, $dir)) { insertWord ($grid, $word, $x, $y, $dir); return 1; } } # The exhaustive algorithm. for my $dir (0 .. 7) { for my $y (0 .. $height - 1) { for my $x (0 .. $width - 1) { if (wordFits ($grid, $word, $x, $y, $dir)) { insertWord ($grid, $word, $x, $y, $dir); return 1; } } } } return 0; } ###################################################################### +## sub wordFits { my ($grid, $word, $x, $y, $dir) = @_; #print "testing $word at [$x,$y] dir $dir\n"; my $xi = $xdelta[$dir]; my $yi = $ydelta[$dir]; # Simple rejection based on length. my $endx = $x + (length ($word) - 1) * $xi; my $endy = $y + (length ($word) - 1) * $yi; return 0 if $endx >= $width || $endx < 0 || $endy >= $height || $endy < 0; for my $i (0 .. length ($word) - 1) { my $x0 = $x + ($i * $xi); my $y0 = $y + ($i * $yi); #print "looking for " . substr ($word, $i, 1) . " at $x0,$y0\n"; return 0 if substr ($grid->[$y0], $x0, 1) ne '.' && substr ($grid->[$y0], $x0, 1) ne substr ($word, $i, 1) +; } return 1; } ###################################################################### +## sub insertWord { my ($grid, $word, $x, $y, $dir) = @_; my $xi = $xdelta[$dir]; my $yi = $ydelta[$dir]; for my $i (0 .. length ($word) - 1) { my $x0 = $x + ($i * $xi); my $y0 = $y + ($i * $yi); my $row = $grid->[$y0]; $row = substr ($row, 0, $x0) . substr ($word, $i, 1) . substr ($row, $x0 + 1, length ($row) - $x0 - 1); $grid->[$y0] = $row; } } ###################################################################### +##



pbeckingham - typist, perishable vertebrate.

In reply to Word Search Builder by pbeckingham

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 avoiding work at the Monastery: (10)
    As of 2014-11-27 11:59 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      My preferred Perl binaries come from:














      Results (184 votes), past polls