X-Git-Url: https://git.sesse.net/?p=remoteglot;a=blobdiff_plain;f=ECO.pm;fp=ECO.pm;h=c1a38331811cf1076459f6665b53ff6d34ca46f0;hp=0000000000000000000000000000000000000000;hb=7dfa8135cabec7261a2a255e7b5edd679e75da0b;hpb=7ac37d77ecacc4f33d8bc76d80e3fb6c7632fb92

diff --git a/ECO.pm b/ECO.pm
new file mode 100755
index 0000000..c1a3833
--- /dev/null
+++ b/ECO.pm
@@ -0,0 +1,82 @@
+#! /usr/bin/perl
+#
+# Get eco.pgn from ftp://ftp.cs.kent.ac.uk/pub/djb/pgn-extract/eco.pgn,
+# or any other opening database you might want to use as a base.
+#
+use strict;
+use warnings;
+use Chess::PGN::Parse;
+
+require 'Position.pm';
+
+package ECO;
+
+our %fen_to_opening = ();
+our @openings = ();
+
+sub init {
+	{
+		my $pos = Position->start_pos("white", "black");
+		my $key = _key_for_pos($pos);
+		push @openings, { eco => 'A00', name => 'Start position' };
+		$fen_to_opening{$key} = $#openings;
+	}
+
+	my $pgn = Chess::PGN::Parse->new("eco.pgn")
+		or die "can't open eco.pgn\n";
+	while ($pgn->read_game()) {
+		my $tags = $pgn->tags();
+		$pgn->quick_parse_game;
+		my $pos = Position->start_pos("white", "black");
+		my $moves = $pgn->moves // [];
+		my $eco = $pgn->eco;
+		next if (!defined($eco));
+		my $name = $tags->{'Opening'};
+		if (exists($tags->{'Variation'}) && $tags->{'Variation'} ne '') {
+			$name .= ": " . $tags->{'Variation'};
+		}
+		for (my $i = 0; $i < scalar @$moves; ++$i) {
+			my ($from_row, $from_col, $to_row, $to_col, $promo) = $pos->parse_pretty_move($moves->[$i]);
+			$pos = $pos->make_move($from_row, $from_col, $to_row, $to_col, $promo, $moves->[$i]);
+		}
+		my $key = _key_for_pos($pos);
+		push @openings, { eco => $pgn->eco(), name => $name };
+		$fen_to_opening{$key} = $#openings;
+	}
+}
+
+sub persist {
+	my $filename = shift;
+	open my $fh, ">", $filename
+		or die "openings.txt: $!";
+	for my $opening (@openings) {
+		print $fh $opening->{'eco'}, " ", $opening->{'name'}, "\n";
+	}
+	close $fh;
+}
+
+sub unpersist {
+	my $filename = shift;
+	open my $fh, "<", $filename
+		or die "openings.txt: $!";
+	while (<$fh>) {
+		chomp;
+		push @openings, $_;
+	}
+	close $fh;
+}
+
+sub get_opening_num {  # May return undef.
+	my $pos = shift;
+	return $fen_to_opening{_key_for_pos($pos)};
+}
+
+sub _key_for_pos {
+	my $pos = shift;
+	my $key = $pos->fen;
+	# Remove the move clocks.
+	$key =~ s/ \d+ \d+$//;
+	return $key;
+}
+
+1;