| Category: | GUI Programming |
| Author/Contact Info | Rhose |
| Description: | Not having used the grid geometry manager in Tk, and not having included pod documentation (redundant), I threw together this version of the Tiger Elctronic's Lights Out game to play with both concepts. I would appreciate any comments on the code (suggestions for improvement would be great). I am also interested in comments on this dumb habbit I picked up -- creating all my GUI objects in a hash array. |
#!/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 + --# #--------------------------------------------------------------------- +-----------------------------# |
|
Back to
Code Catacombs