|
@@ -393,6 +393,7 @@ sub apply_shade($$){ |
|
|
my $not = shift; |
|
|
my $not = shift; |
|
|
my $en = shift; |
|
|
my $en = shift; |
|
|
|
|
|
|
|
|
|
|
|
# $sc{$not} = $en; |
|
|
$sc{$not} = $en unless grep(/^$not$/, keys(%sc)); |
|
|
$sc{$not} = $en unless grep(/^$not$/, keys(%sc)); |
|
|
$sc{$not} = $MOVBLOCK_ENUM unless $sc{$not} == $en; |
|
|
$sc{$not} = $MOVBLOCK_ENUM unless $sc{$not} == $en; |
|
|
} |
|
|
} |
|
@@ -622,12 +623,12 @@ sub apply_shift($$){ |
|
|
my $r0; |
|
|
my $r0; |
|
|
my $c0; |
|
|
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 $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($$){ |
|
|
sub calc_new_cell($$){ |
|
@@ -655,8 +656,17 @@ sub calc_new_cell($$){ |
|
|
return apply_shift($not, [$x_shift, $y_shift]); |
|
|
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; |
|
|
my @mv1; |
|
|
|
|
|
|
|
@@ -664,6 +674,13 @@ sub get_mov($$){ |
|
|
($_->{"type"} & $en) != 0 |
|
|
($_->{"type"} & $en) != 0 |
|
|
} @{$MOVE{$pi}}; |
|
|
} @{$MOVE{$pi}}; |
|
|
|
|
|
|
|
|
|
|
|
my ($t1, $t2) = (0, 0); |
|
|
|
|
|
if($apl eq $P2){ |
|
|
|
|
|
@mv1 = map { |
|
|
|
|
|
mirror_mov($_) |
|
|
|
|
|
} @mv1; |
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
return \@mv1; |
|
|
return \@mv1; |
|
|
} |
|
|
} |
|
|
|
|
|
|
|
@@ -671,9 +688,11 @@ sub find_all_mov($$){ |
|
|
my ($not, $en) = (shift, shift); |
|
|
my ($not, $en) = (shift, shift); |
|
|
my $pi; |
|
|
my $pi; |
|
|
my @mv1; |
|
|
my @mv1; |
|
|
|
|
|
my $apl; |
|
|
|
|
|
|
|
|
$pi = cell_pi($not); |
|
|
$pi = cell_pi($not); |
|
|
@mv1 = @{ get_mov($pi, $en) }; |
|
|
|
|
|
|
|
|
$apl = cell_pl($not); |
|
|
|
|
|
@mv1 = @{ get_mov($pi, $en, $apl) }; |
|
|
|
|
|
|
|
|
return grep { |
|
|
return grep { |
|
|
$_ if $_->[0] ne $ERR_C_1 |
|
|
$_ if $_->[0] ne $ERR_C_1 |
|
@@ -689,9 +708,11 @@ sub shade_pi_mvmt($$){ |
|
|
my ($not, $en) = (shift, shift); |
|
|
my ($not, $en) = (shift, shift); |
|
|
my $c1; |
|
|
my $c1; |
|
|
my @mv1; |
|
|
my @mv1; |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
@mv1 = find_all_mov($not, $en); |
|
|
@mv1 = find_all_mov($not, $en); |
|
|
|
|
|
# printf("%d\n", scalar @mv1); |
|
|
for my $mv (@mv1){ |
|
|
for my $mv (@mv1){ |
|
|
|
|
|
# printf(">>%s\n", $mv->[0]); |
|
|
apply_shade($mv->[0], $mv->[1]); |
|
|
apply_shade($mv->[0], $mv->[1]); |
|
|
} |
|
|
} |
|
|
} |
|
|
} |
|
@@ -700,21 +721,25 @@ sub shade_all_mvmt($$){ |
|
|
my ($pl, $en) = (shift, shift); |
|
|
my ($pl, $en) = (shift, shift); |
|
|
my @pi1; |
|
|
my @pi1; |
|
|
|
|
|
|
|
|
# $pl = shift; |
|
|
|
|
|
|
|
|
|
|
|
@pi1 = grep { |
|
|
@pi1 = grep { |
|
|
cell_pl($_) eq $pl |
|
|
cell_pl($_) eq $pl |
|
|
} keys(%board); |
|
|
} keys(%board); |
|
|
|
|
|
|
|
|
for my $el (@pi1){ |
|
|
for my $el (@pi1){ |
|
|
|
|
|
# printf("%s\n", $el); |
|
|
shade_pi_mvmt($el, $en); |
|
|
shade_pi_mvmt($el, $en); |
|
|
} |
|
|
} |
|
|
|
|
|
# die "test 0"; |
|
|
} |
|
|
} |
|
|
|
|
|
|
|
|
sub shade_all_p1_mvmt($){ |
|
|
sub shade_all_p1_mvmt($){ |
|
|
shade_all_mvmt($P1, $MOVBLOCK_ENUM); |
|
|
shade_all_mvmt($P1, $MOVBLOCK_ENUM); |
|
|
} |
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
sub shade_all_p2_mvmt($){ |
|
|
|
|
|
shade_all_mvmt($P2, $MOVBLOCK_ENUM); |
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
sub get_block_cell($){ |
|
|
sub get_block_cell($){ |
|
|
my $pl; |
|
|
my $pl; |
|
|
|
|
|
|
|
@@ -731,7 +756,7 @@ sub get_block_cell($){ |
|
|
|
|
|
|
|
|
sub check_valid_card($){ |
|
|
sub check_valid_card($){ |
|
|
my $s1 = shift; |
|
|
my $s1 = shift; |
|
|
die "invalid card - $s1" unless grep { |
|
|
|
|
|
|
|
|
die "invalid card/piece - $s1" unless grep { |
|
|
$_ =~ /^$s1$/i |
|
|
$_ =~ /^$s1$/i |
|
|
} @MG_PI; |
|
|
} @MG_PI; |
|
|
} |
|
|
} |
|
@@ -752,6 +777,14 @@ sub check_valid_player($){ |
|
|
} keys %HAND; |
|
|
} 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($$){ |
|
|
sub check_block($$){ |
|
|
my ($s0, $apl) = (shift, shift); |
|
|
my ($s0, $apl) = (shift, shift); |
|
|
for my $c0 (get_block_cell($OPPL{$apl})){ |
|
|
for my $c0 (get_block_cell($OPPL{$apl})){ |
|
@@ -785,6 +818,7 @@ sub summon($$$){ |
|
|
$hx1 = uc $hx1; |
|
|
$hx1 = uc $hx1; |
|
|
check_valid_cell($hx1); |
|
|
check_valid_cell($hx1); |
|
|
check_valid_player($apl); |
|
|
check_valid_player($apl); |
|
|
|
|
|
check_valid_piece($pi, $apl); |
|
|
check_block($hx1, $apl); |
|
|
check_block($hx1, $apl); |
|
|
$board{uc $hx1} = $apl.$DIV.$pi; |
|
|
$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 "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 ); |
|
|
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); |
|
|
sz_summon($self, $mv1, $apl); |
|
|
# printf("%s\n", $mv1); |
|
|
# printf("%s\n", $mv1); |
|
|
} |
|
|
} |
|
@@ -824,6 +858,12 @@ sub new { |
|
|
$AXIS_RV{$_} |
|
|
$AXIS_RV{$_} |
|
|
}(1...11); |
|
|
}(1...11); |
|
|
|
|
|
|
|
|
|
|
|
# Both players start with a |
|
|
|
|
|
# queen |
|
|
|
|
|
push(@{$HAND{$P1}}, "Q"); |
|
|
|
|
|
push(@{$HAND{$P2}}, "Q"); |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
return bless $self, $class; |
|
|
return bless $self, $class; |
|
|
} |
|
|
} |
|
|
|
|
|
|
|
|