#!/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. (Font 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 status bar my $gTotalLightsOn; # Total number of lights currently on my $gTotalMoves; # Total number of moves so far my @gGrid; # Two dimensional grid array my @gSolution; # Solution array (format=row:col) my %gGUIItem; # GUI items #--------------------------------------------------------------------------------------------------# #-- Sub: ButtonName --# #-- Purpose: Returns the name of the button associated with the light 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 classic 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 initial puzzle can be solved in ' . ($#gSolution + 1) . ' moves.'; }, -font => FONT->{normal}, ], [ 'command' => 'Solve', -command => sub { ShowSolution(\@gSolution); 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->messageBox ( -icon => 'info', -message => "Version:\t" . VERSION . "\n" . "Author:\t" . AUTHOR . "\n\n" . ABOUT_TEXT, -title => 'About ' . 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 COLOR->{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 subroutine. 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 => COLOR->{flash}); $gGUIItem{ButtonName($lRow,$lCol)}->configure(-activebackground => 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]) 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; } } } $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 Perl, 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 pressed, its current state is toggled (on buttons turn off, and off buttons turn on.) The buttons immediately above, below, to the left, and to the right of the pressed button are also toggled. =head1 MENU OPTIONS =over 4 =item C Starts a new puzzle. Puzzles are randomly selected and verified that they can actually be solved. =item C Resets the board to the puzzle's initial state. =item C Displays the number of steps it would take for the computer to solve the current puzzle. =item C Solves the current puzzle and shows the steps as they are being taken. =item C Exit the program. =item C 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 --# #--------------------------------------------------------------------------------------------------#