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

Bug fix #1 (dirty).

Browse Source
main
Roy 2 years ago
parent 642870867e
commit bb3830d985
4 changed files with 92 additions and 49 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. 120
      chess_gui/lib/chess_gui.pm
  2. 10
      chess_gui/public/css/index.css
  3. 7
      chess_gui/public/js/dand.js
  4. 4
      chess_gui/views/index.tt

120
chess_gui/lib/chess_gui.pm
Unescape View File

@ -58,7 +58,7 @@ my $sth7 = $dbh->prepare(q/SELECT id FROM black WHERE b0 = ? and b1 = ? and k0 =
#my $sth8 = $dbh->prepare(q/SELECT black.b0, black.b1, black.k0, black.n0, black.n1, black.p0, black.p1, black.p2, black.p3, black.p4, black.p5, black.p6, black.p7, black.q0, black.r0, black.r1, white.b0, white.b1, white.k0, white.n0, white.n1, white.p0, white.p1, white.p2, white.p3, white.p4, white.p5, white.p6, white.p7, white.q0, white.r0, white.r1 FROM black, white WHERE (black.id, white.id) IN (SELECT bid, wid FROM sessions WHERE session = ?)/); #my $sth8 = $dbh->prepare(q/SELECT black.b0, black.b1, black.k0, black.n0, black.n1, black.p0, black.p1, black.p2, black.p3, black.p4, black.p5, black.p6, black.p7, black.q0, black.r0, black.r1, white.b0, white.b1, white.k0, white.n0, white.n1, white.p0, white.p1, white.p2, white.p3, white.p4, white.p5, white.p6, white.p7, white.q0, white.r0, white.r1 FROM black, white WHERE (black.id, white.id) IN (SELECT bid, wid FROM sessions WHERE session = ?)/);
my $sth8 = $dbh->prepare(q/SELECT b0, b1, k0, n0, n1, p0, p1, p2, p3, p4, p5, p6, p7, q0, r0, r1 FROM white WHERE id = ?/); my $sth8 = $dbh->prepare(q/SELECT b0, b1, k0, n0, n1, p0, p1, p2, p3, p4, p5, p6, p7, q0, r0, r1 FROM white 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 $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 (session, bid, wid) = ($1, $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, @keys, @pplayer, %tmpalg, %tmpalg2, %tmpalg3, %tmpalg4, $players, @not_player, $smaleer, %pval);
@not_player[0, 1] = (1, 0); @not_player[0, 1] = (1, 0);
@ -170,6 +170,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 (@xid, $prio, %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.
@ -179,10 +180,22 @@ sub MOVEMENT_TREE { # Assume relative movement to support abritrary depth (0 < $
for (my $c = $#{$tree[$i]{$asrc}}; $c >= 1; $c--) { # This should make the subroutine multiple times faster if there's no previous untravelled branch. for (my $c = $#{$tree[$i]{$asrc}}; $c >= 1; $c--) { # This should make the subroutine multiple times faster if there's no previous untravelled branch.
$keys[$i_al] = $tree[$i]{$asrc}[$c]; $keys[$i_al] = $tree[$i]{$asrc}[$c];
$sth1->execute(@keys); $sth1->execute(@keys);
my $ditet = $sth1->fetchall_arrayref(); my @ditet = $sth1->fetchrow_array();
if ($#$ditet != -1 and defined(${@$ditet[0]}[2/($player+1)+1])) { if ($#ditet != -1 and defined($ditet[2/($player+1)+1])) {
{no warnings; $tmpalg{join ',', @keys} = ${@$ditet[0]}[2/($player+1)+1]}; my $tmpkey = join ',', @keys;
if ($player == $user_mode and 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{join ',', @keys} = 'Inf'; $sth10->execute($_[9], ${@$ditet[0]}[0], ${@$ditet[0]}[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 {
my $val = $tmpalg{$tmpkey};
push @{$key_list_by_value{$val}}, $tmpkey;
unless (defined($prio)) {
$prio = $val;
@xid[0, 1] = @ditet[1, 0];
}
if ($val > $prio) {
$prio = $val;
@xid[0, 1] = @ditet[1, 0];
}
# }
$keys[$i_al] = $asrc; $keys[$i_al] = $asrc;
pop @{$tree[$i]{$asrc}}; pop @{$tree[$i]{$asrc}};
} else { } else {
@ -196,9 +209,9 @@ sub MOVEMENT_TREE { # Assume relative movement to support abritrary depth (0 < $
$keys[$i_al] = $adest; $keys[$i_al] = $adest;
{no warnings; $selection = join ',', @keys}; # CSV. {no warnings; $selection = join ',', @keys}; # CSV.
$sth1->execute(@keys); $sth1->execute(@keys);
my $ditet = $sth1->fetchall_arrayref(); my @ditet = $sth1->fetchrow_array();
if ($#$ditet != -1 and defined(${@$ditet[0]}[2/($player+1)+1])) { # Already calculated the context for this $adest (and since @keys has a fixed order, for this $piece): Skip to save precious time. if ($#ditet != -1 and defined($ditet[2/($player+1)+1])) { # Already calculated the context for this $adest (and since @keys has a fixed order, for this $piece): Skip to save precious time.
$tmpalg{$selection} = ${@$ditet[0]}[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 {print 'false', "\n"}
@ -415,17 +428,17 @@ sub MOVEMENT_TREE { # Assume relative movement to support abritrary depth (0 < $
$tmpalg{$selection} += $dpval - $tmpalg2{$selection} + $tmpalg3{$selection} - $tmpalg4{$selection}; $tmpalg{$selection} += $dpval - $tmpalg2{$selection} + $tmpalg3{$selection} - $tmpalg4{$selection};
$sth6->execute(@keys[0..15]); $sth6->execute(@keys[0..15]);
$wid = $sth6->fetchall_arrayref(); my @wid = $sth6->fetchrow_array();
unless ($#$wid != -1) { if ($#wid == -1) {
$sth2->execute(@keys[0..15]); $sth2->execute(@keys[0..15]);
$wid = $dbh->last_insert_id(undef, undef, undef, undef, {sequence => 'seq_wid'}); $wid = $dbh->last_insert_id(undef, undef, undef, undef, {sequence => 'seq_wid'});
} else {$wid = ${@$wid[0]}[0]} } else {$wid = $wid[0]}
$sth7->execute(@keys[16..31]); $sth7->execute(@keys[16..31]);
$bid = $sth7->fetchall_arrayref(); my @bid = $sth7->fetchrow_array();
unless ($#$bid != -1) { if ($#bid == -1) {
$sth3->execute(@keys[16..31]); $sth3->execute(@keys[16..31]);
$bid = $dbh->last_insert_id(undef, undef, undef, undef, {sequence => 'seq_bid'}); $bid = $dbh->last_insert_id(undef, undef, undef, undef, {sequence => 'seq_bid'});
} else {$bid = ${@$bid[0]}[0]} } else {$bid = $bid[0]}
if ($player == 0) { if ($player == 0) {
$sth5->execute($bid, $wid, undef, $tmpalg{$selection}); $sth5->execute($bid, $wid, undef, $tmpalg{$selection});
@ -447,11 +460,26 @@ $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 and $#asrc != -1 and (join '', @asrc) eq $_[7] and ($_[8] eq $adest or $_[8] eq (join '', @adest))) {$tmpalg{$selection} = 'Inf'; $sth10->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 {
my $val = $tmpalg{$selection};
push @{$key_list_by_value{$val}}, $selection;
unless (defined($prio)) {
$prio = $val;
@xid[0, 1] = ($wid, $bid);
}
if ($val > $prio) {
$prio = $val;
@xid[0, 1] = ($wid, $bid);
}
# }
$keys[$i_al] = $asrc; $keys[$i_al] = $asrc;
} }
} }
} }
for (my $ii = 0; $#{$key_list_by_value{$prio}} >= $ii; $ii++) {
$selection[$ii] = $key_list_by_value{$prio}[$ii];
}
return ($prio, @xid[0, 1], @selection);
} }
sub QUEEN { sub QUEEN {
@ -697,26 +725,30 @@ $user_mode = 0;
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;
my ($depth, %key_list_by_value, $prio, $ice, @selection); my ($depth, $prio, $ice, @selection, @id);
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) { # If the player is human-controlled, we needn't more than $depth 1 (for input validation).
$depth = 1; $depth = 1;
&MOVEMENT_TREE($player, $depth, undef, undef, undef, undef, undef, $_[0], $_[1], $sessid); ($prio, @id[0, 1], @selection) = &MOVEMENT_TREE($player, $depth, undef, undef, undef, undef, undef, $_[0], $_[1], $sessid);
} 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).
&MOVEMENT_TREE($player, $depth); ($prio, @id[0, 1], @selection) = &MOVEMENT_TREE($player, $depth, undef, undef, undef, undef, undef, undef, undef, $sessid);
$sth10->execute($sessid, @id[0, 1]);
} }
foreach (keys %tmpalg) { # print 'keys: ', scalar keys %key_list_by_value, "\n";
my $val = $tmpalg{$_}; # print 'ids: ', $#id, "\n";
push @{$key_list_by_value{$val}}, $_;
unless (defined($prio)) { # foreach (keys %tmpalg) {
$prio = $val; # my $val = $tmpalg{$_};
} # push @{$key_list_by_value{$val}}, $_;
if ($val > $prio) { # unless (defined($prio)) {
$prio = $val; # $prio = $val;
} # }
} # if ($val > $prio) {
# $prio = $val;
# }
# }
if ($player == $user_mode and $prio != 'Inf') { # Invalid user input. if ($player == $user_mode and $prio != 'Inf') { # Invalid user input.
$player_turn--; $player_turn--;
@ -727,21 +759,21 @@ $user_mode = 0;
return %diff; return %diff;
} }
if (scalar keys %key_list_by_value > 0) { # if (scalar keys %key_list_by_value > 0) {
for (my $ii = 0; $#{$key_list_by_value{$prio}} >= $ii; $ii++) { # for (my $ii = 0; $#{$key_list_by_value{$prio}} >= $ii; $ii++) {
$selection[$ii] = $key_list_by_value{$prio}[$ii]; # $selection[$ii] = $key_list_by_value{$prio}[$ii];
} # }
$ice = int(rand($#selection+1)); $ice = int(rand($#selection+1));
} elsif ($user_mode != $player) { # The other side has checkmated you (the AI). The AI should know when to give up (even if it weren't for efficiency reasons). # } elsif ($user_mode != $player) { # The other side has checkmated you (the AI). The AI should know when to give up (even if it weren't for efficiency reasons).
# @{$diff{'msg'}{'gstatus'}}[$player] = 'Player ' . $player . ' resigns!'; ## @{$diff{'msg'}{'gstatus'}}[$player] = 'Player ' . $player . ' resigns!';
push @{$diff{$pplayer[$player]}{'status'}}, 5; # push @{$diff{$pplayer[$player]}{'status'}}, 5;
if ($user_mode == -1) { # So, instead of performing winning moves (which will always be done at this tree depth), we have enough data here to revert back to some previous (hence valid) board state (with untravelled nodes). Rather than starting from scratch every time, this might be preferable for AI training. The importance of the first few chess moves shouldn't be undermined, however. Therefore, include some appropriate randomization. # if ($user_mode == -1) { # So, instead of performing winning moves (which will always be done at this tree depth), we have enough data here to revert back to some previous (hence valid) board state (with untravelled nodes). Rather than starting from scratch every time, this might be preferable for AI training. The importance of the first few chess moves shouldn't be undermined, however. Therefore, include some appropriate randomization.
#TODO: Usual DB writing followed by POC. # #TODO: Usual DB writing followed by POC.
next TURN; # next TURN;
} else { # } else {
next TURN; # next TURN;
} # }
} # }
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) {
@ -833,7 +865,7 @@ $user_mode = 0;
&POSTCHESS_CALC(&PRETTY_CALC(0, $player), 1); &POSTCHESS_CALC(&PRETTY_CALC(0, $player), 1);
# 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}
# if ($player == 0) { # if ($player == 0) {
# $keys[$c] # $keys[$c]
# } # }
@ -844,7 +876,7 @@ $user_mode = 0;
} else { } else {
@{$prop{$adest}} = @{$piece}; @{$prop{$adest}} = @{$piece};
$keys[$c] = $adest; $keys[$c] = $adest;
if ($player != $user_mode) {$sth6->execute(@keys[0..15]); my @wid = $sth6->fetchrow_array(); $sth7->execute(@keys[16..31]); my @bid = $sth7->fetchrow_array(); $sth10->execute($sessid, $bid[0], $wid[0])} # if ($player != $user_mode) {$sth6->execute(@keys[0..15]); my @wid = $sth6->fetchrow_array(); $sth7->execute(@keys[16..31]); my @bid = $sth7->fetchrow_array(); $sth10->execute($sessid, $bid[0], $wid[0])}
undef $prop{$asrc}; undef $prop{$asrc};
} }
# &PRETTY_CALC; # &PRETTY_CALC;

10
chess_gui/public/css/index.css
Unescape View File

@ -58,6 +58,10 @@ h3 > ul:hover .key {
position: fixed; position: fixed;
} }
/*img {*/ img {
/* position: relative;*/ position: relative;
/*}*/ border: 2.5px;
height: 30px;
border-color: #884b10;
border-color: #592b07;
}

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

@ -25,7 +25,14 @@ I(drag).setAttribute('src', 'i/' + responseObject.w.src[0] + '.png');
I(drop).setAttribute('src', 'i/' + responseObject.w.src[1] + '.png'); I(drop).setAttribute('src', 'i/' + responseObject.w.src[1] + '.png');
I(drag).id = responseObject.w.src[0]; I(drag).id = responseObject.w.src[0];
I(drop).id = responseObject.w.src[1]; I(drop).id = responseObject.w.src[1];
// TODO: Display status and/or sleep. // TODO: Display status and/or sleep.
I('title').innerHTML = responseObject.b.src[1] + ' moves from ' + responseObject.b.src[0] + ' to ' + responseObject.b.dst[0];
if (responseObject.b.dst.length === 2) {I('title').innerHTML += ' and takes ' + responseObject.b.dst[1]}
I('description').innerHTML = 'Turn ' + responseObject.w.status.length + ' of white.';
//I('title').innerHTML = responseObject.b.status[0];
//I('description').innerHTML = responseObject.b.status[1];
I(responseObject.b.src[1]).setAttribute('src', 'i/' + responseObject.b.src[0] + '.png'); I(responseObject.b.src[1]).setAttribute('src', 'i/' + responseObject.b.src[0] + '.png');
I(responseObject.b.dst[responseObject.b.dst.length-1]).setAttribute('src', 'i/' + responseObject.b.src[1] + '.png'); I(responseObject.b.dst[responseObject.b.dst.length-1]).setAttribute('src', 'i/' + responseObject.b.src[1] + '.png');
I(responseObject.b.src[1]).id = responseObject.b.src[0]; I(responseObject.b.src[1]).id = responseObject.b.src[0];

4
chess_gui/views/index.tt
Unescape View File

@ -11,8 +11,8 @@
</head> </head>
<body> <body>
<header> <header>
<h1><p>Title</p></h1> <h1><p id="title"></p></h1>
<h2><p>Description</p></h2> <h2><p id="description"></p></h2>
</header> </header>
<section> <section>
<ol id="y-co"><ol id="x-co"><li class="x-co">A</li><li class="x-co">B</li><li class="x-co">C</li><li class="x-co">D</li><li class="x-co">E</li><li class="x-co">F</li><li class="x-co">G</li><li class="x-co">H</li></ol>[% FOREACH row IN board %]<li><ol>[% FOREACH item IN row %]<li><img id="[% GET item %]" class="coord" src="i/[% GET item %].png" alt="" width="32px"></li>[% END %]</ol></li>[% END %] <ol id="y-co"><ol id="x-co"><li class="x-co">A</li><li class="x-co">B</li><li class="x-co">C</li><li class="x-co">D</li><li class="x-co">E</li><li class="x-co">F</li><li class="x-co">G</li><li class="x-co">H</li></ol>[% FOREACH row IN board %]<li><ol>[% FOREACH item IN row %]<li><img id="[% GET item %]" class="coord" src="i/[% GET item %].png" alt="" width="32px"></li>[% END %]</ol></li>[% END %]

Write Preview
Loading…
Cancel
Save