Roy
/
chess-gui
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Ondersteuning voor verschillende sessies op hetzelfde moment.

Browse Source
main
Roy 2 years ago
parent b24a94352b
commit 7c7ac1069b
3 changed files with 108 additions and 84 deletions
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Show Stats Download Patch File Download Diff File
  1. 165
      chess_gui/lib/chess_gui.pm
  2. 9
      chess_gui/public/js/dand.js
  3. 16
      chess_gui/public/js/head.js

165
chess_gui/lib/chess_gui.pm
Unescape View File

@ -1,12 +1,9 @@
#!/usr/bin/env perl #!/usr/bin/env perl
package chess_gui; package chess_gui;
use Dancer2; use Dancer2;
#use Dancer2::Plugin::Ajax;
#use Dancer2::Session::Memcached;
use Template; use Template;
use DBI; use DBI;
use DBD::Pg; use DBD::Pg;
#use HTTP::Cookies;
use strict; use strict;
use warnings; use warnings;
#use warnings FATAL => qw(uninitialized); #use warnings FATAL => qw(uninitialized);
@ -38,6 +35,7 @@ our $VERSION = '37.0';
my $dbname = 'chessd'; # See ./chess.sql. my $dbname = 'chessd'; # See ./chess.sql.
my $username = 'postgres'; my $username = 'postgres';
my $dbh = DBI->connect("dbi:Pg:dbname=$dbname", $username, '', {PrintError => 1, RaiseError => 1, AutoCommit => 1}) or die $?; my $dbh = DBI->connect("dbi:Pg:dbname=$dbname", $username, '', {PrintError => 1, RaiseError => 1, AutoCommit => 1}) or die $?;
my @split_piece_column_names = qw/b 0 b 1 k 0 n 0 n 1 p 0 p 1 p 2 p 3 p 4 p 5 p 6 p 7 q 0 r 0 r 1/;
#my $dbh = DBI->connect("dbi:Pg:dbname=$dbname", $username, '', {PrintError => 0, RaiseError => 0, AutoCommit => 1}) or die $?; #my $dbh = DBI->connect("dbi:Pg:dbname=$dbname", $username, '', {PrintError => 0, RaiseError => 0, AutoCommit => 1}) or die $?;
#my $sth1 = $dbh->prepare(q/SELECT black.id, white.id, black.prio, white.prio FROM black, white WHERE black.id = white.id and white.b0 = ? and white.b1 = ? and white.k0 = ? and white.n0 = ? and white.n1 = ? and white.p0 = ? and white.p1 = ? and white.p2 = ? and white.p3 = ? and white.p4 = ? and white.p5 = ? and white.p6 = ? and white.p7 = ? and white.q0 = ? and white.r0 = ? and white.r1 = ? and black.b0 = ? and black.b1 = ? and black.k0 = ? and black.n0 = ? and black.n1 = ? and black.p0 = ? and black.p1 = ? and black.p2 = ? and black.p3 = ? and black.p4 = ? and black.p5 = ? and black.p6 = ? and black.p7 = ? and black.q0 = ? and black.r0 = ? and black.r1 = ?/); #TODO: There should be a better way to do this... #my $sth1 = $dbh->prepare(q/SELECT black.id, white.id, black.prio, white.prio FROM black, white WHERE black.id = white.id and white.b0 = ? and white.b1 = ? and white.k0 = ? and white.n0 = ? and white.n1 = ? and white.p0 = ? and white.p1 = ? and white.p2 = ? and white.p3 = ? and white.p4 = ? and white.p5 = ? and white.p6 = ? and white.p7 = ? and white.q0 = ? and white.r0 = ? and white.r1 = ? and black.b0 = ? and black.b1 = ? and black.k0 = ? and black.n0 = ? and black.n1 = ? and black.p0 = ? and black.p1 = ? and black.p2 = ? and black.p3 = ? and black.p4 = ? and black.p5 = ? and black.p6 = ? and black.p7 = ? and black.q0 = ? and black.r0 = ? and black.r1 = ?/); #TODO: There should be a better way to do this...
#my $sth0 = $dbh->prepare(q/SELECT bw_id, prio FROM white, context WHERE white.b0 = ? and white.b1 = ? and white.k0 = ? and white.n0 = ? and white.n1 = ? and white.p0 = ? and white.p1 = ? and white.p2 = ? and white.p3 = ? and white.p4 = ? and white.p5 = ? and white.p6 = ? and white.p7 = ? and white.q0 = ? and white.r0 = ? and white.r1 = ? and white.b0 = ? and context.b1 = ? and context.k0 = ? and context.n0 = ? and context.n1 = ? and context.p0 = ? and context.p1 = ? and context.p2 = ? and context.p3 = ? and context.p4 = ? and context.p5 = ? and context.p6 = ? and context.p7 = ? and context.q0 = ? and context.r0 = ? and context.r1 = ?/); #my $sth0 = $dbh->prepare(q/SELECT bw_id, prio FROM white, context WHERE white.b0 = ? and white.b1 = ? and white.k0 = ? and white.n0 = ? and white.n1 = ? and white.p0 = ? and white.p1 = ? and white.p2 = ? and white.p3 = ? and white.p4 = ? and white.p5 = ? and white.p6 = ? and white.p7 = ? and white.q0 = ? and white.r0 = ? and white.r1 = ? and white.b0 = ? and context.b1 = ? and context.k0 = ? and context.n0 = ? and context.n1 = ? and context.p0 = ? and context.p1 = ? and context.p2 = ? and context.p3 = ? and context.p4 = ? and context.p5 = ? and context.p6 = ? and context.p7 = ? and context.q0 = ? and context.r0 = ? and context.r1 = ?/);
@ -60,7 +58,7 @@ my $sth8 = $dbh->prepare(q/SELECT b0, b1, k0, n0, n1, p0, p1, p2, p3, p4, p5, p6
my $sth9 = $dbh->prepare(q/SELECT b0, b1, k0, n0, n1, p0, p1, p2, p3, p4, p5, p6, p7, q0, r0, r1 FROM black WHERE id = ?/); my $sth9 = $dbh->prepare(q/SELECT b0, b1, k0, n0, n1, p0, p1, p2, p3, p4, p5, p6, p7, q0, r0, r1 FROM black WHERE id = ?/);
my $sth10 = $dbh->prepare(q/INSERT INTO sessions (session, bid, wid) VALUES ($1, $2, $3) ON CONFLICT ON CONSTRAINT sessions_pkey DO UPDATE SET (bid, wid) = ($2, $3)/); my $sth10 = $dbh->prepare(q/INSERT INTO sessions (session, bid, wid) VALUES ($1, $2, $3) ON CONFLICT ON CONSTRAINT sessions_pkey DO UPDATE SET (bid, wid) = ($2, $3)/);
my $sth11 = $dbh->prepare(q/SELECT bid, wid FROM sessions WHERE session = ?/); my $sth11 = $dbh->prepare(q/SELECT bid, wid FROM sessions WHERE session = ?/);
my (@tree, @what_i_did, %prop, @keys, @pplayer, %tmpalg, %tmpalg2, %tmpalg3, %tmpalg4, $players, @not_player, $smaleer, %pval); my (@tree, %what_i_did, %prop, %default_prop, @keys, @default_keys, @pplayer, %tmpalg, %tmpalg2, %tmpalg3, %tmpalg4, $players, @not_player, $smaleer, %pval);
@not_player[0, 1] = (1, 0); @not_player[0, 1] = (1, 0);
my @px = ('A'..'H'); my @px = ('A'..'H');
my %pxr; my %pxr;
@ -69,11 +67,15 @@ my %ppiece;
@ppiece{qw/b k n p q r/} = qw/bishop king knight pawn queen rook/; @ppiece{qw/b k n p q r/} = qw/bishop king knight pawn queen rook/;
my @player = reverse @not_player; my @player = reverse @not_player;
@pplayer[0, 1] = qw/White Black/; @pplayer[0, 1] = qw/White Black/;
my @pseudoinfinite_loop_check; #my @pseudoinfinite_loop_check;
my $user_mode; my %pseudoinfinite_loop_check;
#my $user_mode;
my %user_mode;
my $player; my $player;
my $player_turn = 0; #my $player_turn = 0;
my $counter; my %player_turn;
#my $counter;
my %counter;
my $action_limit = 100; my $action_limit = 100;
my $loop_limit = 6; my $loop_limit = 6;
my @direction = qw/1 1 1 -1 -1 -1 -1 1 0 1 0 -1 1 0 -1 0 0.5 2 0.5 -2 -0.5 -2 -0.5 2/; # Diagonal direction modifiers: $direction[0..7]. Straight direction modifiers: $direction[8..15]. Knight direction modifiers: $direction[0..7,16..23]. my @direction = qw/1 1 1 -1 -1 -1 -1 1 0 1 0 -1 1 0 -1 0 0.5 2 0.5 -2 -0.5 -2 -0.5 2/; # Diagonal direction modifiers: $direction[0..7]. Straight direction modifiers: $direction[8..15]. Knight direction modifiers: $direction[0..7,16..23].
@ -100,7 +102,6 @@ $SIG{'INT'} = 'INTERRUPT';
sub PRETTY_CALC { # Calculate total piece value (for post-game). It used to print the chess board. sub PRETTY_CALC { # Calculate total piece value (for post-game). It used to print the chess board.
my ($pval, $player) = @_; my ($pval, $player) = @_;
foreach my $secondc (0..7) { foreach my $secondc (0..7) {
# print "\n";
foreach my $firstc (0..7) { foreach my $firstc (0..7) {
my $coordinate = $firstc.'.'.(7-$secondc); my $coordinate = $firstc.'.'.(7-$secondc);
if (defined($prop{$coordinate})) { if (defined($prop{$coordinate})) {
@ -110,30 +111,26 @@ sub PRETTY_CALC { # Calculate total piece value (for post-game). It used to prin
} else { } else {
$pval -= $pval{$p}; $pval -= $pval{$p};
} }
# printf '%-8s', $p;
} else { } else {
# printf '%-8s', $coordinate;
} }
} }
# print "\n";
} }
return ($pval, $player); return ($pval, $player);
} }
sub INIT_BOARD { sub INIT_BOARD {
my (%h0, %h1); #my (%h0, %h1);
if ($#_ != -1) { #if ($#_ != -1) {
#print $_[0]{'b0'}, "\n"; # map {if (defined($_[0]{$_})) {$h0{$_[0]{$_}} = join '', (0, $_)}} keys %{$_[0]};
map {if (defined($_[0]{$_})) {$h0{$_[0]{$_}} = join '', (0, $_)}} keys %{$_[0]}; # map {if (defined($_[1]{$_})) {$h1{$_[1]{$_}} = join '', (1, $_)}} keys %{$_[1]};
map {if (defined($_[1]{$_})) {$h1{$_[1]{$_}} = join '', (1, $_)}} keys %{$_[1]}; #}
}
foreach (0..63) { # Initialize chess positions piece worth (%p${player}val). foreach (0..63) { # Initialize chess positions piece worth (%p${player}val).
my ($x, $y, $player); my ($x, $y, $player);
# $_ = sprintf("%.1o",$_/10); # (This) sprintf doesn't support octal floats. # $_ = sprintf("%.1o",$_/10); # (This) sprintf doesn't support octal floats.
$_ = sprintf("%.1f", sprintf("%o", $_)/10); $_ = sprintf("%.1f", sprintf("%o", $_)/10);
$x = int($_); $x = int($_);
$y = $_ * 10 % 10; # 0.x % 1 = 0 $y = $_ * 10 % 10; # 0.x % 1 = 0
if ($#_ == -1) { # if ($#_ == -1) {
if ($y < 2) { # White, hereafter called player 0. if ($y < 2) { # White, hereafter called player 0.
$player = 0; $player = 0;
} elsif ($y > 5) { # Black, hereafter called player 1. } elsif ($y > 5) { # Black, hereafter called player 1.
@ -176,9 +173,9 @@ if ($#_ != -1) {
# $default_iboard[$y][$x]{'pco'} = join '', $px[$x], ($y+1); # $default_iboard[$y][$x]{'pco'} = join '', $px[$x], ($y+1);
$default_iboard{'pco'}[7-$x+8*$y] = join '', $px[7-$x], ($y+1); $default_iboard{'pco'}[7-$x+8*$y] = join '', $px[7-$x], ($y+1);
} else { # Restore a previous state (from a session). # } else { # Restore a previous state (from a session).
$session_iboard[$y][$x] = $h1{$_} // $h0{$_} // $_; # $session_iboard[$y][$x] = $h1{$_} // $h0{$_} // $_;
} # }
} }
$players = 1; # Could do something with this if it weren't for @not_player... $players = 1; # Could do something with this if it weren't for @not_player...
} }
@ -189,7 +186,7 @@ sub INIT_KEYS { # For sorted lookup of piece source.
sub MOVEMENT_TREE { # Assume relative movement to support abritrary depth (0 < $depth < Inf). sub MOVEMENT_TREE { # Assume relative movement to support abritrary depth (0 < $depth < Inf).
my ($player, $depth, $i_al, $i) = (@_[0, 1], $_[5] // $_[0]*16-1, $_[2] // -4); # Support for travelling to different tree depths every player turn (could be used to create, e.g., adaptive AI). my ($player, $depth, $i_al, $i) = (@_[0, 1], $_[5] // $_[0]*16-1, $_[2] // -4); # Support for travelling to different tree depths every player turn (could be used to create, e.g., adaptive AI).
my ($ice, $prio, %key_list_by_value, @selection); my ($ice, $rio, %key_list_by_value, @selection);
$i += 4; $i += 4;
ALLY_SOURCE: foreach my $asrc (&KEYS($player)) { ALLY_SOURCE: foreach my $asrc (&KEYS($player)) {
my $dpval = $_[3] // 0; # Default piece value. my $dpval = $_[3] // 0; # Default piece value.
@ -203,19 +200,19 @@ sub MOVEMENT_TREE { # Assume relative movement to support abritrary depth (0 < $
if ($#ditet != -1 and defined($ditet[2/($player+1)+1])) { if ($#ditet != -1 and defined($ditet[2/($player+1)+1])) {
my $tmpkey = join ',', @keys; my $tmpkey = join ',', @keys;
{no warnings; $tmpalg{$tmpkey} = $ditet[2/($player+1)+1]}; {no warnings; $tmpalg{$tmpkey} = $ditet[2/($player+1)+1]};
# if ($player == $user_mode) {if (defined($prop{$asrc}) and (join '', @{$prop{$asrc}}) eq $_[7] and ($_[8] eq $tree[$i]{$asrc}[$c] or (defined($prop{$tree[$i]{$asrc}[$c]}) and $_[8] eq (join '', @{$prop{$tree[$i]{$asrc}[$c]}})))) {$tmpalg{$tmpkey} = 'Inf'; $sth10->execute($_[9], $ditet[0], $ditet[1])}} #else { # if ($player == $user_mode) {if (defined($prop{$asrc}) and (join '', @{$prop{$asrc}}) eq $_[7] and ($_[8] eq $tree[$i]{$asrc}[$c] or (defined($prop{$tree[$i]{$asrc}[$c]}) and $_[8] eq (join '', @{$prop{$tree[$i]{$asrc}[$c]}})))) {$tmpalg{$tmpkey} = 'Inf'; $sth10->execute($_[9], $ditet[0], $ditet[1])}} #else {}
if ($player == $user_mode) {if ($asrc eq $_[7] and $_[8] eq $tree[$i]{$asrc}[$c]) {$tmpalg{$tmpkey} = 'Inf'; $sth10->execute($_[9], $ditet[0], $ditet[1])}} if ($player == $user_mode{$_[9]}) {if ($asrc eq $_[7] and $_[8] eq $tree[$i]{$asrc}[$c]) {$tmpalg{$tmpkey} = 'Inf'; $sth10->execute($_[9], $ditet[0], $ditet[1])}}
my $val = $tmpalg{$tmpkey}; my $val = $tmpalg{$tmpkey};
push @{$key_list_by_value{$val}}, ($tmpkey, @ditet[0, 1]); push @{$key_list_by_value{$val}}, ($tmpkey, @ditet[0, 1]);
unless (defined($prio)) { unless (defined($rio)) {
$prio = $val; $rio = $val;
# @xid[0, 1] = @ditet[0, 1]; # @xid[0, 1] = @ditet[0, 1];
} }
if ($val > $prio) { if ($val > $rio) {
$prio = $val; $rio = $val;
# @xid[0, 1] = @ditet[0, 1]; # @xid[0, 1] = @ditet[0, 1];
} }
# } # {}
$keys[$i_al] = $asrc; $keys[$i_al] = $asrc;
pop @{$tree[$i]{$asrc}}; pop @{$tree[$i]{$asrc}};
} else { } else {
@ -234,7 +231,7 @@ sub MOVEMENT_TREE { # Assume relative movement to support abritrary depth (0 < $
$tmpalg{$selection} = $ditet[2/($player+1)+1]; $tmpalg{$selection} = $ditet[2/($player+1)+1];
$keys[$i_al] = $asrc; # Undo the (reverse-lookup) move. $keys[$i_al] = $asrc; # Undo the (reverse-lookup) move.
next ALLY_DESTINATION; # Already stored this move in the DB, so there's no reason to recalculate our priorities now. next ALLY_DESTINATION; # Already stored this move in the DB, so there's no reason to recalculate our priorities now.
} #else {print 'false', "\n"} } else {$tmpalg{$selection} = 0}
if ($prop{$adest}) { if ($prop{$adest}) {
@adest = @{$prop{$adest}}; @adest = @{$prop{$adest}};
$tmpalg{$selection} += $pval{join '', @adest}; # Prioritize high-value enemy pieces. $tmpalg{$selection} += $pval{join '', @adest}; # Prioritize high-value enemy pieces.
@ -481,15 +478,15 @@ $sth5->execute($bid, $wid, $tmpalg{$selection}, undef);
} }
# if ($player == $user_mode and (join '', @asrc) eq $_[7] and ($_[8] eq $adest or $_[8] eq (join '', @adest))) {$tmpalg{$selection} = 'Inf'; $sth9->execute($_[9], $bid, $wid)} # if ($player == $user_mode and (join '', @asrc) eq $_[7] and ($_[8] eq $adest or $_[8] eq (join '', @adest))) {$tmpalg{$selection} = 'Inf'; $sth9->execute($_[9], $bid, $wid)}
# if ($player == $user_mode) {if ($#asrc != -1 and (join '', @asrc) eq $_[7] and ($_[8] eq $adest or $_[8] eq (join '', @adest))) {$tmpalg{$selection} = 'Inf'; $sth10->execute($_[9], $bid, $wid)}} #else { # if ($player == $user_mode) {if ($#asrc != -1 and (join '', @asrc) eq $_[7] and ($_[8] eq $adest or $_[8] eq (join '', @adest))) {$tmpalg{$selection} = 'Inf'; $sth10->execute($_[9], $bid, $wid)}} #else {
if ($player == $user_mode) {if ($asrc eq $_[7] and $_[8] eq $adest) {$tmpalg{$selection} = 'Inf'; $sth10->execute($_[9], $bid, $wid)}} #else { if ($player == $user_mode{$_[9]}) {if ($asrc eq $_[7] and $_[8] eq $adest) {$tmpalg{$selection} = 'Inf'; $sth10->execute($_[9], $bid, $wid)}} #else {
my $val = $tmpalg{$selection}; my $val = $tmpalg{$selection};
push @{$key_list_by_value{$val}}, ($selection, $bid, $wid); push @{$key_list_by_value{$val}}, ($selection, $bid, $wid);
unless (defined($prio)) { unless (defined($rio)) {
$prio = $val; $rio = $val;
# @xid[0, 1] = ($bid, $wid); # @xid[0, 1] = ($bid, $wid);
} }
if ($val > $prio) { if ($val > $rio) {
$prio = $val; $rio = $val;
# @xid[0, 1] = ($bid, $wid); # @xid[0, 1] = ($bid, $wid);
} }
# } # }
@ -497,11 +494,11 @@ $sth5->execute($bid, $wid, $tmpalg{$selection}, undef);
} }
} }
} }
for (my $ii = 0; $#{$key_list_by_value{$prio}} >= $ii; $ii += 3) { for (my $ii = 0; $#{$key_list_by_value{$rio}} >= $ii; $ii += 3) {
push @selection, $key_list_by_value{$prio}[$ii]; push @selection, $key_list_by_value{$rio}[$ii];
} }
$ice = int(rand($#selection+1)); $ice = int(rand($#selection+1));
return ($prio, $key_list_by_value{$prio}[$ice*3+1], $key_list_by_value{$prio}[$ice*3+2], $selection[$ice], $ice, ($#selection+1)); return ($rio, $key_list_by_value{$rio}[$ice*3+1], $key_list_by_value{$rio}[$ice*3+2], $selection[$ice], $ice, ($#selection+1));
} }
sub QUEEN { sub QUEEN {
@ -680,7 +677,7 @@ sub CLEANUP_POSTTURN {
sub POSTCHESS_CALC { sub POSTCHESS_CALC {
my ($pval, $called_player, $reason) = @_; # Arguments: (Value of all pieces of $player - $not_player[$player], $player, reason for exiting the game (did a $player win?)). my ($pval, $called_player, $reason, $session) = @_; # Arguments: (Value of all pieces of $player - $not_player[$player], $player, reason for exiting the game (did a $player win?)).
foreach my $current_player (@player) { foreach my $current_player (@player) {
my $mpval; my $mpval;
my $sth4 = $dbh->prepare(q/UPDATE context SET /.$pplayer[$not_player[$current_player]].q/prio = ? FROM black, white WHERE black.id = bid and white.id = wid and white.b0 = ? and white.b1 = ? and white.k0 = ? and white.n0 = ? and white.n1 = ? and white.p0 = ? and white.p1 = ? and white.p2 = ? and white.p3 = ? and white.p4 = ? and white.p5 = ? and white.p6 = ? and white.p7 = ? and white.q0 = ? and white.r0 = ? and white.r1 = ? and black.b0 = ? and black.b1 = ? and black.k0 = ? and black.n0 = ? and black.n1 = ? and black.p0 = ? and black.p1 = ? and black.p2 = ? and black.p3 = ? and black.p4 = ? and black.p5 = ? and black.p6 = ? and black.p7 = ? and black.q0 = ? and black.r0 = ? and black.r1 = ?/); my $sth4 = $dbh->prepare(q/UPDATE context SET /.$pplayer[$not_player[$current_player]].q/prio = ? FROM black, white WHERE black.id = bid and white.id = wid and white.b0 = ? and white.b1 = ? and white.k0 = ? and white.n0 = ? and white.n1 = ? and white.p0 = ? and white.p1 = ? and white.p2 = ? and white.p3 = ? and white.p4 = ? and white.p5 = ? and white.p6 = ? and white.p7 = ? and white.q0 = ? and white.r0 = ? and white.r1 = ? and black.b0 = ? and black.b1 = ? and black.k0 = ? and black.n0 = ? and black.n1 = ? and black.p0 = ? and black.p1 = ? and black.p2 = ? and black.p3 = ? and black.p4 = ? and black.p5 = ? and black.p6 = ? and black.p7 = ? and black.q0 = ? and black.r0 = ? and black.r1 = ?/);
@ -707,15 +704,20 @@ my ($pval, $called_player, $reason) = @_; # Arguments: (Value of all pieces of $
} }
} }
} }
foreach my $anothervar (keys %{$what_i_did[$current_player]}) { foreach my $anothervar (keys %{$what_i_did{$session}[$current_player]}) {
$what_i_did[$current_player]{$anothervar} += $mpval; $what_i_did{$session}[$current_player]{$anothervar} += $mpval;
$sth4->execute($what_i_did[$current_player]{$anothervar}, @keys); $sth4->execute($what_i_did{$session}[$current_player]{$anothervar}, @keys);
} }
} }
#undef %what_i_did{$session};
#undef %user_mode{$session};
#undef %player_turn{$session};
#undef %counter{$session};
#undef %pseudoinfinite_loop_check{$session};
} }
sub PROGRAM { sub PROGRAM {
$user_mode = 0; $user_mode{$_[2]} = 0;
# if (!defined($user_mode)) { # if (!defined($user_mode)) {
# print 'Please input your side:', "\n"; # print 'Please input your side:', "\n";
# foreach (@player) { # foreach (@player) {
@ -740,29 +742,38 @@ $user_mode = 0;
# MATCH: while (1) { # MATCH: while (1) {
my %diff; my %diff;
$player_turn++; $player_turn{$_[2]}++;
# $player = ($player_turn+1) % 2; # $player = ($player_turn+1) % 2;
TURN: foreach my $player (@player) { TURN: foreach my $player (@player) {
# @{$diff{'msg'}{'turn'}}[$player] = 'Player ' . $player . ' turn ' . $player_turn . ':'; # @{$diff{'msg'}{'turn'}}[$player] = 'Player ' . $player . ' turn ' . $player_turn . ':';
push @{$diff{$pplayer[$player]}{'status'}}, $player_turn; push @{$diff{$pplayer[$player]}{'status'}}, $player_turn{$_[2]};
my ($depth, $prio, $ice, $selection, @id, $n_o_selections); my ($depth, $prio, $ice, $selection, @id, $n_o_selections);
my ($dpval, $i_al) = (0, 0); my ($dpval, $i_al) = (0, 0);
if ($player == $user_mode) { # If the player is human-controlled, we needn't more than $depth 1 (for input validation). if ($player == $user_mode{$_[2]}) { # If the player is human-controlled, we needn't more than $depth 1 (for input validation).
$depth = 1; $depth = 1;
$sth11->execute($_[2]);
my @ids = $sth11->fetchrow_array();
if (!defined($ids[0])) { # Default state.
%prop = %default_prop;
@keys = @default_keys;
} else { # Restore arbitrary states.
$sth8->execute($ids[1]);
$sth9->execute($ids[0]);
&CLEANUP_POSTGAME;
{my $x = 0; map {$keys[$x+16] = $_; if (defined($_)) {push @{$prop{$_}}, (1, @split_piece_column_names[($x*2)..($x*2+1)])}; $x++} @{$sth9->fetchrow_arrayref}};
{my $x = 0; map {if (!defined($_) or exists($prop{$_})) {$keys[$x] = undef} else {$keys[$x] = $_; push @{$prop{$_}}, (0, @split_piece_column_names[($x*2)..($x*2+1)])}; $x++} @{$sth8->fetchrow_arrayref}}; # Not applying it correctly with @keys and %prop modifications after $sth10.
}
my ($xrc, $yrc) = split //, $_[0]; my ($xrc, $yrc) = split //, $_[0];
$_[0] = join '.', $pxr{$xrc}, ($yrc-1); $_[0] = join '.', $pxr{$xrc}, ($yrc-1);
($xrc, $yrc) = split //, $_[1]; ($xrc, $yrc) = split //, $_[1];
$_[1] = join '.', $pxr{$xrc}, ($yrc-1); $_[1] = join '.', $pxr{$xrc}, ($yrc-1);
print $_[0], ' ', $_[1], "\n";
($prio, @id[0, 1], $selection, $ice, $n_o_selections) = &MOVEMENT_TREE($player, $depth, undef, undef, undef, undef, undef, $_[0], $_[1], $_[2]); ($prio, @id[0, 1], $selection, $ice, $n_o_selections) = &MOVEMENT_TREE($player, $depth, undef, undef, undef, undef, undef, $_[0], $_[1], $_[2]);
print 'w ', $id[0], ' ', $id[1], "\n";
} else { } else {
$depth = 2; # Usually about 20^$depth possibilities (but ten times as much iterates for including no movement). $depth = 2; # Usually about 20^$depth possibilities (but ten times as much iterates for including no movement).
($prio, @id[0, 1], $selection, $ice, $n_o_selections) = &MOVEMENT_TREE($player, $depth, undef, undef, undef, undef, undef, undef, undef, $_[2]); ($prio, @id[0, 1], $selection, $ice, $n_o_selections) = &MOVEMENT_TREE($player, $depth, undef, undef, undef, undef, undef, undef, undef, $_[2]);
$sth10->execute($_[2], @id[0, 1]); $sth10->execute($_[2], @id[0, 1]);
print 'b ', $id[0], ' ', $id[1], "\n";
} }
# print 'keys: ', scalar keys %key_list_by_value, "\n"; # print 'keys: ', scalar keys %key_list_by_value, "\n";
# print 'ids: ', $#id, "\n"; # print 'ids: ', $#id, "\n";
@ -778,8 +789,8 @@ print 'b ', $id[0], ' ', $id[1], "\n";
# } # }
# } # }
if ($player == $user_mode and $prio != 'Inf') { # Invalid user input. if ($player == $user_mode{$_[2]} and $prio != 'Inf') { # Invalid user input.
$player_turn--; $player_turn{$_[2]}--;
# push @{$diff{$player}{'warn'}} = 'Reverting an invalid set.'; # push @{$diff{$player}{'warn'}} = 'Reverting an invalid set.';
undef $diff{$pplayer[$not_player[$player]]}; undef $diff{$pplayer[$not_player[$player]]};
push @{$diff{$pplayer[$player]}{'status'}}, -1; push @{$diff{$pplayer[$player]}{'status'}}, -1;
@ -809,70 +820,70 @@ print 'b ', $id[0], ' ', $id[1], "\n";
my $matches = grep {!/^[01][.]k[.]0_/} keys %tmpalg; # When only the king can move... my $matches = grep {!/^[01][.]k[.]0_/} keys %tmpalg; # When only the king can move...
if ($matches == 0) { if ($matches == 0) {
$counter++; $counter{$_[2]}++;
if ($counter >= 2 && $player_turn > 24) { # End the game if the same applies to the opponent (only the king can move), and $player_turn have passed. if ($counter{$_[2]} >= 2 && $player_turn{$_[2]} > 24) { # End the game if the same applies to the opponent (only the king can move), and $player_turn have passed.
# @{$diff{'msg'}{'gstatus'}}[$player] = 'Only the kings can act. Stalemate...'; # @{$diff{'msg'}{'gstatus'}}[$player] = 'Only the kings can act. Stalemate...';
push @{$diff{$pplayer[$player]}{'status'}}, 4; push @{$diff{$pplayer[$player]}{'status'}}, 4;
&POSTCHESS_CALC(&PRETTY_CALC(0, $player), 0); &POSTCHESS_CALC(&PRETTY_CALC(0, $player), 0, $_[2]);
# return; # return;
} }
} }
if ($player_turn >= $action_limit) { # TODO: Is this needed when we have @pseudoinfinite_loop_check? if ($player_turn{$_[2]} >= $action_limit) { # TODO: Is this needed when we have @pseudoinfinite_loop_check?
# @{$diff{'msg'}{'gstatus'}}[$player] = 'Total turn limit ' . ($player_turn*2) . ' reached: Stalemate...'; # @{$diff{'msg'}{'gstatus'}}[$player] = 'Total turn limit ' . ($player_turn*2) . ' reached: Stalemate...';
push @{$diff{$pplayer[$player]}{'status'}}, 3; push @{$diff{$pplayer[$player]}{'status'}}, 3;
&POSTCHESS_CALC(&PRETTY_CALC(0, $player), 0); &POSTCHESS_CALC(&PRETTY_CALC(0, $player), 0, $_[2]);
# return; # return;
} }
if (($player_turn*2+$player) % ($loop_limit+1) == 0) { # When player 0 is iterating through all chess possibilities in training mode, stop & do the usual decrement when both players have been doing the same four-turn loop at least three times successively. If we don't stop the program here but do stop the four-turn loop, player 1 might prioritize creating loops when breaking the loop would be a final blow for player 0. TODO: Alternatively, we might revert back here to some previous state... if (($player_turn{$_[2]}*2+$player) % ($loop_limit+1) == 0) { # When player 0 is iterating through all chess possibilities in training mode, stop & do the usual decrement when both players have been doing the same four-turn loop at least three times successively. If we don't stop the program here but do stop the four-turn loop, player 1 might prioritize creating loops when breaking the loop would be a final blow for player 0. TODO: Alternatively, we might revert back here to some previous state...
my ($evenval1, $unevenval1, $evenval2, $unevenval2); my ($evenval1, $unevenval1, $evenval2, $unevenval2);
for (my $counter3 = 0; $#pseudoinfinite_loop_check >= $counter3; $counter3++) { for (my $counter3 = 0; $#{$pseudoinfinite_loop_check{$_[2]}} >= $counter3; $counter3++) {
if ($counter3 > 1) { if ($counter3 > 1) {
if ($counter3 > 3) { if ($counter3 > 3) {
if ($counter3 % 2 == 0) { if ($counter3 % 2 == 0) {
if ($counter3 % 4 == 0) { if ($counter3 % 4 == 0) {
next if $evenval1 eq $pseudoinfinite_loop_check[$counter3]; next if $evenval1 eq $pseudoinfinite_loop_check{$_[2]}[$counter3];
last; last;
} elsif (($counter3+1) % 4 == 0) { } elsif (($counter3+1) % 4 == 0) {
next if $unevenval1 eq $pseudoinfinite_loop_check[$counter3]; next if $unevenval1 eq $pseudoinfinite_loop_check{$_[2]}[$counter3];
last; last;
} elsif (($counter3+2) % 4 == 0) { } elsif (($counter3+2) % 4 == 0) {
next if $evenval2 eq $pseudoinfinite_loop_check[$counter3]; next if $evenval2 eq $pseudoinfinite_loop_check{$_[2]}[$counter3];
last; last;
} elsif (($counter3+3) % 4 == 0) { } elsif (($counter3+3) % 4 == 0) {
next if $unevenval2 eq $pseudoinfinite_loop_check[$counter3]; next if $unevenval2 eq $pseudoinfinite_loop_check{$_[2]}[$counter3];
last; last;
} }
} }
} elsif ($counter3 % 2 == 0) { } elsif ($counter3 % 2 == 0) {
$evenval2 = $pseudoinfinite_loop_check[$counter3]; $evenval2 = $pseudoinfinite_loop_check{$_[2]}[$counter3];
next; next;
} else { } else {
$unevenval2 = $pseudoinfinite_loop_check[$counter3]; $unevenval2 = $pseudoinfinite_loop_check{$_[2]}[$counter3];
next; next;
} }
} elsif ($counter3 % 2 == 0) { } elsif ($counter3 % 2 == 0) {
$evenval1 = $pseudoinfinite_loop_check[$counter3]; $evenval1 = $pseudoinfinite_loop_check{$_[2]}[$counter3];
next; next;
} else { } else {
$unevenval1 = $pseudoinfinite_loop_check[$counter3]; $unevenval1 = $pseudoinfinite_loop_check{$_[2]}[$counter3];
next; next;
} }
# @{$diff{'status'}}[$player] = 'Loop limit ' . $loop_limit . ' reached: Stalemate...'; # @{$diff{'status'}}[$player] = 'Loop limit ' . $loop_limit . ' reached: Stalemate...';
push @{$diff{$pplayer[$player]}{'status'}}, 2; push @{$diff{$pplayer[$player]}{'status'}}, 2;
&POSTCHESS_CALC(&PRETTY_CALC(0, $player), 0); &POSTCHESS_CALC(&PRETTY_CALC(0, $player), 0, $_[2]);
# return; # return;
} }
undef @pseudoinfinite_loop_check; undef @{$pseudoinfinite_loop_check{$_[2]}};
} }
push @pseudoinfinite_loop_check, $selection; push @{$pseudoinfinite_loop_check{$_[2]}}, $selection;
# push @{$diff{$pplayer[$player]}{'prio'}}, $prio; # push @{$diff{$pplayer[$player]}{'prio'}}, $prio;
# push @{$diff{$pplayer[$player]}{'moveno'}}, ($ice+1) . '/' . $n_o_selections; # push @{$diff{$pplayer[$player]}{'moveno'}}, ($ice+1) . '/' . $n_o_selections;
# @{$diff{'msg'}{'verbose'}}[$player] = $selection[$ice]; # @{$diff{'msg'}{'verbose'}}[$player] = $selection[$ice];
$what_i_did[$player]{$selection} = $prio; $what_i_did{$_[2]}[$player]{$selection} = $prio;
my $c = 0; my $c = 0;
my $adest; my $adest;
foreach (split /,/, $selection) { foreach (split /,/, $selection) {
@ -896,7 +907,7 @@ print 'b ', $id[0], ' ', $id[1], "\n";
if ($prop{$adest}[1] eq 'k') { if ($prop{$adest}[1] eq 'k') {
push @{$diff{$pplayer[$player]}{'status'}}, 1; push @{$diff{$pplayer[$player]}{'status'}}, 1;
# push @{$diff{[$player]}{'win'}}, ' Player ' . $player . ' wins!'; # push @{$diff{[$player]}{'win'}}, ' Player ' . $player . ' wins!';
&POSTCHESS_CALC(&PRETTY_CALC(0, $player), 1); &POSTCHESS_CALC(&PRETTY_CALC(0, $player), 1, $_[2]);
# return; # return;
} }
# if ($player != $user_mode) {$keys[$c] = $adest; $sth6->execute(@keys[0..15]); my @wid = $sth6->fetchrow_array(); $sth7->execute(@keys[16..31]); my @bid = $sth7->fetchrow_array(); print $bid[0], ' ', $#bid, ' ', $#wid, ' ', $wid[0], "\n"; $sth10->execute($sessid, $bid[0], $wid[0]); $keys[$c] = $asrc} # if ($player != $user_mode) {$keys[$c] = $adest; $sth6->execute(@keys[0..15]); my @wid = $sth6->fetchrow_array(); $sth7->execute(@keys[16..31]); my @bid = $sth7->fetchrow_array(); print $bid[0], ' ', $#bid, ' ', $#wid, ' ', $wid[0], "\n"; $sth10->execute($sessid, $bid[0], $wid[0]); $keys[$c] = $asrc}
@ -923,19 +934,17 @@ print 'b ', $id[0], ' ', $id[1], "\n";
#&CLEANUP_POSTGAME; #&CLEANUP_POSTGAME;
&INIT_BOARD; &INIT_BOARD;
%default_prop = %prop;
&INIT_KEYS; &INIT_KEYS;
@default_keys = @keys;
#my $jar = HTTP::Cookies->new;
get '/board/init' => sub { get '/board/init' => sub {
encode_json(\%default_iboard); encode_json(\%default_iboard);
}; };
get '/move/:src/:dst' => sub { get '/move/:src/:dst/:stt' => sub {
#if (session('init')) { my %diff = &PROGRAM(route_parameters->get('src'), route_parameters->get('dst'), route_parameters->get('stt')); # Includes player input.
my %diff = &PROGRAM(route_parameters->get('src'), route_parameters->get('dst'), session->id); # Includes player input.
encode_json(\%diff); encode_json(\%diff);
#}
}; };
get '/' => sub { get '/' => sub {

9
chess_gui/public/js/dand.js
Unescape View File

@ -8,9 +8,10 @@ var pp = ['White','Black'];
//x = 25; //x = 25;
//console.log(x.toString(36)); //console.log(x.toString(36));
if (!window.localStorage || !localStorage.init) { // Use AJAX. if (!localStorage.init) { // Use AJAX.
console.log(localStorage.length); if (window.localStorage) { // TODO: Might try session storage/cookies if false.
var xhr = new XMLHttpRequest(); localStorage.state = S();
}
xhr.open('GET', 'board/init', true); // Returns coordinate & piece. xhr.open('GET', 'board/init', true); // Returns coordinate & piece.
xhr.send(null); xhr.send(null);
xhr.onload = function () { xhr.onload = function () {
@ -42,7 +43,7 @@ i++;
} }
function dragAndDrop(drag, drop) { function dragAndDrop(drag, drop) {
xhr.open('GET', 'move/' + drag + '/' + drop , true); xhr.open('GET', 'move/' + drag + '/' + drop + '/' + localStorage.state, true);
xhr.send(null); xhr.send(null);
xhr.onload = function () { xhr.onload = function () {
if (xhr.status === 200) { if (xhr.status === 200) {

16
chess_gui/public/js/head.js
Unescape View File

@ -10,6 +10,21 @@ function T(a) {
return document.getElementsByTagName(a); return document.getElementsByTagName(a);
} }
function S() {
var r = (Math.random()*36).toString(36).substring(2);
var f = Math.random().toString().replace(/^0\./, '');
//f = f*10**(f.toString().length-2);
var g = '';
for (var i=0; f.length > i && r.length > i; i++) {
if (f.charAt(i) >= 5) {
g += r.charAt(i).toUpperCase();
} else {
g += r.charAt(i);
}
}
return g;
}
function G(i, s, o, r) { function G(i, s, o, r) {
if (i % 8 === 0) { if (i % 8 === 0) {
var li = document.createElement('li'); var li = document.createElement('li');
@ -34,7 +49,6 @@ img.setAttribute('alt', pp[o.substring(0, 1)] + ' ' + pn[prop] + ' on ' + s);
li.appendChild(img); li.appendChild(img);
} else { } else {
var pce = I(o); var pce = I(o);
console.log(i, s, o, pce, r);
if (pce === null) { if (pce === null) {
var img = document.createElement('img'); var img = document.createElement('img');
var prop = o.substring(1, 2); var prop = o.substring(1, 2);

Write Preview
Loading…
Cancel
Save