The Labs.Com Issue_04_OO

TPJ: Issue_04_OO

This is a collection of programs published by The Perl Journal. You can download all source-code also from TPJ: Programs.

1. 8q
2. Queen.pm
3. Queen
4. More Samples on OO

Download 8q

#!/usr/local/bin/perl -w

use strict;

require Queen;

require Queen::Null;

my $lastQueen;

my $column;

my $neighbour = new Queen::Null;

foreach $column (1 .. 8) {

$lastQueen = new Queen;

$lastQueen->initialColumn ($column, $neighbour);

$neighbour = $lastQueen;

}

if ($lastQueen->first ()) {

my $tuple;

foreach $tuple (@{$lastQueen->getState ()}) {

print "row: $tuple->[0] column: $tuple->[1]\n";

}

}

Issue_04_OO 2. Queen.pm

Download Queen.pm

package Queen;

;#####################################################################\

#########

;#

;# This is a pretty straight translation of Timothy Budd's Objective C\

8 queens

;# solution presented in Appendix A of the first edition of "An Introd\

uction To

;# Object-Oriented Programming" published by Addison-Wesley (ISBN 0 20\

1 54709

;# 0)

;#

;#####################################################################\

#########

use strict;

;#####################################################################\

#########

;#

;# new

;#

sub new {

my $type = shift;

return bless {}, $type;

}

;#####################################################################\

#########

;#

;# initialColumn

;#

;# initialise the column and neighbour values

;#

sub initialColumn {

my $self = shift;

$self->{'column'} = shift;

$self->{'neighbour'} = shift;

return;

}

;#####################################################################\

#########

;#

;# canAttack

;#

;# check to see if queen or neighbours can attack a given position

;#

sub canAttack {

my $self = shift;

my $row = shift;

my $column = shift;

$self->{'row'} == $row and return 1;

my $cd = abs ($column - $self->{'column'});

my $rd = abs ($row - $self->{'row'});

$cd == $rd and return 1;

return $self->{'neighbour'}->canAttack ($row, $column);

}

;#####################################################################\

#########

;#

;# testOrAdvance

;#

;# test a given position, advancing if not acceptable

;#

sub testOrAdvance {

my $self = shift;

if ($self->{'neighbour'}->canAttack (@{$self}{'row', 'column'}\

)) {

return $self->next ();

}

return 1;

}

;#####################################################################\

#########

;#

;# first

;#

;# compute first legal position for queen and neighbours

;#

sub first {

my $self = shift;

$self->{'row'} = 1;

if ($self->{'neighbour'}->first ()) {

return $self->testOrAdvance ();

}

return 0;

}

;#####################################################################\

#########

;#

;# next

;#

;# compute next legal position for queen and neighbours

;#

;# note that perl will give "Deep Recursion" warnings if $^W isn't tur\

ned off

;# here.  Usually that's a "good thing", but here recursion is intende\

d to go

;# as deep as is necessary to generate a valid solution.

sub next {

my $self = shift;

local $^W = 0;

if ($self->{'row'} == 8) {

unless ($self->{'neighbour'}->next ()) {

return 0;

}

else {

$self->{'row'} = 0;

}

}

$self->{'row'}++;

return $self->testOrAdvance ();

}

;#####################################################################\

#########

;#

;# getState

;#

;# collect state about the current state from neighbours and an my own\

state

;# before returning a reference to an anonymous list of row/column tup\

les

;#

sub getState {

my $self = shift;

my $stateArray = $self->{'neighbour'}->getState ();

push @$stateArray, [@{$self}{'row', 'column'}];

return $stateArray;

}

1;

Issue_04_OO 3. Queen

Download Queen

Issue_04_OO 4. More Samples on OO

• Issue_04_OO