LPST.pm - added mirror move. was a massive pain ntvl.pl updated test cases
This commit is contained in:
gashapwn
parent
bf37806515
commit
74316a8618
64
LPST.pm
64
LPST.pm
@ -393,6 +393,7 @@ sub apply_shade($$){
|
||||
my $not = shift;
|
||||
my $en = shift;
|
||||
|
||||
# $sc{$not} = $en;
|
||||
$sc{$not} = $en unless grep(/^$not$/, keys(%sc));
|
||||
$sc{$not} = $MOVBLOCK_ENUM unless $sc{$not} == $en;
|
||||
}
|
||||
@ -622,12 +623,12 @@ sub apply_shift($$){
|
||||
my $r0;
|
||||
my $c0;
|
||||
|
||||
($r0, $c0) = cell_index($not);
|
||||
($c0, $r0) = cell_index($not);
|
||||
|
||||
$r0 += $my_shift->[0];
|
||||
$c0 += $my_shift->[1];
|
||||
$r0 += $my_shift->[1];
|
||||
$c0 += $my_shift->[0];
|
||||
return $ERR_C_1 if $r0 > 11 or $c0 > 11 or $r0 < 1 or $c0 < 1;
|
||||
return cell_index_rev($r0, $c0);
|
||||
return cell_index_rev($c0, $r0);
|
||||
}
|
||||
|
||||
sub calc_new_cell($$){
|
||||
@ -655,8 +656,17 @@ sub calc_new_cell($$){
|
||||
return apply_shift($not, [$x_shift, $y_shift]);
|
||||
}
|
||||
|
||||
sub get_mov($$){
|
||||
my ($pi, $en) = (shift, shift);
|
||||
sub mirror_mov($){
|
||||
my $mov = shift;
|
||||
|
||||
return MoveStruct->new(
|
||||
"mov" => [$mov->{"mov"}[0] * -1, $mov->{"mov"}[1] * -1],
|
||||
"type" => $mov->{"type"}
|
||||
);
|
||||
}
|
||||
|
||||
sub get_mov($$$){
|
||||
my ($pi, $en, $apl) = (shift, shift, shift);
|
||||
|
||||
my @mv1;
|
||||
|
||||
@ -664,6 +674,13 @@ sub get_mov($$){
|
||||
($_->{"type"} & $en) != 0
|
||||
} @{$MOVE{$pi}};
|
||||
|
||||
my ($t1, $t2) = (0, 0);
|
||||
if($apl eq $P2){
|
||||
@mv1 = map {
|
||||
mirror_mov($_)
|
||||
} @mv1;
|
||||
}
|
||||
|
||||
return \@mv1;
|
||||
}
|
||||
|
||||
@ -671,9 +688,11 @@ sub find_all_mov($$){
|
||||
my ($not, $en) = (shift, shift);
|
||||
my $pi;
|
||||
my @mv1;
|
||||
my $apl;
|
||||
|
||||
$pi = cell_pi($not);
|
||||
@mv1 = @{ get_mov($pi, $en) };
|
||||
$apl = cell_pl($not);
|
||||
@mv1 = @{ get_mov($pi, $en, $apl) };
|
||||
|
||||
return grep {
|
||||
$_ if $_->[0] ne $ERR_C_1
|
||||
@ -689,9 +708,11 @@ sub shade_pi_mvmt($$){
|
||||
my ($not, $en) = (shift, shift);
|
||||
my $c1;
|
||||
my @mv1;
|
||||
|
||||
|
||||
@mv1 = find_all_mov($not, $en);
|
||||
# printf("%d\n", scalar @mv1);
|
||||
for my $mv (@mv1){
|
||||
# printf(">>%s\n", $mv->[0]);
|
||||
apply_shade($mv->[0], $mv->[1]);
|
||||
}
|
||||
}
|
||||
@ -700,21 +721,25 @@ sub shade_all_mvmt($$){
|
||||
my ($pl, $en) = (shift, shift);
|
||||
my @pi1;
|
||||
|
||||
# $pl = shift;
|
||||
|
||||
@pi1 = grep {
|
||||
cell_pl($_) eq $pl
|
||||
} keys(%board);
|
||||
|
||||
for my $el (@pi1){
|
||||
# printf("%s\n", $el);
|
||||
shade_pi_mvmt($el, $en);
|
||||
}
|
||||
# die "test 0";
|
||||
}
|
||||
|
||||
sub shade_all_p1_mvmt($){
|
||||
shade_all_mvmt($P1, $MOVBLOCK_ENUM);
|
||||
}
|
||||
|
||||
sub shade_all_p2_mvmt($){
|
||||
shade_all_mvmt($P2, $MOVBLOCK_ENUM);
|
||||
}
|
||||
|
||||
sub get_block_cell($){
|
||||
my $pl;
|
||||
|
||||
@ -731,7 +756,7 @@ sub get_block_cell($){
|
||||
|
||||
sub check_valid_card($){
|
||||
my $s1 = shift;
|
||||
die "invalid card - $s1" unless grep {
|
||||
die "invalid card/piece - $s1" unless grep {
|
||||
$_ =~ /^$s1$/i
|
||||
} @MG_PI;
|
||||
}
|
||||
@ -752,6 +777,14 @@ sub check_valid_player($){
|
||||
} keys %HAND;
|
||||
}
|
||||
|
||||
sub check_valid_piece($$){
|
||||
my ($pi, $apl) = (shift, shift);
|
||||
check_valid_card($pi);
|
||||
die "player $apl does not have $pi" unless grep {
|
||||
$pi =~ /$_$/
|
||||
} @{$HAND{$apl}};
|
||||
}
|
||||
|
||||
sub check_block($$){
|
||||
my ($s0, $apl) = (shift, shift);
|
||||
for my $c0 (get_block_cell($OPPL{$apl})){
|
||||
@ -785,6 +818,7 @@ sub summon($$$){
|
||||
$hx1 = uc $hx1;
|
||||
check_valid_cell($hx1);
|
||||
check_valid_player($apl);
|
||||
check_valid_piece($pi, $apl);
|
||||
check_block($hx1, $apl);
|
||||
$board{uc $hx1} = $apl.$DIV.$pi;
|
||||
}
|
||||
@ -802,7 +836,7 @@ sub ft_summon($$$){
|
||||
die "Must summon queen on first turn" unless $s0 =~ /$MG_Q[A-ka-k]{1,2}[0-9]{1,2}/;
|
||||
die "Max summons on first turn is $MAX_FT_SUMMON" if ( scalar (() = $s0 =~ /\*/g) > $MAX_FT_SUMMON );
|
||||
|
||||
for my $mv1 ($s0 =~ /[A-Za-z]{2,3}[0-9]{1,2}\*/g){
|
||||
for my $mv1 ($s0 =~ /\b[A-Za-z]{2,3}[0-9]{1,2}\*/g){
|
||||
sz_summon($self, $mv1, $apl);
|
||||
# printf("%s\n", $mv1);
|
||||
}
|
||||
@ -824,6 +858,12 @@ sub new {
|
||||
$AXIS_RV{$_}
|
||||
}(1...11);
|
||||
|
||||
# Both players start with a
|
||||
# queen
|
||||
push(@{$HAND{$P1}}, "Q");
|
||||
push(@{$HAND{$P2}}, "Q");
|
||||
|
||||
|
||||
return bless $self, $class;
|
||||
}
|
||||
|
||||
|
||||
15
ntvl.pl
15
ntvl.pl
@ -43,7 +43,7 @@ sub is_ft($){
|
||||
|
||||
sub ft($$$){
|
||||
my ($b, $s0, $apl) = (shift, shift, shift);
|
||||
die "invalid ft() syntax $s0" unless $s0 =~ /^([A-Za-z]{2,3}[0-9]{1,2}\*){1,}$/;
|
||||
die "invalid ft() syntax $s0" unless $s0 =~ /^([A-Za-z]{2,3}[0-9]{1,2}\*(, )?){1,}$/;
|
||||
$b->ft_summon($s0, $apl);
|
||||
}
|
||||
|
||||
@ -105,15 +105,10 @@ sub f1($$){
|
||||
my $ns0;
|
||||
|
||||
$ns0 = "";
|
||||
$ns0 .= "A I It Au N\n";
|
||||
$ns0 .= "A I Im Au H\n";
|
||||
$ns0 .= "A S Im Rc It\n";
|
||||
# $ns0 .= "Aa1*Ab1*Ac1*Ad1*Ae1*Qf1*Ag1*Ah1*Ai1*Aj1*Ak1*Ad2*Ai2*Aj2*Ak2*Ad3*\n";
|
||||
$ns0 .= "Aa1*Ab1*Ac1*Ad1*Ae1*Qf1*\n";
|
||||
|
||||
my $m1 = "c10";
|
||||
my $m2 = "b3";
|
||||
my $c1 = LPST->MG_SY;
|
||||
my $c2 = LPST->MG_A;
|
||||
$ns0 .= "Aa1*, Ab1*, Ac1*, Ad1*, Ae1*, Qf1*, Ag1*, Ah1*, Ai1*, Aj1*, Ak1*, Ad2*, Ai2*, Aj2*, Ak2*, Ad3*\n";
|
||||
$ns0 .= "Aa11*, Ab11*, Ac11*, Ad11*, Ae11*, Qf11*\n";
|
||||
|
||||
my $b;
|
||||
|
||||
@ -121,5 +116,5 @@ $b = LPST->new();
|
||||
|
||||
f1($b, $ns0);
|
||||
|
||||
$b->shade_all_p1_mvmt();
|
||||
$b->shade_all_p2_mvmt();
|
||||
$b->disp_board();
|
||||
|
||||
Loading…
Reference in New Issue
Block a user