Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
#!/usr/bin/perl -w use strict; #--------------------------------------------------------------------- +-----------------------------# #-- + --# #-- Script: LightsOut.pl + --# #-- Purpose: Plays the game Lights Out + --# #-- + --# #-- Author: Robert(Bob) Smith + --# #-- Date: November 28, 2001 + --# #-- + --# #-- Wish List: Enable users to create their own puzzles + --# #-- Since the order in which buttons are pressed does not +matter, could randomize --# #-- the solution so the method is not as obvious. + --# #-- Spacing of objects is not quite right under Linux. (Fo +nt issue?) --# #-- + --# #-- Rev Hist: 2001-11-28 00.00.a rws Initial version + --# #-- 2001-11-29 00.00.b rws Cleaned up the code a bit + --# #-- + --# #--------------------------------------------------------------------- +-----------------------------# #--------------------------------------------------------------------- +-----------------------------# #-- Use modules + --# #--------------------------------------------------------------------- +-----------------------------# use Tk; #--------------------------------------------------------------------- +-----------------------------# #-- Define constants + --# #--------------------------------------------------------------------- +-----------------------------# use constant VERSION => '00.00.b'; use constant AUTHOR => 'Robert(Bob) Smith'; use constant TRUE => 1; use constant FALSE => 0; use constant COLOR => { 'button' => 'black', 'flash' => 'red', 'label' => 'black', 'off' => 'grey55', 'on' => 'blue', 'status' => 'red', }; use constant ERR => { 'ok' => 0, }; use constant FONT => { 'normal' => 'Arial 10 normal', }; use constant MAINWINDOW => { 'height' => 210, 'title' => 'Lights Out', 'width' => 270, }; #--------------------------------------------------------------------- +-----------------------------# #-- Define variables + --# #--------------------------------------------------------------------- +-----------------------------# my $gMainWindow; # Main GUI window my $gStatusMsg; # Message to display on the st +atus bar my $gTotalLightsOn; # Total number of lights curre +ntly on my $gTotalMoves; # Total number of moves so far my @gGrid; # Two dimensional grid array my @gSolution; # Solution array (format=row:c +ol) my %gGUIItem; # GUI items #--------------------------------------------------------------------- +-----------------------------# #-- Sub: ButtonName + --# #-- Purpose: Returns the name of the button associated with the lig +ht located at the --# #-- specified row and column + --# #-- + --# #-- Parameters: pRow - Light row + --# #-- pCol - Light column + --# #-- + --# #--------------------------------------------------------------------- +-----------------------------# sub ButtonName { #-- Get parameters my $pRow=shift; my $pCol=shift; #-- Return the button name return sprintf('cmdGrid_%02d_%02d',$pRow,$pCol); } #--------------------------------------------------------------------- +-----------------------------# #-- Sub: CreateButtons + --# #-- Purpose: Creates the buttons + --# #-- + --# #-- Parameters: None + --# #-- + --# #--------------------------------------------------------------------- +-----------------------------# sub CreateButtons { #-- Define local variables my $lRow; my $lCol; #-- Create the buttons foreach $lRow (0..4) { foreach $lCol (0..4) { $gGUIItem{ButtonName($lRow,$lCol)} = $gMainWindow->Button ( -activebackground => COLOR->{off}, -anchor => 'center', -background => COLOR->{off}, -borderwidth => 2, -command => sub { PushButton($lRow,$lCol); }, -font => FONT->{normal}, -foreground => COLOR->{off}, -relief => 'groove', -state => 'normal', -text => '', -width => 5, )->grid( -row => ($lRow + 1), -col => $lCol); } } } #--------------------------------------------------------------------- +-----------------------------# #-- Sub: CreateMainWin + --# #-- Purpose: Creates the main Tk window + --# #-- + --# #-- Parameters: None + --# #-- + --# #--------------------------------------------------------------------- +-----------------------------# sub CreateMainWin { #-- Define local variables my $lWinX; my $lWinY; #-- Create the window $gMainWindow = MainWindow->new; $gMainWindow->title(MAINWINDOW->{title}); $lWinX = int(($gMainWindow->screenwidth - MAINWINDOW->{width})/2); $lWinY = int(($gMainWindow->screenheight - MAINWINDOW->{height})/2); $gMainWindow->geometry ( MAINWINDOW->{width} . 'x' . MAINWINDOW->{height} . '+' . $lWinX . '+' . $lWinY ); $gMainWindow->resizable(FALSE,FALSE); } #--------------------------------------------------------------------- +-----------------------------# #-- Sub: CreateMenu + --# #-- Purpose: Creates the menu + --# #-- + --# #-- Parameters: None + --# #-- + --# #--------------------------------------------------------------------- +-----------------------------# sub CreateMenu { #-- Define local constants use constant ABOUT_TEXT => 'Perl/Tk version of Tiger Electronics cla +ssic Lights Out.'; #-- Add the Game menu $gGUIItem{mnuFile} = $gMainWindow->Menubutton ( -anchor => 'w', -direction => 'below', -font => FONT->{normal}, -foreground => COLOR->{button}, -indicatoron => FALSE, -menuitems => [ [ 'command' => 'New', -command => sub { GenerateRandomGrid(\@ +gGrid,\@gSolution); DisplayGrid(\@gGrid); SaveGrid(\@gGrid); }, -font => FONT->{normal}, ], [ 'command' => 'Reset Puzzle', -command => sub { DisplayGrid(\@gGrid); }, -font => FONT->{normal}, ], [ 'command' => 'Count Steps', -command => sub { $gStatusMsg = 'The ini +tial puzzle can be solved in ' . ($#gSolu +tion + 1) . ' moves.'; }, -font => FONT->{normal}, ], [ 'command' => 'Solve', -command => sub { ShowSolution(\@gSolut +ion); DisplayGrid(\@gGrid); }, -font => FONT->{normal}, ], '-', [ 'command' => 'Exit', -command => sub { $gMainWindow->destroy; }, -font => FONT->{normal}, ] ], -tearoff => FALSE, -text => 'Game', -width => 5, )->grid( -row => 0, -col => 0); #-- Add the help menu $gGUIItem{mnuHelp} = $gMainWindow->Menubutton ( -anchor => 'w', -direction => 'below', -font => FONT->{normal}, -foreground => COLOR->{button}, -indicatoron => FALSE, -menuitems => [ [ 'command' => 'About', -command => sub { $gMainWindow->messageB +ox ( -icon => 'info +', -message => "Vers +ion:\t" . VERSION . "\n" . "Auth +or:\t" . AUTHOR . "\n\n" . ABOUT +_TEXT, -title => 'Abou +t ' . MAINWINDOW->{title}, -type => 'Ok', ); }, -font => FONT->{normal}, ] ], -tearoff => FALSE, -text => 'Help', -width => 5, )->grid( -row => 0, -col => 4); } #--------------------------------------------------------------------- +-----------------------------# #-- Sub: CreateStatusBar + --# #-- Purpose: Creates the status bar + --# #-- + --# #-- Parameters: None + --# #-- + --# #--------------------------------------------------------------------- +-----------------------------# sub CreateStatusBar { #-- Add the status bar $gGUIItem{barStatus} = $gMainWindow->Label ( -anchor => 'w', -font => FONT->{normal}, -foreground => COLOR->{status}, -relief => 'flat', -textvariable => \$gStatusMsg, -width => 36, )->grid( -row => 6, -col => 0, -columnspan => 5); } #--------------------------------------------------------------------- +-----------------------------# #-- Sub: DisplayGrid + --# #-- Purpose: Displays the current grid + --# #-- + --# #-- Parameters: pGrid - Grid to display + --# #-- + --# #--------------------------------------------------------------------- +-----------------------------# sub DisplayGrid { #-- Get parameters my $pGrid=shift; #-- Define local variables my $lCol; my $lRow; #-- Display the grid foreach $lRow (0..4) { foreach $lCol (0..4) { SetLight($lRow,$lCol,$$pGrid[$lRow][$lCol]); } } #-- Reset global variables $gStatusMsg=''; $gTotalMoves=0; $gTotalLightsOn=HowManyLightsOn(); } #--------------------------------------------------------------------- +-----------------------------# #-- Sub: GenerateRandomGrid + --# #-- Purpose: Generates a random grid + --# #-- + --# #-- Parameters: pGrid - Grid to create + --# #-- pSolution - Solution array + --# #-- + --# #--------------------------------------------------------------------- +-----------------------------# sub GenerateRandomGrid { #-- Get parameters my $pGrid=shift; my $pSolution=shift; #-- Define local variables my $lCol; my $lRow; #-- Clear grid #-- May take this line out as all elements are overwritten @$pGrid=(); #-- Generate a random solvable grid while (TRUE) { #-- Generate a grid foreach $lRow (0..4) { foreach $lCol (0..4) { $$pGrid[$lRow][$lCol]=(int(rand(6)) < 3 ? TRUE : FALSE); } } #-- Check for solution SolveGrid(\@$pGrid, \@$pSolution); last if ($#$pSolution > -1); } } #--------------------------------------------------------------------- +-----------------------------# #-- Sub: HowManyLightOn + --# #-- Purpose: Counts how many lights are still on + --# #-- + --# #-- Parameters: None + --# #-- + --# #--------------------------------------------------------------------- +-----------------------------# sub HowManyLightsOn { #-- Define local variables my $lCol; my $lLightsOn=0; my $lRow; #-- Create the buttons foreach $lRow (0..4) { foreach $lCol (0..4) { $lLightsOn++ if IsLightOn($lRow,$lCol); } } #-- Return the number of lights on return $lLightsOn; } #--------------------------------------------------------------------- +-----------------------------# #-- Sub: IsLightOn + --# #-- Purpose: Returns TRUE if the specified light is on, FALSE if it + is off --# #-- + --# #-- Parameters: pRow - Light row + --# #-- pCol - Light column + --# #-- + --# #--------------------------------------------------------------------- +-----------------------------# sub IsLightOn { #-- Get parameters my $pRow=shift; my $pCol=shift; #-- Return the button status return ($gGUIItem{ButtonName($pRow,$pCol)}->cget(-background) eq COL +OR->{on}); } #--------------------------------------------------------------------- +-----------------------------# #-- Sub: PushButton + --# #-- Purpose: Handles the logic of pushing a button + --# #-- + --# #-- Parameters: pRow - Button row + --# #-- pCol - Button column + --# #-- + --# #--------------------------------------------------------------------- +-----------------------------# sub PushButton { #-- Get parameters my $pRow=shift; my $pCol=shift; #-- Toggle buttons ToggleLight($pRow,$pCol); ToggleLight($pRow-1,$pCol) unless $pRow==0; ToggleLight($pRow+1,$pCol) unless $pRow==4; ToggleLight($pRow,$pCol-1) unless $pCol==0; ToggleLight($pRow,$pCol+1) unless $pCol==4; #-- Increment the total number of moves $gTotalMoves++; $gStatusMsg = 'Moves so far: ' . $gTotalMoves; #-- Check for all lights out $gStatusMsg = 'You win, game over!' unless $gTotalLightsOn; } #--------------------------------------------------------------------- +-----------------------------# #-- Sub: SaveGrid + --# #-- Purpose: Saves the grid for future use + --# #-- + --# #-- Parameters: pGrid - Array in which the grid is to be saved + --# #-- + --# #--------------------------------------------------------------------- +-----------------------------# sub SaveGrid { #-- Get parameters my $pGrid=shift; #-- Define local variables my $lCol; my $lRow; #-- Clear the old grid #-- May take this line out as all elements are overwritten @$pGrid=(); #-- Save the current grid foreach $lRow (0..4) { foreach $lCol (0..4) { $$pGrid[$lRow][$lCol]=IsLightOn($lRow,$lCol); } } } #--------------------------------------------------------------------- +-----------------------------# #-- Sub: SetLight + --# #-- Purpose: Sets the status of a light to either on (TRUE) or off +(FALSE) --# #-- + --# #-- Parameters: pRow - Light row + --# #-- pCol - Light column + --# #-- pStatus - On or Off + --# #-- + --# #--------------------------------------------------------------------- +-----------------------------# sub SetLight { #-- Get parameters my $pRow=shift; my $pCol=shift; my $pStatus=shift; #-- Set the button if ($pStatus) { $gGUIItem{ButtonName($pRow,$pCol)}->configure(-background => COLOR +->{on}); $gGUIItem{ButtonName($pRow,$pCol)}->configure(-activebackground => + COLOR->{on}); } else { $gGUIItem{ButtonName($pRow,$pCol)}->configure(-background => COLOR +->{off}); $gGUIItem{ButtonName($pRow,$pCol)}->configure(-activebackground => + COLOR->{off}); } } #--------------------------------------------------------------------- +-----------------------------# #-- Sub: ShowSolution + --# #-- Purpose: Solves the puzzle on the screen + --# #-- + --# #-- Parameters: pSolution - Solution array + --# #-- + --# #-- Notes: I have used DoOneEvent() quite a bit in this subroutin +e. This code generates --# #-- a lot of events -- changing colors and such which are +not processed unless --# #-- the system is told to do so. + --# #-- + --# #--------------------------------------------------------------------- +-----------------------------# sub ShowSolution { #-- Get parameters my $pSolution=shift; #-- Define local constants use constant FLASH_PAUSE => 500; #-- Define local variables my $lButtonStatus; my $lCol; my $lRow; #-- Reset the puzzle DisplayGrid(\@gGrid); DoOneEvent(); #-- Press keys to solve foreach (@$pSolution) { #-- Parse the solution ($lRow,$lCol)=split(':'); #-- Save the initial button status $lButtonStatus=IsLightOn($lRow,$lCol); #-- Show which button we are going to use foreach (0..3) { #-- Flash the button #-- Using modulus (remainder) operator. TRUE for 1 and 3, FALSE +for 0 and 2 (remainder == 0) if ($_ % 2) { SetLight($lRow,$lCol,$lButtonStatus); } else { $gGUIItem{ButtonName($lRow,$lCol)}->configure(-background => C +OLOR->{flash}); $gGUIItem{ButtonName($lRow,$lCol)}->configure(-activebackgroun +d => COLOR->{flash}); } DoOneEvent(); #-- Pause $gMainWindow->after(FLASH_PAUSE); DoOneEvent(); } #-- Press the button $gGUIItem{ButtonName($lRow,$lCol)}->invoke(); DoOneEvent(); } } #--------------------------------------------------------------------- +-----------------------------# #-- Sub: SolveGrid + --# #-- Purpose: Solves the grid and populates the solution array + --# #-- + --# #-- Parameters: pGrid - Grid to solve + --# #-- pSolution - Solution array + --# #-- + --# #--------------------------------------------------------------------- +-----------------------------# sub SolveGrid { #-- Get parameters my $pGrid=shift; my $pSolution=shift; #-- Define local constants use constant SOLUTION => { '00000' => '', '00111' => '3', '01010' => '0:3', '01101' => '0', '10001' => '0:1', '10110' => '4', '11011' => '2', '11100' => '1', }; #-- Define local variables my $lCol; my $lSolutionKey; my $lRow; my @lTmpGrid; #-- Initialize variables foreach $lRow (0..4) { foreach $lCol (0..4) { $lTmpGrid[$lRow][$lCol]=$$pGrid[$lRow][$lCol]; } } @$pSolution=(); #-- Locate the solution key foreach $lRow (1..4) { foreach $lCol (0..4) { if ($lTmpGrid[$lRow-1][$lCol]) { $lTmpGrid[$lRow][$lCol]=(1 - $lTmpGrid[$lRow][$lCol]); $lTmpGrid[$lRow-1][$lCol]=(1 - $lTmpGrid[$lRow-1][$lCol]) unle +ss $lRow==0; $lTmpGrid[$lRow+1][$lCol]=(1 - $lTmpGrid[$lRow+1][$lCol]) unle +ss $lRow==4; $lTmpGrid[$lRow][$lCol-1]=(1 - $lTmpGrid[$lRow][$lCol-1]) unle +ss $lCol==0; $lTmpGrid[$lRow][$lCol+1]=(1 - $lTmpGrid[$lRow][$lCol+1]) unle +ss $lCol==4; } } } $lSolutionKey = sprintf( '%d%d%d%d%d', $lTmpGrid[4][0], $lTmpGrid[4][1], $lTmpGrid[4][2], $lTmpGrid[4][3], $lTmpGrid[4][4] ); #-- Populate the solution array if (defined(SOLUTION->{$lSolutionKey})) { #-- Reset the working array foreach $lRow (0..4) { foreach $lCol (0..4) { $lTmpGrid[$lRow][$lCol]=$$pGrid[$lRow][$lCol]; } } #-- Save the key presses to solve foreach (split(':',SOLUTION->{$lSolutionKey})) { push @$pSolution, '0:' . $_; $lTmpGrid[0][$_] = (1 - $lTmpGrid[0][$_]); $lTmpGrid[1][$_] = (1 - $lTmpGrid[1][$_]); $lTmpGrid[0][$_ - 1] = (1 - $lTmpGrid[0][$_ - 1]) unless $_ == 0 +; $lTmpGrid[0][$_ + 1] = (1 - $lTmpGrid[0][$_ + 1]) unless $_ == 4 +; } foreach $lRow (1..4) { foreach $lCol (0..4) { if ($lTmpGrid[$lRow-1][$lCol]) { push @$pSolution, sprintf('%d:%d',$lRow,$lCol); $lTmpGrid[$lRow][$lCol] = (1 - $lTmpGrid[$lRow][$lCol]); $lTmpGrid[$lRow-1][$lCol] = (1 - $lTmpGrid[$lRow-1][$lCol]) +unless $lRow==0; $lTmpGrid[$lRow+1][$lCol] = (1 - $lTmpGrid[$lRow+1][$lCol]) +unless $lRow==4; $lTmpGrid[$lRow][$lCol-1] = (1 - $lTmpGrid[$lRow][$lCol-1]) +unless $lCol==0; $lTmpGrid[$lRow][$lCol+1] = (1 - $lTmpGrid[$lRow][$lCol+1]) +unless $lCol==4; } } } } } #--------------------------------------------------------------------- +-----------------------------# #-- Sub: ToggleLight + --# #-- Purpose: Toggles the state of a light -- off->on and on->off + --# #-- + --# #-- Parameters: pRow - Light row + --# #-- pCol - Light column + --# #-- + --# #--------------------------------------------------------------------- +-----------------------------# sub ToggleLight { #-- Get parameters my $pRow=shift; my $pCol=shift; #-- Update the total number of lights on $gTotalLightsOn += (IsLightOn($pRow,$pCol) ? -1 : 1); #-- Toggle the button SetLight($pRow,$pCol,!IsLightOn($pRow,$pCol)); } #--------------------------------------------------------------------- +-----------------------------# #-- Initialize the random number generator + --# #--------------------------------------------------------------------- +-----------------------------# srand(time() ^ ($$ + ($$ << 15))); # Suggestion from Programming P +erl, pg 223 #--------------------------------------------------------------------- +-----------------------------# #-- Initialize variables + --# #--------------------------------------------------------------------- +-----------------------------# $gStatusMsg=''; #--------------------------------------------------------------------- +-----------------------------# #-- Create the main window + --# #--------------------------------------------------------------------- +-----------------------------# CreateMainWin(); CreateMenu(); CreateButtons(); CreateStatusBar(); #--------------------------------------------------------------------- +-----------------------------# #-- Generate an initial puzzle + --# #--------------------------------------------------------------------- +-----------------------------# GenerateRandomGrid(\@gGrid,\@gSolution); DisplayGrid(\@gGrid); SaveGrid(\@gGrid); #--------------------------------------------------------------------- +-----------------------------# #-- Tk Main loop + --# #--------------------------------------------------------------------- +-----------------------------# MainLoop; #--------------------------------------------------------------------- +-----------------------------# #-- Exit + --# #--------------------------------------------------------------------- +-----------------------------# exit(ERR->{ok}); #--------------------------------------------------------------------- +-----------------------------# #-- Documentation + --# #--------------------------------------------------------------------- +-----------------------------# __END__ =pod =head1 NAME LightsOut.pl - Perl/Tk version of the popular Lights Out game. =head1 CREDITS The classic "Lights Out" game was manufactured by Tiger Electronics. =head1 GOAL AND RULES The goal of the game is to turn all the lights off. When a button is p +ressed, its current state is toggled (on buttons turn off, and off buttons turn on.) The buttons im +mediately above, below, to the left, and to the right of the pressed button are also toggled. =head1 MENU OPTIONS =over 4 =item C<Game/New> Starts a new puzzle. Puzzles are randomly selected and verified that t +hey can actually be solved. =item C<Game/Reset Puzzle> Resets the board to the puzzle's initial state. =item C<Game/Count Steps> Displays the number of steps it would take for the computer to solve t +he current puzzle. =item C<Game/Solve> Solves the current puzzle and shows the steps as they are being taken. =item C<Game/Exit> Exit the program. =item C<Help/About> Displays the version, author, and brief description of the game. =back =head1 AUTHOR AND COPYRIGHT Copyright 2001, Robert(Bob) Smith This program may be used under the same terms as Perl itself. Code is +supplied "as is" with no warranties that it even works. *Grins* =cut #--------------------------------------------------------------------- +-----------------------------# #-- End of Script + --# #--------------------------------------------------------------------- +-----------------------------#

In reply to Perl/Tk Lights Out by Rhose

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
  • 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 cooling their heels in the Monastery: (8)
    As of 2015-07-29 21:05 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









      Results (269 votes), past polls