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 Introduction To ;# Object-Oriented Programming" published by Addison-Wesley (ISBN 0 201 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 turned off ;# here. Usually that's a "good thing", but here recursion is intended 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 tuples ;# sub getState { my $self = shift; my $stateArray = $self->{'neighbour'}->getState (); push @$stateArray, [@{$self}{'row', 'column'}]; return $stateArray; } 1;