#!/usr/bin/perl -w
#
# $Id: chess960open,v 1.2 2006/11/09 07:41:47 jmates Exp $
#
# Print positions from left to right for Chess960 opening:
# http://en.wikipedia.org/wiki/Chess960
use strict;
my @pieces = qw(Rook Knight Bishop Queen King Bishop Knight Rook);
my %piece_map = (
'utf8' => {
Rook => '♖',
Knight => '♘',
Bishop => '♗',
Queen => '♕',
King => '♔',
},
);
determine_positions( \@pieces );
if ( !-t 0 ) {
require CGI;
require HTML::Template;
my @piece_list;
for my $piece (@pieces) {
push @piece_list,
{ name => $piece, symbol => $piece_map{utf8}->{$piece} };
}
my $cgi = CGI->new();
my $template = HTML::Template->new(
filehandle => *DATA,
die_on_bad_params => 0,
loop_context_vars => 1
);
$template->param( 'PIECE_LIST_WHITE' => \@piece_list, );
print $cgi->header( -type => 'text/html', -charset => 'utf8' );
print $template->output;
} else {
# for CLI or text only output
print join( ' ', @pieces ), "\n";
}
sub determine_positions {
my $pieces_ref = shift;
POSITIONS: {
fisher_yates_shuffle($pieces_ref);
unless ( validate_positions($pieces_ref) ) {
redo POSITIONS;
}
}
return 1;
}
# Returns 1 if $pieces_ref valid layout, 0 otherwise
sub validate_positions {
my $pieces_ref = shift;
my $bishop_first_color;
my $rook_count = 0;
my $king_count = 0;
for my $i ( 0 .. $#{$pieces_ref} ) {
#my $mod = $i & 1;
#warn "info: validating piece: number=$i, mod=$mod, piece="
# . $pieces_ref->[$i] . "\n";
# TODO use dispatch table instead of elsif foo (then can add in new
# rules for other variants!)
if ( $pieces_ref->[$i] eq 'Bishop' ) {
# Bishops must reside on different colors
if ( !defined $bishop_first_color ) {
$bishop_first_color = $i & 1;
} else {
my $bishop_second_color = $i & 1;
#warn "info: bishop info: $bishop_first_color $bishop_second_color\n";
if ( $bishop_first_color == $bishop_second_color ) {
#warn "notice: validation failure: bishops on same color\n";
return 0;
}
}
} elsif ( $pieces_ref->[$i] eq 'Rook' ) {
# Must play King between Rooks
if ( $rook_count == 1 and $king_count != 1 ) {
#warn "notice: validation failure: king not between other rook\n";
return 0;
} else {
$rook_count++;
}
} elsif ( $pieces_ref->[$i] eq 'King' ) {
# Must play King between Rooks
if ( $rook_count != 1 ) {
#warn "notice: validation failure: king not between rooks\n";
return 0;
} else {
$king_count = 1;
}
}
}
return 1;
}
# fisher_yates_shuffle( \@array ) : generate a random permutation
# of @array in place
sub fisher_yates_shuffle {
my $array = shift;
my $i;
for ( $i = @$array; --$i; ) {
my $j = int rand( $i + 1 );
next if $i == $j;
@$array[ $i, $j ] = @$array[ $j, $i ];
}
}
__DATA__
Random Chess960 Opening
A random Chess960 opening position for White. Black must mirror these positions directly.