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 $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$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$sth11=$dbh->prepare(q/SELECT bid, wid FROM sessions WHERE session = ?/);
$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.
subMOVEMENT_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($ice,$prio,%key_list_by_value,@selection);
my($ice,$rio,%key_list_by_value,@selection);
$i+=4;
ALLY_SOURCE:foreachmy$asrc(&KEYS($player)){
my$dpval=$_[3]//0;# Default piece value.
@ -203,19 +200,19 @@ sub MOVEMENT_TREE { # Assume relative movement to support abritrary depth (0 < $
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?)).
foreachmy$current_player(@player){
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 = ?/);
@ -707,15 +704,20 @@ my ($pval, $called_player, $reason) = @_; # Arguments: (Value of all pieces of $
{my$x=0;map{if(!defined($_)orexists($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$matches=grep{!/^[01][.]k[.]0_/}keys%tmpalg;# When only the king can move...
if($matches==0){
$counter++;
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.
$counter{$_[2]}++;
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...';
push@{$diff{$pplayer[$player]}{'status'}},4;
&POSTCHESS_CALC(&PRETTY_CALC(0,$player),0);
&POSTCHESS_CALC(&PRETTY_CALC(0,$player),0,$_[2]);
# 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?
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...
Roy
2 years ago