#!/usr/bin/perl
#
# epd.pl -- A CGI script for displaying epd-file based problem sets.
#
# Copyright (C) 2002  Mario Lang <mlang@delysid.org>
#
# This file is licensed under the terms of the GNU General Public License.
#

use CGI qw/:standard -no_xhtml/;

# Configurable options:
$title = 'Chess puzzles';

$epdpath = '/home/mlang/epd/';
$imgpath = '/chess/pieces';
%puzzles = ('bwtc'=>'1001 Billiant Ways to Checkmate (Reinfeld 1955, 1001 positions)',
	    'ece3','Encyclopedia of Chess Endgames (volume 3) (Adorjan 1986, 1797 positions)',
	    'ecm'=>'Encyclopedia of Chess Middlegames (Krogius, Taimanov ... 1980, 879 positions)',
	    'mes','Modern Endgame Studies (Sutherland, Lommer 1968, 1258 positions)',
	    'wac'=>'Win at Chess (Reinfeld 1958, 300 positions)',
	    'wcsac','1001 Winning Chess Sacrifices And Combinations (Reinfeld 1955, 1001 positions)');


$site_header = <<EOF;
<H1>Games</H1>
  <!-- Main Menu -->
<DIV id="MainMenu">
[<a href="index.html" onmouseover="self.status = 'Go to Index'; return true" onmouseout="self.status = ''; return true" onfocus="self.status = 'Go to Index'; return true" onblur="self.status = ''; return true">Home</a>]<strong><big>&middot;</big></strong>[<a href="programming.html" onmouseover="self.status = 'The art of debugging a blank sheet of paper (or, the art of debugging an empty file).'; return true" onmouseout="self.status = ''; return true" onfocus="self.status = 'The art of debugging a blank sheet of paper (or, the art of debugging an empty file).'; return true" onblur="self.status = ''; return true">Code</a>]<strong><big>&middot;</big></strong>[<a href="debian.html" onmouseover="self.status = 'The Free, Accessible and Universal Operating System'; return true" onmouseout="self.status = ''; return true" onfocus="self.status = 'The Free, Accessible and Universal Operating System'; return true" onblur="self.status = ''; return true">Debian</a>]<strong><big>&middot;</big></strong>&nbsp;Games&nbsp;<strong><big>&middot;</big></strong>[<a href="hardware/index.html" onmouseover="self.status = 'Hardware revies'; return true" onmouseout="self.status = ''; return true" onfocus="self.status = 'Hardware revies'; return true" onblur="self.status = ''; return true">Hardware</a>]<strong><big>&middot;</big></strong>[<a href="music/index.html" onmouseover="self.status = 'music/index.html'; return true" onmouseout="self.status = ''; return true" onfocus="self.status = 'music/index.html'; return true" onblur="self.status = ''; return true">Music</a>]<strong><big>&middot;</big></strong>[<a href="links.html" onmouseover="self.status = 'links.html'; return true" onmouseout="self.status = ''; return true" onfocus="self.status = 'links.html'; return true" onblur="self.status = ''; return true">Links</a>]<strong><big>&middot;</big></strong>[<a href="about.html" onmouseover="self.status = 'About the author of these webpages'; return true" onmouseout="self.status = ''; return true" onfocus="self.status = 'About the author of these webpages'; return true" onblur="self.status = ''; return true">About</a>]</DIV>
  <!-- End of Main Menu -->
<UL id="SubMenu">
<LI>Chess Puzzles</LI>
</UL>
  <DIV id="Content">
<H1>Chess Puzzles</H1>
EOF
$site_footer = <<EOF;
  </DIV>
  <DIV id="Copyright">
   Copyright &copy; 2003-2006
   <A href="mailto:webmaster@delysid.org">Mario Lang</A>
  </DIV>
  <DIV id="LastModified">
   Last Modified: 2006-11-27 00:19:00
  </DIV>
  <DIV id="SourceInfo">
   View the <A href="epd.pl">Source Code</A> of this page
  </DIV>
  <P id="Footer">
   This site is
   powered by Linux,
   <A href="http://validator.w3.org/check/referer">valid HTML 4.01</A> and
   <A href="http://jigsaw.w3.org/css-validator/check/referer">Valid CSS!</A>
  </P>
EOF

# FEN board regexps:
$rankre = '[1-8pnbrqk]{1,8}';
$fenboardre = join '/', ($rankre)x8;

if (!param('p')) {
  print header,
  start_html(-lang=>'en',-style=>'/standard.css',-title=>$title),
  $site_header,
  start_form,
  p,
  'Select a puzzle category: ',
  popup_menu('p',
	     ['bwtc','ece3','ecm','mes','wac','wcsac'],
	     'bwtc', \%puzzles),
  p,
  "Select display type: ",
  popup_menu('d',
	     ['ASCII','GIF'],
	     'ASCII'),
  p,
  submit('Start'),
  end_form,
  $site_footer,
  end_html;
  exit;
}

open(EPD,"<$epdpath".param('p').".epd") or do {
    print header,
    start_html(-lang=>'en',-title=>$title),
    $site_header,
    p("Error, Puzzle set not found."),
    hr,
    p("Please contact mlang\@delysid.org and include exactly what you did to produce this error."),
    $site_footer, end_html; exit; };

# Read the EPD file into an array of strings
my @epds;
while (<EPD>) { push @epds,$_; }
close(EPD);

if (!param('n') ||
    ((param('n') < 1) &&
     (param('n') > $#epds+1))) {
    $eltnum = int(rand($#epds))+1;
} else {
    $eltnum = param('n');
}

if (!param('d')) {
    param(-name=>'d',
	  -value=>"ASCII");
}

# Parse the string into a hash
my %entry = parseEPDstring($epds[$eltnum-1]);

# Parse the FEN string into a 2d array
my @brd = &parseFENboard($entry{'fen'});

print header,
    start_html(-lang=>'en',-style=>'/standard.css',-title=>$title." - ".uc(param('p'))." #".$eltnum),
    $site_header,
    h2($puzzles{param('p')}),
    p,
    start_form,
    'Select category: ',
    popup_menu('p',
	       ['bwtc','ece3','ecm','mes','wac','wcsac'],
	       param('p'), \%puzzles),
    p,
    "Display type: ",
    popup_menu('d',
	       ['ASCII','GIF'],
	       'ASCII'),
    p,
    "Puzzle number: ",
    textfield(-name=>'n',
	      -default=>$eltnum,
	      -override=>1,
	      -size=>5)," (leave empty for random selection)",
    p,
    "Best move: ",
    textfield(-name=>'s',
	      -size=>7)," (? for solution)",
    submit('Go!'),
    end_form,
    hr,
    p((($entry{'stm'} eq 'w')?"White":"Black")." to move");

if (param('d') eq 'GIF') {
    print p,"\n<table border=1 cellspacing=0>\n";
    for $rank (0..7) {
	print "<tr><td valign=center>",(8-$rank),"</td>\n";
	for $file (0..7) {
	    my $c = $brd[$rank][$file];
	    my $sqc = (($rank+$file) % 2);
	    print "<td>";
	    if (!defined($c)) {
		if ($sqc == 0) {
		    print "<img src='$imgpath/efw.gif' alt='-'>";
		} else {
		    print "<img src='$imgpath/efb.gif' alt='+'>";
		}
	    } else {
		if ($c =~ /[KQRBNP]/) {
		    print "<img src='$imgpath/w".lc($c);
		    if ($sqc == 0) {
			print "w";
		    } else {
			print "b";
		    }
		    print ".gif' alt='".$c."'>";
		} else {
		    print "<img src='$imgpath/b".$c;
		    if ($sqc == 0) {
			print "w";
		    } else {
			print "b";
		    }
		    print ".gif' alt='".$c."'>";
		}
	    }
	    print "</td>\n";
	}
	print "</tr>\n";
    }
    print "<tr><td></td><td align=center>A</td><td align=center>B</td><td align=center>C</td><td align=center>D</td><td align=center>E</td><td align=center>F</td><td align=center>G</td><td align=center>H</td></tr></table>\n",p;
} elsif (param('d') eq 'ASCII') {
    print p,"\n<pre>\n";
    for $rank (0..7) {
	for $file (0..7) {
	    my $c = $brd[$rank][$file];
	    if (!defined($c)) {
		if ((($rank+$file) % 2) == 0) {
		    print "-";
		} else {
		    print "+";
		}
	    } else {
		print $c;
	    }
	    print " ";
	}
	print "\n";
    }
    print "\n</pre>\n",p;
}

if (param('s') && lc($entry{'bm'}) eq (param('s'))) {
    print p("Congratulations, ".$entry{'bm'}." is the best move!");
} elsif (param('s') eq '?') {
    print p('The best move is: '.$entry{'bm'});
} elsif (param('s')) {
    print p("Sorry, ".param('s')." does not seem to be the best move here.");
}


print $site_footer,end_html;

# end of main program
#-----------------------------------------------------------------------------

# Subroutines:

sub parseEPDstring {
  my $str = shift;
  if (my ($board, $stm, $castle, $enp, $bm) = 
      $str =~ /^($fenboardre) ([bw]) ([kq-]+) ([1-8-]) bm ([^;]+);/i) {
    return ('fen'=>$board,
	    'stm'=>$stm,
	    'castle'=>$castle,
	    'enp'=>$enp,
	    bm=>$bm);
  }
}

sub parseFENboard {
  my $board = shift;
  my @b;
  my $rank = 0;
  my $file = 0;
 SWITCH: for (split //, $board) {
    /[kqrbnp]/i && do {$b[$rank][$file] = $_;$file++;};
    /\// && do {$rank++;$file=0;};
    /[1-8]/ && do {$file+=$_;};
  }
  return @b;
}