git.sesse.net Git - remoteglot/blob - ECO.pm

   1 #! /usr/bin/perl
   2 #
   3 # Get eco.pgn from ftp://ftp.cs.kent.ac.uk/pub/djb/pgn-extract/eco.pgn,
   4 # or any other opening database you might want to use as a base.
   5 #
   6 use strict;
   7 use warnings;
   8 use Chess::PGN::Parse;
   9
  10 require 'Position.pm';
  11
  12 package ECO;
  13
  14 our %fen_to_opening = ();
  15 our @openings = ();
  16
  17 sub init {
  18         {
  19                 my $pos = Position->start_pos("white", "black");
  20                 my $key = _key_for_pos($pos);
  21                 push @openings, { eco => 'A00', name => 'Start position' };
  22                 $fen_to_opening{$key} = $#openings;
  23         }
  24
  25         my $pgn = Chess::PGN::Parse->new("eco.pgn")
  26                 or die "can't open eco.pgn\n";
  27         while ($pgn->read_game()) {
  28                 my $tags = $pgn->tags();
  29                 $pgn->quick_parse_game;
  30                 my $pos = Position->start_pos("white", "black");
  31                 my $moves = $pgn->moves // [];
  32                 my $eco = $pgn->eco;
  33                 next if (!defined($eco));
  34                 my $name = $tags->{'Opening'};
  35                 if (exists($tags->{'Variation'}) && $tags->{'Variation'} ne '') {
  36                         $name .= ": " . $tags->{'Variation'};
  37                 }
  38                 for (my $i = 0; $i < scalar @$moves; ++$i) {
  39                         my ($from_row, $from_col, $to_row, $to_col, $promo) = $pos->parse_pretty_move($moves->[$i]);
  40                         $pos = $pos->make_move($from_row, $from_col, $to_row, $to_col, $promo, $moves->[$i]);
  41                 }
  42                 my $key = _key_for_pos($pos);
  43                 push @openings, { eco => $pgn->eco(), name => $name };
  44                 $fen_to_opening{$key} = $#openings;
  45         }
  46 }
  47
  48 sub persist {
  49         my $filename = shift;
  50         open my $fh, ">", $filename
  51                 or die "openings.txt: $!";
  52         for my $opening (@openings) {
  53                 print $fh $opening->{'eco'}, " ", $opening->{'name'}, "\n";
  54         }
  55         close $fh;
  56 }
  57
  58 sub unpersist {
  59         my $filename = shift;
  60         open my $fh, "<", $filename
  61                 or die "openings.txt: $!";
  62         while (<$fh>) {
  63                 chomp;
  64                 push @openings, $_;
  65         }
  66         close $fh;
  67 }
  68
  69 sub get_opening_num {  # May return undef.
  70         my $pos = shift;
  71         return $fen_to_opening{_key_for_pos($pos)};
  72 }
  73
  74 sub _key_for_pos {
  75         my $pos = shift;
  76         my $key = $pos->fen;
  77         # Remove the move clocks.
  78         $key =~ s/ \d+ \d+$//;
  79         return $key;
  80 }
  81
  82 1;