Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

comment on

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

The Times newspaper features an occasional "The Listener Crossword" which is in fact a numerically based logic puzzle in the form of a crossword. A friend of mine introduced me to the genera with #4321 which is a puzzle of two parts. The first part consists of populating the playing grid with hexadecimal numbers. The second part consist of using the populated grid to play a game of solitaire which, when played correctly on a correctly constructed grid ends up spelling out three words. There is a certain amount of trial and error involved in finding the solution!

So to aid playing the game in the second part of the puzzle I wrote the following script. The gameGrid is configured for a partial solution of the game. A feature of the code is that you can "save" the game state at any point then paste the saved gameGrid in place of the current grid to explore possibilities from that point.

As far as I can tell developing tools of this sort is all part of the solution domain for the puzzle. They are very much one off puzzles as each "crossword" is a puzzle of a completely different nature, so it is very unlikely that this tool will be useful for another "Crossword Puzzle". But it is a cool use for Perl!

Note that a few shortcuts have been taken in the code. In particular global variables are used, which I usually avoid. The rendered grid is not very pretty and the layout generally is rough, but good enough for the task at hand.

Play consists of clicking on a "peg" (piece to be moved) then an "empty" cell ("_") skipping over one intervening piece. The skipped piece is removed and added to the "skipped" string. Moves can be undone back to the starting state. For instructions beyond these you will need to find the original puzzle instructions and create the starting grid.

use strict; use warnings; use Tk; my @gameGrid = ( # Word search start [qw(- - _ C C - -)], [qw(- - _ 0 _ - -)], [qw(D D 1 1 _ C A)], [qw(B _ 0 0 _ B F)], [qw(_ E _ C _ _ 0)], [qw(- - _ _ _ - -)], [qw(- - _ _ _ - -)], ); my $main = Tk::MainWindow->new(-title => "X4321"); my @rows; for my $rowIdx (0 .. 6) { for my $colIdx (0 .. 6) { next if ($rowIdx < 2 || $rowIdx > 4) && ($colIdx < 2 || $colId +x > 4); $rows[$rowIdx][$colIdx] = $main->Button( -textvariable => \$gameGrid[$rowIdx][$colIdx], -command => sub {onClick($rowIdx, $colIdx)} )->form( -top => $rowIdx * 20 + 2, -bottom => $rowIdx * 20 + 19, -left => $colIdx * 75 + 2, -right => $colIdx * 75 + 73 ); } } my @fromValue = ''; my $overValue = ''; my $lastToValue = ''; my $skipped = ''; my @stack; my $topPix = 7 * 20 + 2; my $botPix = 7 * 20 + 19; my $fromField = $main->Label(-textvariable => \$fromValue[0]) ->form( -top => $topPix, -bottom => $botPix, -left => 4, -right => 70 ); my $overField = $main->Label(-textvariable => \$overValue) ->form( -top => $topPix, -bottom => $botPix, -left => 74, -right => 140 ); my $toField = $main->Label(-textvariable => \$lastToValue) ->form( -top => $topPix, -bottom => $botPix, -left => 144, -right => 210 ); my $skippedField = $main->Label(-textvariable => \$skipped) ->form( -top => $topPix, -bottom => $botPix, -left => 214, -right => 460 ); my $undo = $main->Button(-text => 'undo', -command => sub {onUndo()}) ->form( -top => $topPix, -bottom => $botPix, -left => 464, -right => 510 ); my $save = $main->Button(-text => 'save', -command => sub {onSave()}) ->form( -top => $topPix, -bottom => $botPix, -left => 514, -right => 560 ); Tk::MainLoop(); sub onClick { my ($rowIdx, $colIdx) = @_; if (!$fromValue[0]) { $fromValue[0] = sprintf "%d, %d: %s", $rowIdx, $colIdx, $gameG +rid[$rowIdx][$colIdx]; $fromValue[1] = $rowIdx; $fromValue[2] = $colIdx; $lastToValue = ''; return; } if ($rowIdx == $fromValue[1] && $colIdx == $fromValue[2]) { $fromValue[0] = ''; return; } if ( !( ($rowIdx == $fromValue[1] && abs($colIdx - $fromValue[2 +]) == 2) || ($colIdx == $fromValue[2] && abs($rowIdx - $fromValue[1 +]) == 2) ) || $gameGrid[$rowIdx][$colIdx] ne '_' ) { $lastToValue = 'Invalid'; return; } my $rowMid = ($rowIdx + $fromValue[1]) / 2; my $colMid = ($colIdx + $fromValue[2]) / 2; push @stack, [$gameGrid[$rowMid][$colMid], @fromValue[1, 2], $rowI +dx, $colIdx]; $skipped = join ' ', map {$_->[0]} @stack; $gameGrid[$rowIdx][$colIdx] = $gameGrid[$fromValue[1]][$fromValue[ +2]]; $gameGrid[$rowMid][$colMid] = '_'; $gameGrid[$fromValue[1]][$fromValue[2]] = '_'; $fromValue[0] = ''; } sub onUndo { return if !@stack; my $move = pop @stack; my ($delChar, $fromRow, $fromCol, $toRow, $toCol) = @$move; my $rowMid = ($fromRow + $toRow) / 2; my $colMid = ($fromCol + $toCol) / 2; $gameGrid[$fromRow][$fromCol] = $gameGrid[$toRow][$toCol]; $gameGrid[$rowMid][$colMid] = $delChar; $gameGrid[$toRow][$toCol] = '_'; $skipped = join ' ', map {$_->[0]} @stack; $fromValue[0] = ''; } sub onSave { print "my \@gameGrid = (\n"; for my $rowIdx (0 .. 6) { print " [qw("; print join ' ', @{$gameGrid[$rowIdx]}; print ")],\n"; } print " );\n"; }
Optimising for fewest key strokes only makes sense transmitting to Pluto or beyond

In reply to Listener Crossword #4321 solitaire by GrandFather

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!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • 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
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            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 having an uproarious good time at the Monastery: (6)
    As of 2019-09-21 02:28 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      The room is dark, and your next move is ...












      Results (269 votes). Check out past polls.

      Notices?