Chess-PGN-EPD

 view release on metacpan or  search on metacpan

lib/Chess/PGN/EPD.pm  view on Meta::CPAN

        $qc    = 0;
        for ( 0 .. 7 ) {
            $array[$_] =~ s/(\d+)/'_' x $1/ge;
            my @row = split( '', $array[$_] );
            my $rank = 'a';
            for my $piece (@row) {
                $board{"$rank$file"} = $piece if $piece ne '_';
                $rank++;
            }
            $file--;
        }
        $w = ( $array[8] eq 'w' );
        for ( split( '', $array[9] ) ) {
            if ( $_ eq 'K' ) {
                $Kc = 1;
            }
            elsif ( $_ eq 'Q' ) {
                $Qc = 1;
            }
            elsif ( $_ eq 'k' ) {
                $kc = 1;
            }
            elsif ( $_ eq 'q' ) {
                $qc = 1;
            }
        }
    }
    else {
        %board = qw(
            a1 R a2 P a7 p a8 r
            b1 N b2 P b7 p b8 n
            c1 B c2 P c7 p c8 b
            d1 Q d2 P d7 p d8 q
            e1 K e2 P e7 p e8 k
            f1 B f2 P f7 p f8 b
            g1 N g2 P g7 p g8 n
            h1 R h2 P h7 p h8 r
        );
        $w  = 1;
        $Kc = 1;
        $Qc = 1;
        $kc = 1;
        $qc = 1;
    }
    return;
}

sub epdstr {
    my %parameters = @_;
    if ( $parameters{'board'} ) {
        my %board;
        my $hashref = $parameters{'board'};

        for ( keys %$hashref ) {
            $board{$_} = $$hashref{$_};
        }
        $parameters{'epd'} = epd( 0, 0, 0, 0, 0, 0, %board );
    }
    my $epd  = $parameters{'epd'};
    my $type = lc( $parameters{'type'} );
    my ( $border, $corner, $legend ) = ( 'single', 'square', 'no' );

    $border = lc( $parameters{'border'} ) if exists( $parameters{'border'} );
    $corner = lc( $parameters{'corner'} ) if exists( $parameters{'corner'} );
    $legend = lc( $parameters{'legend'} ) if exists( $parameters{'legend'} );
    my @array = split( /\/|\s/, $epd );
    my @board;
    if ( $type eq 'diagram' ) {
        for ( 0 .. 7 ) {
            $array[$_] =~ s/(\d+)/'_' x $1/ge;
            $array[$_]
                =~ s/_/(((pos $array[$_]) % 2) xor ($_ % 2)) ? '-' : ' '/ge;
            push( @board, 8 - $_ . "  " . $array[$_] );
        }
        push( @board, '   abcdefgh' );
    }
    elsif ( $type eq 'text' ) {
        for ( 0 .. 7 ) {
            $array[$_] =~ s/(\d+)/'_' x $1/ge;
            $array[$_]
                =~ s/_/(((pos $array[$_]) % 2) xor ($_ % 2)) ? '-' : ' '/ge;
            push( @board, $array[$_] );
        }
    }
    elsif ( $type eq 'palview' ) {
        my @diagram;
        my $table;

        for ( 0 .. 7 ) {
            $array[$_] =~ s/(\d+)/'_' x $1/ge;
            $array[$_]
                =~ s/_/(((pos $array[$_]) % 2) xor ($_ % 2)) ? '-' : ' '/ge;
            push( @diagram, $array[$_] );
        }
        for (@diagram) {
            for ( split(//) ) {
                $table .= $convertPalView{$_};
            }
            $table .= "<BR>";
            push( @board, $table );
            $table = '';
        }
    }
    elsif ( $type eq 'latex' ) {
        push( @board, '\\begin{diagram}' );
        push( @board, '\\board' );
        for ( 0 .. 7 ) {
            $array[$_] =~ s/(\d+)/'_' x $1/ge;
            $array[$_]
                =~ s/_/(((pos $array[$_]) % 2) xor ($_ % 2)) ? '*' : ' '/ge;
            push( @board, '{' . $array[$_] . '}' );
        }
        push( @board, '\\end{diagram}' );
    }
    elsif ( $type eq 'tilburg' ) {
        for ( 0 .. 7 ) {
            $array[$_] =~ s/(\d+)/'_' x $1/ge;
            $array[$_]
                =~ s/([pnbrqkPNBRQK_])/_mappiece(pos $array[$_],$_,$1,"\341\345\351\355\361\365\337\343\347\353\357\363
\335","\340\344\350\354\360\364\336\342\346\352\356\362\334")/ge;
            push( @board, $array[$_] );
        }
    }
    else {
        @board = _configureboard( $type, $border, $corner, $legend );
        for ( 0 .. 7 ) {
            $array[$_] =~ s/(\d+)/'_' x $1/ge;
            $array[$_]
                =~ s/([pnbrqkPNBRQK_])/_mappiece(pos $array[$_],$_,$1,$FontMap{$type}{'OnBlack'},$FontMap{$type}
{'OnWhite'})/ge;
            substr( $board[ $_ + 1 ], 1, 8 ) = $array[$_];
        }
    }
    return @board;
}

sub _configureboard {
    my $type   = shift;
    my $border = shift;
    my $corner = shift;
    my $legend = shift;
    my $single = $border eq 'single';
    my $box    = $FontMap{$type}{ $single ? 'SingleBox' : 'DoubleBox' };
    my @board;

    if ( $corner eq 'rounded' ) {
        my $corners
            = $FontMap{$type}{ $single ? 'SingleRounded' : 'DoubleRounded' };

        substr( $box, 0, 1 ) = substr( $corners, 0, 1 );
        substr( $box, 2, 1 ) = substr( $corners, 1, 1 );
        substr( $box, 5, 1 ) = substr( $corners, 2, 1 );
        substr( $box, 7, 1 ) = substr( $corners, 3, 1 );
    }
    push( @board,
              substr( $box, 0, 1 )
            . substr( $box, 1, 1 ) x 8
            . substr( $box, 2, 1 ) );
    for ( 0 .. 7 ) {
        push( @board, substr( $box, 3, 1 ) . ' ' x 8 . substr( $box, 4, 1 ) );
    }
    push( @board,
              substr( $box, 5, 1 )
            . substr( $box, 6, 1 ) x 8
            . substr( $box, 7, 1 ) );
    if ( $legend eq 'yes' ) {
        my $left = $FontMap{$type}{
            $single
            ? 'SingleLeftLegend'
            : 'DoubleLeftLegend'
        };
        my $bottom = $FontMap{$type}{
            $single
            ? 'SingleBottomLegend'
            : 'DoubleBottomLegend'
        };

        for ( 1 .. 8 ) {
            substr( $board[$_], 0, 1 ) = substr( $left, $_ - 1, 1 );
        }
        substr( $board[-1], 1, 8 ) = $bottom;

    }
    return @board;
}

sub _mappiece {
    my $x         = shift;
    my $y         = shift;
    my $piece     = shift;
    my $ifonblack = shift;
    my $ifonwhite = shift;
    my $onwhite   = $onwhite[ ( $y * 8 ) + $x ];
    my $which     = index( 'pnbrqkPNBRQK_', $piece );

    return substr( $onwhite ? $ifonwhite : $ifonblack, $which, 1 );
}

sub epdgetboard {
    if ( my $epd = shift ) {
        epdset($epd);
    }
    return $w, $Kc, $Qc, $kc, $qc, %board;
}

sub epdfromto {
    my @moves = @_;
    my @movelist;

    epdset();
    for (@moves) {
        if ($_) {
            my ( $piece, $to, $from, $promotion ) = _movetype( $w, $_ );
            my $enpassant;
            my $ep = '-';
            my $castles = /O/ ? $_ : '';

            $Kc = 0 if $to eq 'h1';
            $Qc = 0 if $to eq 'a1';
            $kc = 0 if $to eq 'h8';
            $qc = 0 if $to eq 'a8';

            if ( $piece eq "P" ) {
                $piece = "p" if not $w;
                $promotion = lc($promotion) if $promotion and not $w;
                if ($from) {

lib/Chess/PGN/EPD.pm  view on Meta::CPAN


An en passant target square is given if and only if the last move was a pawn
advance of two squares.  Therefore, an en passant target square field may have
a square name even if there is no pawn of the opposing side that may
immediately execute the en passant capture.

=item Halfmove clock

The fifth field is a nonnegative integer representing the halfmove clock.  This
number is the count of halfmoves (or ply) since the last pawn advance or
capturing move.  This value is used for the fifty move draw rule.

=item Fullmove number

The sixth and last field is a positive integer that gives the fullmove number.
This will have the value "1" for the first move of a game for both White and
Black.  It is incremented by one immediately after each move by Black.

=back

B<Examples>

Here's the FEN for the starting position:

rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1

And after the move 1. e4:

rnbqkbnr/pppppppp/8/8/4P3/8/PPPP1PPP/RNBQKBNR b KQkq e3 0 1

And then after 1. ... c5:

rnbqkbnr/pp1ppppp/8/2p5/4P3/8/PPPP1PPP/RNBQKBNR w KQkq c6 0 2

And then after 2. Nf3:

rnbqkbnr/pp1ppppp/8/2p5/4P3/5N2/PPPP1PPP/RNBQKB1R b KQkq - 1 2

For two kings on their home squares and a white pawn on e2 (White to move) with
thirty eight full moves played with five halfmoves since the last pawn move or
capture:

4k3/8/8/8/8/8/4P3/4K3 w - - 5 39

=head3 NOTE

With only a little observation, the astute user will notice that actually this function
doesn't return either EPD or FEN, but rather a bit of both. It is mostly FEN, but it lacks
the Fullmove number field, since for most usage that information is available else where
or can easily be reconstructed. As to why the module is called EPD, well I figured since it
wasn't one and it wasn't the other, that left it up to me to choose--besides, who would want
a module named after a swamp?!

=head2 epdset(I<epd>)

For those instances where the game in question does not begin
with a complete move list, this function allows the user to
set the starting position using a 'EPD' string as described
elsewhere in the document.

=head2 epdstr(I<epd>|I<board>,I<type> [I<border>,I<corner>,I<legend>])

Returns an array of strings that represent a diagramatic conversion of the
specified B<epd> string or board postion to the specified B<type>. Parameters are passed as
a anonymous hash, i.e. epdstr(epd => $position,type => 'diagram') or similar.

=head3 Types Supported

The following types are understood by B<epdstr>:

=over

=item 'diagram'

A plain ASCII diagram with simple border showing rank and file. Typical output:

 8  rnbqkb r
 7  ppp pppp
 6   - - n -
 5  - -P- -
 4   - - - -
 3  - - - -
 2  PPPP PPP
 1  RNBQKBNR
    abcdefgh

=item 'text'

A plain ASCII diagram. Typical output:

 rnbqkb r
 ppp pppp
  - - n -
 - -P- -
  - - - -
 - - - -
 PPPP PPP
 RNBQKBNR

=item 'palview'

An array of HTML information that represents the tabular diagram information for PalView.
Typical output:

<IMG SRC="jpc/br.gif"><IMG SRC="jpc/bn.gif"><IMG SRC="jpc/bb.gif"><IMG SRC="jpc/bq.gif"><IMG
SRC="jpc/bk.gif"><IMG SRC="jpc/bb.gif"><IMG SRC="jpc/bn.gif"><IMG SRC="jpc/br.gif"><BR>
<IMG SRC="jpc/bp.gif"><IMG SRC="jpc/bp.gif"><IMG SRC="jpc/bp.gif"><IMG SRC="jpc/bp.gif"><IMG
SRC="jpc/bp.gif"><IMG SRC="jpc/bp.gif"><IMG SRC="jpc/bp.gif"><IMG SRC="jpc/bp.gif"><BR>
<IMG SRC="jpc/i.gif"><IMG SRC="jpc/i.gif"><IMG SRC="jpc/i.gif"><IMG SRC="jpc/i.gif"><IMG
SRC="jpc/i.gif"><IMG SRC="jpc/i.gif"><IMG SRC="jpc/i.gif"><IMG SRC="jpc/i.gif"><BR>
<IMG SRC="jpc/i.gif"><IMG SRC="jpc/i.gif"><IMG SRC="jpc/i.gif"><IMG SRC="jpc/i.gif"><IMG
SRC="jpc/i.gif"><IMG SRC="jpc/i.gif"><IMG SRC="jpc/i.gif"><IMG SRC="jpc/i.gif"><BR>
<IMG SRC="jpc/i.gif"><IMG SRC="jpc/i.gif"><IMG SRC="jpc/i.gif"><IMG SRC="jpc/i.gif"><IMG
SRC="jpc/i.gif"><IMG SRC="jpc/i.gif"><IMG SRC="jpc/i.gif"><IMG SRC="jpc/i.gif"><BR>
<IMG SRC="jpc/i.gif"><IMG SRC="jpc/i.gif"><IMG SRC="jpc/i.gif"><IMG SRC="jpc/i.gif"><IMG
SRC="jpc/i.gif"><IMG SRC="jpc/i.gif"><IMG SRC="jpc/i.gif"><IMG SRC="jpc/wn.gif"><BR>
<IMG SRC="jpc/wp.gif"><IMG SRC="jpc/wp.gif"><IMG SRC="jpc/wp.gif"><IMG SRC="jpc/wp.gif"><IMG
SRC="jpc/wp.gif"><IMG SRC="jpc/wp.gif"><IMG SRC="jpc/wp.gif"><IMG SRC="jpc/wp.gif"><BR>
<IMG SRC="jpc/wr.gif"><IMG SRC="jpc/wn.gif"><IMG SRC="jpc/wb.gif"><IMG SRC="jpc/wq.gif"><IMG
SRC="jpc/wk.gif"><IMG SRC="jpc/wb.gif"><IMG SRC="jpc/i.gif"><IMG SRC="jpc/wr.gif"><BR>

=item 'latex'

The necessary text fragment to 'set' the diagram in LaTeX using
any variation of Piet Tutelars original chess12.tar.Z package. As given, the LaTeX
command 'diagram' is used. As an example here is the source to test.tex:

 %%
 %% test.tex -- example LaTeX file to demonstrate output from Chess::PGN::EPD
 %%
 \documentclass{article}
 \usepackage{chess}
 \usepackage{bdfchess}
 \begin{document}
 \newenvironment{diagram}{\begin{nochess}}{$$\showboardwithnotation$$\end{nochess}}
 %%
 %% fragment as produced by epdstr(epd => $position,type => 'latex');
 %%
 \begin{diagram}
 \board
 {rnbqkb r}
 {ppp pppp}
 { * * n *}
 {* *P* * }
 { * * * *}
 {* * * * }
 {PPPP PPP}
 {RNBQKBNR}
 \end{diagram}
 %%
 %% end of fragment
 %%
 \end{document}

=item 'linares'

Alpine Electronics' LinaresDiagram font. Mapping also works with both HastingsDiagram
and ZurichDiagram fonts. Single or double border, With or without algebraic legend.

=item 'linares1'

Standard mapping, single border, squares offset.

=item 'linares2'

Standard mapping, thick single border.

=item 'tilburg'

A borderless font designed by Eric Schiller and Bill Cone.

=item 'marroquin'

This type refers to any font designed by Armando H. Marroquin,
excepting his FigurineSymbol fonts. They having a different purpose,
have a different mapping.

=item 'leschemelle'

The map for Chess Cases designed by Matthieu Leschemelle.

=item 'bentzen1'

The map for Chess Alpha designed by Eric Bentzen.

=item 'bentzen2'

The map for Chess Berlin designed by Eric Bentzen.

=item 'hickey'

The map for Chess Plain designed by Alan Hickey.

=item 'scott1'

The map for Chess Regular a port of Adobe Cheq ported to
True Type by Alistair Scott.

=item 'scott2'

The map for Chess Usual a modification of Chess Regular
by Armando H. Marroquin.

=item 'bodlaender'

The map for Chess Utrecht designed by Hans Bodlaender.

=item 'cowderoy'

The map for Traveller Standard v3  designed by Alan Cowderoy.

=back

Note that 'type' is not case sensative so that 'latex' and 'LaTeX' will both
work equally well.

=head3 Fonts Supported

lib/Chess/PGN/EPD.pm  view on Meta::CPAN


=item Chess Mediaeval -- Armando H. Marroquin -- marroquin

=item Chess Merida -- Armando H. Marroquin -- marroquin

=item Chess Millennia -- Armando H. Marroquin -- marroquin

=item Chess Miscel -- Armando H. Marroquin -- marroquin

=item Chess Montreal -- Gary Katch -- katch

=item Chess Motif -- Armando H. Marroquin -- marroquin

=item Chess Plain -- Alan Hickey -- hickey

=item Chess Regular -- Alistair Scott -- scott1

=item Chess Usual -- Armando H. Marroquin -- scott2

=item Chess Utrecht -- Hans Bodlaender -- bodlaender

=item Tilburg -- Eric Schiller and Bill Cone -- tilburg

=item Traveller Standard v3 -- Alan Cowderoy -- cowderoy

=back

These are available at L<http://www.enpassant.dk/chess/fonteng.htm> along
with a good deal of useful information on chess desktop publishing.

=head3 Font Designers Supported

=over

=item Eric Bentzen

=item Bill Cone

=item Alan Cowderoy

=item Alan Hickey

=item Gary Katch

=item Armondo H. Marroquin

=item Eric Schiller

=item Alastair Scott

=item Steve Smith

=item Piet Tutelaers

=back

=head3 Borders and Such Like

Some fonts, for example those designed by Armondo H. Marroquin support a variety of border
styles and decorations. The border may be single or double, with square corners or rounded,
and with an algebraic legend. These effects are supported by the addition of the necessary
parameters to the allowed parameter list. In particular:

=over

=item * Border, values can be either 'single' or 'double' (default is 'single')

=item * Corner, values can be either 'square' or 'rounded' (default is 'square')

=item * Legend, values can be either 'yes' or 'no' (default is 'no')

=back

Again, letter case is not particularly important, 'yes' works as well as 'Yes' etc.
As for those fonts that don't support a particular feature, B<epdstr> will fail silently, that
is, the parameter will be ignored and processing will continue as though no such request
had been made.

=head2 epdTaxonomy(I<options>)

At one point the following was required in order to properly 'tag' a PGN file with opening
names and information:

 if ($ARGV[0]) {
     my $pgn = new Chess::PGN::Parse($ARGV[0]) or die "Can't open $ARGV[0]: $!\n";
     while ($pgn->read_game()) {
         my @epd;

         $pgn->parse_game();
         @epd = reverse epdlist( @{$pgn->moves()} );
         print '[ECO,"',epdcode('ECO',\@epd),"\"]\n";
         print '[NIC,"',epdcode('NIC',\@epd),"\"]\n";
         print '[Opening,"',epdcode('Opening',\@epd),"\"]\n";
     }
 }

Not all that bad, but not all that clear either. As can be seen from the examples shown at the
begining of this documentation, I've created a new subroutine called epdTaxonomy that replaces
all of the above with:

 if ($ARGV[0]) {
     my $pgn = new Chess::PGN::Parse($ARGV[0]) or die "Can't open $ARGV[0]: $!\n";
     while ($pgn->read_game()) {
         my @epd;

         $pgn->parse_game();
         my @moves = @{ $game{'GameMoves'} };
         print join("\n",epdTaxonomy(moves => \@moves,all => 1,astags => 1)),"\n";
     }
 }

Clearly a win for the parsimonious team! This sub takes a single parameter, a hash with the following
possibilities:

=over

=item 'moves' -- required in order to have something to work with.

=item 'all' -- if true, create all three tags supported.

=item 'astags' -- if true, create complete PGN header tags for the specified codes.



( run in 0.809 second using v1.01-cache-2.11-cpan-524268b4103 )