#!/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
+ --#
#---------------------------------------------------------------------
+-----------------------------#
|