LPST/MNU - refactored a bunch of functions into methods to fix stupid shading bug test.pl - updated test cases
This commit is contained in:
gashapwn
parent
42c9b7e56c
commit
b3ee9aa4c8
242
LPST.pm
242
LPST.pm
@ -356,15 +356,13 @@ my %MOVE = (
|
||||
]
|
||||
);
|
||||
|
||||
|
||||
my %sc = ();
|
||||
my %board;
|
||||
|
||||
# Display pieces
|
||||
#==================================================
|
||||
|
||||
sub get_pi_str($){
|
||||
my $p = shift;
|
||||
my ($p) = (shift);
|
||||
$p =~ s/($P1|$P2)$DIV//;
|
||||
$p .= "_" if length($p) < 2;
|
||||
return $p;
|
||||
@ -391,18 +389,16 @@ sub sub_pi_str($$$){
|
||||
# Display shade
|
||||
#==================================================
|
||||
|
||||
sub apply_shade($$){
|
||||
my $not = shift;
|
||||
my $en = shift;
|
||||
sub apply_shade($$$){
|
||||
my ($self, $not, $en) = (shift, shift, shift);
|
||||
|
||||
# $sc{$not} = $en;
|
||||
$sc{$not} = $en unless grep(/^$not$/, keys(%sc));
|
||||
$sc{$not} = $MOVBLOCK_ENUM unless $sc{$not} == $en;
|
||||
$self->{"sc"}{$not} = $en unless grep(/^$not$/, keys( %{$self->{"sc"}} ));
|
||||
$self->{"sc"}{$not} = $MOVBLOCK_ENUM unless $self->{"sc"}{$not} == $en;
|
||||
}
|
||||
|
||||
sub get_shade_en($){
|
||||
my $not = shift;
|
||||
return $sc{$not} if (grep /^$not$/, keys(%sc));
|
||||
sub get_shade_en($$){
|
||||
my ($self, $not) = (shift, shift);
|
||||
return $self->{"sc"}{$not} if (grep /^$not$/, keys( %{$self->{"sc"}} ));
|
||||
return $EMPTY_ENUM;
|
||||
}
|
||||
|
||||
@ -411,12 +407,12 @@ sub get_shade_hex($){
|
||||
return $SHADE{$en};
|
||||
}
|
||||
|
||||
sub get_cell_shade($$){
|
||||
my ($r0, $c0) = (shift, shift);
|
||||
sub get_cell_shade($$$){
|
||||
my ($self, $r0, $c0) = (shift, shift, shift);
|
||||
my $not;
|
||||
|
||||
$not = cell_index_rev($c0, $r0);
|
||||
return get_shade_hex(get_shade_en($not));
|
||||
return get_shade_hex($self->get_shade_en($not));
|
||||
}
|
||||
|
||||
|
||||
@ -425,34 +421,34 @@ sub get_cell_shade($$){
|
||||
# Display lines
|
||||
#==================================================
|
||||
|
||||
sub disp_1($$){
|
||||
my ($r0, $c0) = (shift, shift);
|
||||
sub disp_1($$$){
|
||||
my ($self, $r0, $c0) = (shift, shift, shift);
|
||||
my $hex;
|
||||
|
||||
$hex = get_cell_shade($r0, $c0)->[0];
|
||||
$hex = $self->get_cell_shade($r0, $c0)->[0];
|
||||
|
||||
return $hex;
|
||||
}
|
||||
|
||||
sub disp_2($$){
|
||||
my ($r0, $c0) = (shift, shift);
|
||||
sub disp_2($$$){
|
||||
my ($self, $r0, $c0) = (shift, shift, shift);
|
||||
my $p;
|
||||
my $not;
|
||||
my $hex;
|
||||
|
||||
$hex = get_cell_shade($r0, $c0)->[1];
|
||||
$hex = $self->get_cell_shade($r0, $c0)->[1];
|
||||
$not = cell_index_rev($c0, $r0);
|
||||
|
||||
$p = $board{$not};
|
||||
$p = $self->{"board"}{$not};
|
||||
|
||||
return sub_pi_str($p, $c0, $hex);
|
||||
}
|
||||
|
||||
sub disp_3($$){
|
||||
my ($r0, $c0) = (shift, shift);
|
||||
sub disp_3($$$){
|
||||
my ($self, $r0, $c0) = (shift, shift, shift);
|
||||
my $hex;
|
||||
|
||||
$hex = get_cell_shade($r0, $c0)->[2];
|
||||
$hex = $self->get_cell_shade($r0, $c0)->[2];
|
||||
|
||||
return $hex;
|
||||
}
|
||||
@ -474,29 +470,27 @@ sub disp_y_axis($$$$){
|
||||
# Display cell
|
||||
#==================================================
|
||||
|
||||
sub add_cell($$$$$){
|
||||
my ($s0, $s1, $s2, $r0, $c0) = @_;
|
||||
sub add_cell($$$$$$){
|
||||
my ($self, $s0, $s1, $s2, $r0, $c0) = @_;
|
||||
|
||||
$s0 .= disp_1($r0, $c0);
|
||||
$s1 .= disp_2($r0, $c0);
|
||||
$s2 .= disp_3($r0, $c0);
|
||||
$s0 .= $self->disp_1($r0, $c0);
|
||||
$s1 .= $self->disp_2($r0, $c0);
|
||||
$s2 .= $self->disp_3($r0, $c0);
|
||||
|
||||
return ($s0, $s1, $s2);
|
||||
}
|
||||
|
||||
sub disp_0($){
|
||||
my $r0;
|
||||
my ($self, $r0) = (shift, shift);
|
||||
|
||||
my ($s0, $s1, $s2);
|
||||
|
||||
$r0 = shift;
|
||||
|
||||
# Append the y axis
|
||||
($s0, $s1, $s2) = disp_y_axis($s0, $s1, $s2, $r0);
|
||||
|
||||
# Iterate through the cells
|
||||
for my $i (1..11){
|
||||
($s0, $s1, $s2) = add_cell($s0, $s1, $s2, $r0, $i);
|
||||
($s0, $s1, $s2) = $self->add_cell($s0, $s1, $s2, $r0, $i);
|
||||
}
|
||||
|
||||
return $s0."\n".$s1."\n".$s2."\n";
|
||||
@ -505,13 +499,13 @@ sub disp_0($){
|
||||
# Display row
|
||||
#==================================================
|
||||
|
||||
sub disp_row($){
|
||||
sub disp_row($$){
|
||||
my $row;
|
||||
my $r0;
|
||||
my ($self, $r0) = (shift, shift);
|
||||
|
||||
$r0 = shift;
|
||||
# $r0 = shift;
|
||||
|
||||
$row = disp_0($r0);
|
||||
$row = $self->disp_0($r0);
|
||||
|
||||
# Handle trailing characters
|
||||
if($r0 % 2 == 1){
|
||||
@ -574,11 +568,12 @@ sub disp_x_axis(){
|
||||
# Display board
|
||||
#==================================================
|
||||
|
||||
sub disp_board(){
|
||||
sub disp_board($){
|
||||
my $self = shift;
|
||||
my $b;
|
||||
|
||||
for my $i (map {11-$_+1} (1..11)) {
|
||||
$b .= disp_row($i);
|
||||
$b .= $self->disp_row($i);
|
||||
}
|
||||
$b .= disp_trailing_row();
|
||||
$b .= disp_x_axis();
|
||||
@ -595,19 +590,19 @@ sub disp_board(){
|
||||
|
||||
# Caclulate movement
|
||||
#==================================================
|
||||
sub pi_split($$){
|
||||
my ($not, $i0) = (shift, shift);
|
||||
return (split(/$DIV/, $board{$not}))[$i0];
|
||||
sub pi_split($$$){
|
||||
my ($self, $not, $i0) = (shift, shift, shift);
|
||||
return (split(/$DIV/, $self->{"board"}{$not}))[$i0];
|
||||
}
|
||||
|
||||
sub cell_pi($){
|
||||
my $not = shift;
|
||||
return pi_split($not, 1);
|
||||
sub cell_pi($$){
|
||||
my ($self, $not) = (shift, shift);
|
||||
return $self->pi_split($not, 1);
|
||||
}
|
||||
|
||||
sub cell_pl($){
|
||||
my $not = shift;
|
||||
return pi_split($not, 0);
|
||||
sub cell_pl($$){
|
||||
my ($self, $not) = (shift, shift);
|
||||
return $self->pi_split($not, 0);
|
||||
}
|
||||
|
||||
sub cell_index_rev($$){
|
||||
@ -686,14 +681,14 @@ sub get_mov($$$){
|
||||
return \@mv1;
|
||||
}
|
||||
|
||||
sub find_all_mov($$){
|
||||
my ($not, $en) = (shift, shift);
|
||||
sub find_all_mov($$$){
|
||||
my ($self, $not, $en) = (shift, shift, shift);
|
||||
my $pi;
|
||||
my @mv1;
|
||||
my $apl;
|
||||
|
||||
$pi = cell_pi($not);
|
||||
$apl = cell_pl($not);
|
||||
$pi = $self->cell_pi($not);
|
||||
$apl = $self->cell_pl($not);
|
||||
@mv1 = @{ get_mov($pi, $en, $apl) };
|
||||
|
||||
return grep {
|
||||
@ -706,136 +701,136 @@ sub find_all_mov($$){
|
||||
} @mv1;
|
||||
}
|
||||
|
||||
sub shade_pi_mvmt($$){
|
||||
my ($not, $en) = (shift, shift);
|
||||
sub shade_pi_mvmt($$$){
|
||||
my ($self, $not, $en) = (shift, shift, shift);
|
||||
my $c1;
|
||||
my @mv1;
|
||||
|
||||
@mv1 = find_all_mov($not, $en);
|
||||
@mv1 = $self->find_all_mov($not, $en);
|
||||
for my $mv (@mv1){
|
||||
apply_shade($mv->[0], $mv->[1]);
|
||||
$self->apply_shade($mv->[0], $mv->[1]);
|
||||
}
|
||||
}
|
||||
|
||||
sub shade_all_mvmt($$){
|
||||
my ($pl, $en) = (shift, shift);
|
||||
sub shade_all_mvmt($$$){
|
||||
my ($self, $pl, $en) = (shift, shift, shift);
|
||||
my @pi1;
|
||||
|
||||
@pi1 = grep {
|
||||
cell_pl($_) eq $pl
|
||||
} keys(%board);
|
||||
$self->cell_pl($_) eq $pl
|
||||
} keys(%{$self->{"board"}});
|
||||
|
||||
for my $el (@pi1){
|
||||
shade_pi_mvmt($el, $en);
|
||||
$self->shade_pi_mvmt($el, $en);
|
||||
}
|
||||
# die "test 0";
|
||||
}
|
||||
|
||||
sub shade_all_p1_mvmt($){
|
||||
shade_all_mvmt($P1, $MOVBLOCK_ENUM);
|
||||
my $self = shift;
|
||||
$self->shade_all_mvmt($P1, $MOVBLOCK_ENUM);
|
||||
}
|
||||
|
||||
sub shade_all_p2_mvmt($){
|
||||
shade_all_mvmt($P2, $MOVBLOCK_ENUM);
|
||||
my $self = shift;
|
||||
$self->shade_all_mvmt($P2, $MOVBLOCK_ENUM);
|
||||
}
|
||||
|
||||
sub get_block_cell($){
|
||||
my $pl;
|
||||
|
||||
$pl = shift;
|
||||
sub get_block_cell($$){
|
||||
my ($self, $pl) = (shift, shift);
|
||||
|
||||
return map {
|
||||
$_->[0]
|
||||
} map {
|
||||
( find_all_mov($_, $BLOCK_ENUM) );
|
||||
( $self->find_all_mov($_, $BLOCK_ENUM) );
|
||||
} grep {
|
||||
cell_pl($_) eq $pl
|
||||
} keys(%board);
|
||||
$self->cell_pl($_) eq $pl
|
||||
} keys(%{$self->{"board"}});
|
||||
}
|
||||
|
||||
sub check_valid_card($){
|
||||
my $s1 = shift;
|
||||
sub check_valid_card($$){
|
||||
my ($self, $s1) = (shift, shift);
|
||||
die "invalid card/piece - $s1" unless grep {
|
||||
$_ =~ /^$s1$/i
|
||||
} @MG_PI;
|
||||
}
|
||||
|
||||
sub check_empty_cell($){
|
||||
my $hx1 = shift;
|
||||
sub check_empty_cell($$){
|
||||
my ($self, $hx1) = (shift, shift);
|
||||
$hx1 = uc $hx1;
|
||||
|
||||
check_valid_cell($hx1);
|
||||
die "piece in cell $hx1" if $board{$hx1} ne $EMPTY_CELL;
|
||||
$self->check_valid_cell($hx1);
|
||||
die "piece in cell $hx1" if $self->{"board"}{$hx1} ne $EMPTY_CELL;
|
||||
}
|
||||
|
||||
sub check_nonempty_cell($){
|
||||
my $hx1 = shift;
|
||||
sub check_nonempty_cell($$){
|
||||
my ($self, $hx1) = (shift, shift);
|
||||
$hx1 = uc $hx1;
|
||||
|
||||
check_valid_cell($hx1);
|
||||
die "no piece in cell $hx1" if $board{$hx1} eq $EMPTY_CELL;
|
||||
$self->check_valid_cell($hx1);
|
||||
die "no piece in cell $hx1" if $self->{"board"}{$hx1} eq $EMPTY_CELL;
|
||||
}
|
||||
|
||||
sub check_valid_cell($){
|
||||
my $hx1 = shift;
|
||||
sub check_valid_cell($$){
|
||||
my ($self, $hx1) = (shift, shift);
|
||||
$hx1 = uc $hx1;
|
||||
|
||||
die "invalid cell - $hx1" unless grep {
|
||||
$hx1 =~ /^$_$/i
|
||||
} keys %board;
|
||||
} keys %{$self->{"board"}};
|
||||
# } keys %board;
|
||||
}
|
||||
|
||||
sub check_src_cell($$){
|
||||
my ($hx1, $apl) = (shift, shift);
|
||||
sub check_src_cell($$$){
|
||||
my ($self, $hx1, $apl) = (shift, shift, shift);
|
||||
$hx1 = uc $hx1;
|
||||
|
||||
check_nonempty_cell($hx1);
|
||||
die "This cell is not owned by $apl" if cell_pl($hx1) ne $apl;
|
||||
$self->check_nonempty_cell($hx1);
|
||||
die "This cell is not owned by $apl" if $self->cell_pl($hx1) ne $apl;
|
||||
}
|
||||
|
||||
sub check_valid_player($){
|
||||
my $apl = shift;
|
||||
sub check_valid_player($$){
|
||||
my ($self, $apl) = (shift, shift);
|
||||
die "invalid player - $apl" unless grep {
|
||||
$apl =~ /^$_$/
|
||||
} keys %HAND;
|
||||
}
|
||||
|
||||
sub check_valid_piece($$){
|
||||
my ($pi, $apl) = (shift, shift);
|
||||
check_valid_card($pi);
|
||||
sub check_valid_piece($$$){
|
||||
my ($self, $pi, $apl) = (shift, shift, shift);
|
||||
$self->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})){
|
||||
sub check_block($$$){
|
||||
my ($self, $s0, $apl) = (shift, shift, shift);
|
||||
for my $c0 ($self->get_block_cell($OPPL{$apl})){
|
||||
die "summon to cell $s0 is blocked" if $s0 eq $c0;
|
||||
}
|
||||
}
|
||||
|
||||
sub check_valid_mov($$){
|
||||
my ($src, $dst) = (shift, shift);
|
||||
sub check_valid_mov($$$){
|
||||
my ($self, $src, $dst) = (shift, shift, shift);
|
||||
$src = uc $src;
|
||||
die "not valid move" unless grep {$dst eq $_->[0]} find_all_mov($src, $MOVE_ENUM);
|
||||
die "not valid move" unless grep {$dst eq $_->[0]} $self->find_all_mov($src, $MOVE_ENUM);
|
||||
}
|
||||
|
||||
sub check_sz($$){
|
||||
my ($hx1, $apl) = (shift, shift);
|
||||
sub check_sz($$$){
|
||||
my ($self, $hx1, $apl) = (shift, shift, shift);
|
||||
my ($c0, $r0) = cell_index($hx1);
|
||||
|
||||
die "$hx1 not in start zone" if($r0 > 3 && $apl eq $P1);
|
||||
die "$hx1 not in start zone" if($r0 < 8 && $apl eq $P2);
|
||||
}
|
||||
|
||||
sub draw($$){
|
||||
sub draw($$$){
|
||||
my ($self, $s0, $apl) = (shift, shift, shift);
|
||||
|
||||
my $i = 0;
|
||||
for my $s1 (uniq( [split(/ /, $s0)] )){
|
||||
$i++;
|
||||
check_valid_card($s1);
|
||||
$self->check_valid_card($s1);
|
||||
push(@{$HAND{$apl}}, $s1);
|
||||
}
|
||||
die "draw() $s0 - hand size less than $HAND_SIZE. Possible duplicate card?" if $i < $HAND_SIZE;
|
||||
@ -845,19 +840,19 @@ sub summon($$$){
|
||||
my ($self, $s0, $apl) = (shift, shift, shift);
|
||||
my ($pi, $hx1) = $s0 =~ /([A-Za-z]{1,2})([A-Za-z][0-9]{1,})/;
|
||||
$hx1 = uc $hx1;
|
||||
check_empty_cell($hx1);
|
||||
check_valid_player($apl);
|
||||
check_valid_piece($pi, $apl);
|
||||
check_block($hx1, $apl);
|
||||
$board{uc $hx1} = $apl.$DIV.$pi;
|
||||
$self->check_empty_cell($hx1);
|
||||
$self->check_valid_player($apl);
|
||||
$self->check_valid_piece($pi, $apl);
|
||||
$self->check_block($hx1, $apl);
|
||||
$self->{"board"}{uc $hx1} = $apl.$DIV.$pi;
|
||||
}
|
||||
|
||||
sub sz_summon($$$){
|
||||
my ($self, $s0, $apl) = (shift, shift, shift);
|
||||
my ($pi, $hx1) = $s0 =~ /([A-Za-z]{1,2})([A-Za-z][0-9]{1,})/;
|
||||
$hx1 = uc $hx1;
|
||||
check_sz($hx1, $apl);
|
||||
summon($self, $s0, $apl);
|
||||
$self->check_sz($hx1, $apl);
|
||||
$self->summon($s0, $apl);
|
||||
}
|
||||
|
||||
sub ft_summon($$$){
|
||||
@ -866,7 +861,7 @@ sub ft_summon($$$){
|
||||
die "Max summons on first turn is $MAX_FT_SUMMON" if ( scalar (() = $s0 =~ /\*/g) > $MAX_FT_SUMMON );
|
||||
|
||||
for my $mv1 ($s0 =~ /\b[A-Za-z]{2,3}[0-9]{1,2}\*/g){
|
||||
sz_summon($self, $mv1, $apl);
|
||||
$self->sz_summon($mv1, $apl);
|
||||
}
|
||||
}
|
||||
|
||||
@ -875,18 +870,27 @@ sub mov($$$){
|
||||
my ($src, $dst) = $s0 =~ /([A-Za-z][0-9]{1,2})([A-Za-z][0-9]{1,2})$/;
|
||||
$src = uc $src;
|
||||
$dst = uc $dst;
|
||||
check_valid_player($apl);
|
||||
check_src_cell($src, $apl);
|
||||
check_empty_cell($dst);
|
||||
check_valid_mov($src, $dst);
|
||||
$board{$dst} = cell_pl($src).$DIV.cell_pi($src);
|
||||
$board{$src} = $EMPTY_CELL;
|
||||
$self->check_valid_player($apl);
|
||||
$self->check_src_cell($src, $apl);
|
||||
$self->check_empty_cell($dst);
|
||||
$self->check_valid_mov($src, $dst);
|
||||
$self->{"board"}{$dst} = $self->cell_pl($src).$DIV.$self->cell_pi($src);
|
||||
$self->{"board"}{$src} = $EMPTY_CELL;
|
||||
}
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $self = { @_ };
|
||||
|
||||
$self->{"board"} = { map {
|
||||
$_ => $EMPTY_CELL
|
||||
} map {
|
||||
my $l0;
|
||||
$l0 = $_;
|
||||
(map {$l0.$_} ("1".."11"))
|
||||
} map {
|
||||
$AXIS_RV{$_}
|
||||
}(1...11) };
|
||||
# Creates a hash of the the form
|
||||
# $board{cell_notation} = piece_enum
|
||||
%board = map {
|
||||
@ -899,6 +903,8 @@ sub new {
|
||||
$AXIS_RV{$_}
|
||||
}(1...11);
|
||||
|
||||
$self->{"sc"} = {};
|
||||
|
||||
# Both players start with a
|
||||
# queen
|
||||
push(@{$HAND{$P1}}, "Q");
|
||||
|
||||
2
MNU.pm
2
MNU.pm
@ -29,7 +29,7 @@ sub eval_game_str($$){
|
||||
my ($b, $game_str) = (shift, shift);
|
||||
try {
|
||||
NTVL->f1($b, $game_str);
|
||||
disp_board($b);
|
||||
$b->disp_board();
|
||||
} catch {
|
||||
warn "invalid move: $_";
|
||||
$game_str = roll_back($game_str);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user