diff --git a/chess_gui/lib/chess_gui.pm b/chess_gui/lib/chess_gui.pm index f03080f..fcd43ad 100644 --- a/chess_gui/lib/chess_gui.pm +++ b/chess_gui/lib/chess_gui.pm @@ -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 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 $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 (@tree, @what_i_did, %prop, @keys, @pplayer, %tmpalg, %tmpalg2, %tmpalg3, %tmpalg4, $players, @not_player, $smaleer, %pval); @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). 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; ALLY_SOURCE: foreach my $asrc (&KEYS($player)) { 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. $keys[$i_al] = $tree[$i]{$asrc}[$c]; $sth1->execute(@keys); - my $ditet = $sth1->fetchall_arrayref(); - if ($#$ditet != -1 and defined(${@$ditet[0]}[2/($player+1)+1])) { - {no warnings; $tmpalg{join ',', @keys} = ${@$ditet[0]}[2/($player+1)+1]}; - 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])} + my @ditet = $sth1->fetchrow_array(); + if ($#ditet != -1 and defined($ditet[2/($player+1)+1])) { + my $tmpkey = join ',', @keys; + {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; pop @{$tree[$i]{$asrc}}; } else { @@ -196,9 +209,9 @@ sub MOVEMENT_TREE { # Assume relative movement to support abritrary depth (0 < $ $keys[$i_al] = $adest; {no warnings; $selection = join ',', @keys}; # CSV. $sth1->execute(@keys); - my $ditet = $sth1->fetchall_arrayref(); - 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. - $tmpalg{$selection} = ${@$ditet[0]}[2/($player+1)+1]; + my @ditet = $sth1->fetchrow_array(); + 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[2/($player+1)+1]; $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. } #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}; $sth6->execute(@keys[0..15]); -$wid = $sth6->fetchall_arrayref(); - unless ($#$wid != -1) { +my @wid = $sth6->fetchrow_array(); + if ($#wid == -1) { $sth2->execute(@keys[0..15]); $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]); -$bid = $sth7->fetchall_arrayref(); - unless ($#$bid != -1) { +my @bid = $sth7->fetchrow_array(); + if ($#bid == -1) { $sth3->execute(@keys[16..31]); $bid = $dbh->last_insert_id(undef, undef, undef, undef, {sequence => 'seq_bid'}); -} else {$bid = ${@$bid[0]}[0]} +} else {$bid = $bid[0]} if ($player == 0) { $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 $#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; } } } + 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 { @@ -697,26 +725,30 @@ $user_mode = 0; TURN: foreach my $player (@player) { # @{$diff{'msg'}{'turn'}}[$player] = 'Player ' . $player . ' turn ' . $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); if ($player == $user_mode) { # If the player is human-controlled, we needn't more than $depth 1 (for input validation). $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 { $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) { - my $val = $tmpalg{$_}; - push @{$key_list_by_value{$val}}, $_; - unless (defined($prio)) { - $prio = $val; - } - if ($val > $prio) { - $prio = $val; - } - } +# print 'keys: ', scalar keys %key_list_by_value, "\n"; +# print 'ids: ', $#id, "\n"; + +# foreach (keys %tmpalg) { +# my $val = $tmpalg{$_}; +# push @{$key_list_by_value{$val}}, $_; +# unless (defined($prio)) { +# $prio = $val; +# } +# if ($val > $prio) { +# $prio = $val; +# } +# } if ($player == $user_mode and $prio != 'Inf') { # Invalid user input. $player_turn--; @@ -727,21 +759,21 @@ $user_mode = 0; return %diff; } - if (scalar keys %key_list_by_value > 0) { - for (my $ii = 0; $#{$key_list_by_value{$prio}} >= $ii; $ii++) { - $selection[$ii] = $key_list_by_value{$prio}[$ii]; - } +# if (scalar keys %key_list_by_value > 0) { +# for (my $ii = 0; $#{$key_list_by_value{$prio}} >= $ii; $ii++) { +# $selection[$ii] = $key_list_by_value{$prio}[$ii]; +# } $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). -# @{$diff{'msg'}{'gstatus'}}[$player] = 'Player ' . $player . ' resigns!'; - 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. - #TODO: Usual DB writing followed by POC. - next TURN; - } else { - next TURN; - } - } +# } 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!'; +# 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. +# #TODO: Usual DB writing followed by POC. +# next TURN; +# } else { +# next TURN; +# } +# } my $matches = grep {!/^[01][.]k[.]0_/} keys %tmpalg; # When only the king can move... if ($matches == 0) { @@ -833,7 +865,7 @@ $user_mode = 0; &POSTCHESS_CALC(&PRETTY_CALC(0, $player), 1); # 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) { # $keys[$c] # } @@ -844,7 +876,7 @@ $user_mode = 0; } else { @{$prop{$adest}} = @{$piece}; $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}; } # &PRETTY_CALC; diff --git a/chess_gui/public/css/index.css b/chess_gui/public/css/index.css index 72bf2f0..746ac6b 100644 --- a/chess_gui/public/css/index.css +++ b/chess_gui/public/css/index.css @@ -58,6 +58,10 @@ h3 > ul:hover .key { position: fixed; } -/*img {*/ -/* position: relative;*/ -/*}*/ +img { + position: relative; + border: 2.5px; + height: 30px; + border-color: #884b10; + border-color: #592b07; +} diff --git a/chess_gui/public/js/dand.js b/chess_gui/public/js/dand.js index 249f5a7..943bf4d 100644 --- a/chess_gui/public/js/dand.js +++ b/chess_gui/public/js/dand.js @@ -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(drag).id = responseObject.w.src[0]; I(drop).id = responseObject.w.src[1]; + // 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.dst[responseObject.b.dst.length-1]).setAttribute('src', 'i/' + responseObject.b.src[1] + '.png'); I(responseObject.b.src[1]).id = responseObject.b.src[0]; diff --git a/chess_gui/views/index.tt b/chess_gui/views/index.tt index 2ffb115..7f84aa6 100644 --- a/chess_gui/views/index.tt +++ b/chess_gui/views/index.tt @@ -11,8 +11,8 @@
-

Title

-

Description

+

+

    1. A
    2. B
    3. C
    4. D
    5. E
    6. F
    7. G
    8. H
    [% FOREACH row IN board %]
    1. [% FOREACH item IN row %]
      2. [% END %]
    2. [% END %]