gashapwn/lpst
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

LPST.pm - added mirror move. was a massive pain ntvl.pl updated test cases

Browse Source
This commit is contained in:
gashapwn 2021-04-11 03:00:14 +00:00
parent bf37806515
commit 74316a8618
2 changed files with 57 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
LPST.pm
View File

@ -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
@ -691,7 +710,9 @@ sub shade_pi_mvmt($$){
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
View File

@ -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();