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

LPST/MNU - refactored a bunch of functions into methods to fix stupid shading bug test.pl - updated test cases

Browse Source
This commit is contained in:
gashapwn 2021-04-19 00:02:52 +00:00
parent 42c9b7e56c
commit b3ee9aa4c8
3 changed files with 127 additions and 119 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

242
LPST.pm
View File

@ -356,15 +356,13 @@ my %MOVE = (
] ]
); );
my %sc = ();
my %board; my %board;
# Display pieces # Display pieces
#================================================== #==================================================
sub get_pi_str($){ sub get_pi_str($){
my $p = shift; my ($p) = (shift);
$p =~ s/($P1|$P2)$DIV//; $p =~ s/($P1|$P2)$DIV//;
$p .= "_" if length($p) < 2; $p .= "_" if length($p) < 2;
return $p; return $p;
@ -391,18 +389,16 @@ sub sub_pi_str($$$){
# Display shade # Display shade
#================================================== #==================================================
sub apply_shade($$){ sub apply_shade($$$){
my $not = shift; my ($self, $not, $en) = (shift, shift, shift);
my $en = shift;
# $sc{$not} = $en; $self->{"sc"}{$not} = $en unless grep(/^$not$/, keys( %{$self->{"sc"}} ));
$sc{$not} = $en unless grep(/^$not$/, keys(%sc)); $self->{"sc"}{$not} = $MOVBLOCK_ENUM unless $self->{"sc"}{$not} == $en;
$sc{$not} = $MOVBLOCK_ENUM unless $sc{$not} == $en;
} }
sub get_shade_en($){ sub get_shade_en($$){
my $not = shift; my ($self, $not) = (shift, shift);
return $sc{$not} if (grep /^$not$/, keys(%sc)); return $self->{"sc"}{$not} if (grep /^$not$/, keys( %{$self->{"sc"}} ));
return $EMPTY_ENUM; return $EMPTY_ENUM;
} }
@ -411,12 +407,12 @@ sub get_shade_hex($){
return $SHADE{$en}; return $SHADE{$en};
} }
sub get_cell_shade($$){ sub get_cell_shade($$$){
my ($r0, $c0) = (shift, shift); my ($self, $r0, $c0) = (shift, shift, shift);
my $not; my $not;
$not = cell_index_rev($c0, $r0); $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 # Display lines
#================================================== #==================================================
sub disp_1($$){ sub disp_1($$$){
my ($r0, $c0) = (shift, shift); my ($self, $r0, $c0) = (shift, shift, shift);
my $hex; my $hex;
$hex = get_cell_shade($r0, $c0)->[0]; $hex = $self->get_cell_shade($r0, $c0)->[0];
return $hex; return $hex;
} }
sub disp_2($$){ sub disp_2($$$){
my ($r0, $c0) = (shift, shift); my ($self, $r0, $c0) = (shift, shift, shift);
my $p; my $p;
my $not; my $not;
my $hex; my $hex;
$hex = get_cell_shade($r0, $c0)->[1]; $hex = $self->get_cell_shade($r0, $c0)->[1];
$not = cell_index_rev($c0, $r0); $not = cell_index_rev($c0, $r0);
$p = $board{$not}; $p = $self->{"board"}{$not};
return sub_pi_str($p, $c0, $hex); return sub_pi_str($p, $c0, $hex);
} }
sub disp_3($$){ sub disp_3($$$){
my ($r0, $c0) = (shift, shift); my ($self, $r0, $c0) = (shift, shift, shift);
my $hex; my $hex;
$hex = get_cell_shade($r0, $c0)->[2]; $hex = $self->get_cell_shade($r0, $c0)->[2];
return $hex; return $hex;
} }
@ -474,29 +470,27 @@ sub disp_y_axis($$$$){
# Display cell # Display cell
#================================================== #==================================================
sub add_cell($$$$$){ sub add_cell($$$$$$){
my ($s0, $s1, $s2, $r0, $c0) = @_; my ($self, $s0, $s1, $s2, $r0, $c0) = @_;
$s0 .= disp_1($r0, $c0); $s0 .= $self->disp_1($r0, $c0);
$s1 .= disp_2($r0, $c0); $s1 .= $self->disp_2($r0, $c0);
$s2 .= disp_3($r0, $c0); $s2 .= $self->disp_3($r0, $c0);
return ($s0, $s1, $s2); return ($s0, $s1, $s2);
} }
sub disp_0($){ sub disp_0($){
my $r0; my ($self, $r0) = (shift, shift);
my ($s0, $s1, $s2); my ($s0, $s1, $s2);
$r0 = shift;
# Append the y axis # Append the y axis
($s0, $s1, $s2) = disp_y_axis($s0, $s1, $s2, $r0); ($s0, $s1, $s2) = disp_y_axis($s0, $s1, $s2, $r0);
# Iterate through the cells # Iterate through the cells
for my $i (1..11){ 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"; return $s0."\n".$s1."\n".$s2."\n";
@ -505,13 +499,13 @@ sub disp_0($){
# Display row # Display row
#================================================== #==================================================
sub disp_row($){ sub disp_row($$){
my $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 # Handle trailing characters
if($r0 % 2 == 1){ if($r0 % 2 == 1){
@ -574,11 +568,12 @@ sub disp_x_axis(){
# Display board # Display board
#================================================== #==================================================
sub disp_board(){ sub disp_board($){
my $self = shift;
my $b; my $b;
for my $i (map {11-$_+1} (1..11)) { for my $i (map {11-$_+1} (1..11)) {
$b .= disp_row($i); $b .= $self->disp_row($i);
} }
$b .= disp_trailing_row(); $b .= disp_trailing_row();
$b .= disp_x_axis(); $b .= disp_x_axis();
@ -595,19 +590,19 @@ sub disp_board(){
# Caclulate movement # Caclulate movement
#================================================== #==================================================
sub pi_split($$){ sub pi_split($$$){
my ($not, $i0) = (shift, shift); my ($self, $not, $i0) = (shift, shift, shift);
return (split(/$DIV/, $board{$not}))[$i0]; return (split(/$DIV/, $self->{"board"}{$not}))[$i0];
} }
sub cell_pi($){ sub cell_pi($$){
my $not = shift; my ($self, $not) = (shift, shift);
return pi_split($not, 1); return $self->pi_split($not, 1);
} }
sub cell_pl($){ sub cell_pl($$){
my $not = shift; my ($self, $not) = (shift, shift);
return pi_split($not, 0); return $self->pi_split($not, 0);
} }
sub cell_index_rev($$){ sub cell_index_rev($$){
@ -686,14 +681,14 @@ sub get_mov($$$){
return \@mv1; return \@mv1;
} }
sub find_all_mov($$){ sub find_all_mov($$$){
my ($not, $en) = (shift, shift); my ($self, $not, $en) = (shift, shift, shift);
my $pi; my $pi;
my @mv1; my @mv1;
my $apl; my $apl;
$pi = cell_pi($not); $pi = $self->cell_pi($not);
$apl = cell_pl($not); $apl = $self->cell_pl($not);
@mv1 = @{ get_mov($pi, $en, $apl) }; @mv1 = @{ get_mov($pi, $en, $apl) };
return grep { return grep {
@ -706,136 +701,136 @@ sub find_all_mov($$){
} @mv1; } @mv1;
} }
sub shade_pi_mvmt($$){ sub shade_pi_mvmt($$$){
my ($not, $en) = (shift, shift); my ($self, $not, $en) = (shift, shift, shift);
my $c1; my $c1;
my @mv1; my @mv1;
@mv1 = find_all_mov($not, $en); @mv1 = $self->find_all_mov($not, $en);
for my $mv (@mv1){ for my $mv (@mv1){
apply_shade($mv->[0], $mv->[1]); $self->apply_shade($mv->[0], $mv->[1]);
} }
} }
sub shade_all_mvmt($$){ sub shade_all_mvmt($$$){
my ($pl, $en) = (shift, shift); my ($self, $pl, $en) = (shift, shift, shift);
my @pi1; my @pi1;
@pi1 = grep { @pi1 = grep {
cell_pl($_) eq $pl $self->cell_pl($_) eq $pl
} keys(%board); } keys(%{$self->{"board"}});
for my $el (@pi1){ for my $el (@pi1){
shade_pi_mvmt($el, $en); $self->shade_pi_mvmt($el, $en);
} }
# die "test 0";
} }
sub shade_all_p1_mvmt($){ 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($){ 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($){ sub get_block_cell($$){
my $pl; my ($self, $pl) = (shift, shift);
$pl = shift;
return map { return map {
$_->[0] $_->[0]
} map { } map {
( find_all_mov($_, $BLOCK_ENUM) ); ( $self->find_all_mov($_, $BLOCK_ENUM) );
} grep { } grep {
cell_pl($_) eq $pl $self->cell_pl($_) eq $pl
} keys(%board); } keys(%{$self->{"board"}});
} }
sub check_valid_card($){ sub check_valid_card($$){
my $s1 = shift; my ($self, $s1) = (shift, shift);
die "invalid card/piece - $s1" unless grep { die "invalid card/piece - $s1" unless grep {
$_ =~ /^$s1$/i $_ =~ /^$s1$/i
} @MG_PI; } @MG_PI;
} }
sub check_empty_cell($){ sub check_empty_cell($$){
my $hx1 = shift; my ($self, $hx1) = (shift, shift);
$hx1 = uc $hx1; $hx1 = uc $hx1;
check_valid_cell($hx1); $self->check_valid_cell($hx1);
die "piece in cell $hx1" if $board{$hx1} ne $EMPTY_CELL; die "piece in cell $hx1" if $self->{"board"}{$hx1} ne $EMPTY_CELL;
} }
sub check_nonempty_cell($){ sub check_nonempty_cell($$){
my $hx1 = shift; my ($self, $hx1) = (shift, shift);
$hx1 = uc $hx1; $hx1 = uc $hx1;
check_valid_cell($hx1); $self->check_valid_cell($hx1);
die "no piece in cell $hx1" if $board{$hx1} eq $EMPTY_CELL; die "no piece in cell $hx1" if $self->{"board"}{$hx1} eq $EMPTY_CELL;
} }
sub check_valid_cell($){ sub check_valid_cell($$){
my $hx1 = shift; my ($self, $hx1) = (shift, shift);
$hx1 = uc $hx1; $hx1 = uc $hx1;
die "invalid cell - $hx1" unless grep { die "invalid cell - $hx1" unless grep {
$hx1 =~ /^$_$/i $hx1 =~ /^$_$/i
} keys %board; } keys %{$self->{"board"}};
# } keys %board;
} }
sub check_src_cell($$){ sub check_src_cell($$$){
my ($hx1, $apl) = (shift, shift); my ($self, $hx1, $apl) = (shift, shift, shift);
$hx1 = uc $hx1; $hx1 = uc $hx1;
check_nonempty_cell($hx1); $self->check_nonempty_cell($hx1);
die "This cell is not owned by $apl" if cell_pl($hx1) ne $apl; die "This cell is not owned by $apl" if $self->cell_pl($hx1) ne $apl;
} }
sub check_valid_player($){ sub check_valid_player($$){
my $apl = shift; my ($self, $apl) = (shift, shift);
die "invalid player - $apl" unless grep { die "invalid player - $apl" unless grep {
$apl =~ /^$_$/ $apl =~ /^$_$/
} keys %HAND; } keys %HAND;
} }
sub check_valid_piece($$){ sub check_valid_piece($$$){
my ($pi, $apl) = (shift, shift); my ($self, $pi, $apl) = (shift, shift, shift);
check_valid_card($pi); $self->check_valid_card($pi);
die "player $apl does not have $pi" unless grep { die "player $apl does not have $pi" unless grep {
$pi =~ /$_$/ $pi =~ /$_$/
} @{$HAND{$apl}}; } @{$HAND{$apl}};
} }
sub check_block($$){ sub check_block($$$){
my ($s0, $apl) = (shift, shift); my ($self, $s0, $apl) = (shift, shift, shift);
for my $c0 (get_block_cell($OPPL{$apl})){ for my $c0 ($self->get_block_cell($OPPL{$apl})){
die "summon to cell $s0 is blocked" if $s0 eq $c0; die "summon to cell $s0 is blocked" if $s0 eq $c0;
} }
} }
sub check_valid_mov($$){ sub check_valid_mov($$$){
my ($src, $dst) = (shift, shift); my ($self, $src, $dst) = (shift, shift, shift);
$src = uc $src; $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($$){ sub check_sz($$$){
my ($hx1, $apl) = (shift, shift); my ($self, $hx1, $apl) = (shift, shift, shift);
my ($c0, $r0) = cell_index($hx1); 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 > 3 && $apl eq $P1);
die "$hx1 not in start zone" if($r0 < 8 && $apl eq $P2); die "$hx1 not in start zone" if($r0 < 8 && $apl eq $P2);
} }
sub draw($$){ sub draw($$$){
my ($self, $s0, $apl) = (shift, shift, shift); my ($self, $s0, $apl) = (shift, shift, shift);
my $i = 0; my $i = 0;
for my $s1 (uniq( [split(/ /, $s0)] )){ for my $s1 (uniq( [split(/ /, $s0)] )){
$i++; $i++;
check_valid_card($s1); $self->check_valid_card($s1);
push(@{$HAND{$apl}}, $s1); push(@{$HAND{$apl}}, $s1);
} }
die "draw() $s0 - hand size less than $HAND_SIZE. Possible duplicate card?" if $i < $HAND_SIZE; 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 ($self, $s0, $apl) = (shift, shift, shift);
my ($pi, $hx1) = $s0 =~ /([A-Za-z]{1,2})([A-Za-z][0-9]{1,})/; my ($pi, $hx1) = $s0 =~ /([A-Za-z]{1,2})([A-Za-z][0-9]{1,})/;
$hx1 = uc $hx1; $hx1 = uc $hx1;
check_empty_cell($hx1); $self->check_empty_cell($hx1);
check_valid_player($apl); $self->check_valid_player($apl);
check_valid_piece($pi, $apl); $self->check_valid_piece($pi, $apl);
check_block($hx1, $apl); $self->check_block($hx1, $apl);
$board{uc $hx1} = $apl.$DIV.$pi; $self->{"board"}{uc $hx1} = $apl.$DIV.$pi;
} }
sub sz_summon($$$){ sub sz_summon($$$){
my ($self, $s0, $apl) = (shift, shift, shift); my ($self, $s0, $apl) = (shift, shift, shift);
my ($pi, $hx1) = $s0 =~ /([A-Za-z]{1,2})([A-Za-z][0-9]{1,})/; my ($pi, $hx1) = $s0 =~ /([A-Za-z]{1,2})([A-Za-z][0-9]{1,})/;
$hx1 = uc $hx1; $hx1 = uc $hx1;
check_sz($hx1, $apl); $self->check_sz($hx1, $apl);
summon($self, $s0, $apl); $self->summon($s0, $apl);
} }
sub ft_summon($$$){ 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 ); 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){ 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})$/; my ($src, $dst) = $s0 =~ /([A-Za-z][0-9]{1,2})([A-Za-z][0-9]{1,2})$/;
$src = uc $src; $src = uc $src;
$dst = uc $dst; $dst = uc $dst;
check_valid_player($apl); $self->check_valid_player($apl);
check_src_cell($src, $apl); $self->check_src_cell($src, $apl);
check_empty_cell($dst); $self->check_empty_cell($dst);
check_valid_mov($src, $dst); $self->check_valid_mov($src, $dst);
$board{$dst} = cell_pl($src).$DIV.cell_pi($src); $self->{"board"}{$dst} = $self->cell_pl($src).$DIV.$self->cell_pi($src);
$board{$src} = $EMPTY_CELL; $self->{"board"}{$src} = $EMPTY_CELL;
} }
sub new { sub new {
my $class = shift; my $class = shift;
my $self = { @_ }; 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 # Creates a hash of the the form
# $board{cell_notation} = piece_enum # $board{cell_notation} = piece_enum
%board = map { %board = map {
@ -899,6 +903,8 @@ sub new {
$AXIS_RV{$_} $AXIS_RV{$_}
}(1...11); }(1...11);
$self->{"sc"} = {};
# Both players start with a # Both players start with a
# queen # queen
push(@{$HAND{$P1}}, "Q"); push(@{$HAND{$P1}}, "Q");

2
MNU.pm
View File

@ -29,7 +29,7 @@ sub eval_game_str($$){
my ($b, $game_str) = (shift, shift); my ($b, $game_str) = (shift, shift);
try { try {
NTVL->f1($b, $game_str); NTVL->f1($b, $game_str);
disp_board($b); $b->disp_board();
} catch { } catch {
warn "invalid move: $_"; warn "invalid move: $_";
$game_str = roll_back($game_str); $game_str = roll_back($game_str);

2
test.pl
View File

@ -52,6 +52,8 @@ sub roll_back($){
$b = LPST->new(); $b = LPST->new();
NTVL->f1($b, $ns0); NTVL->f1($b, $ns0);
# printf("%s\n", $b->{"board"}{"c3"});
printf("%s\n", $b->{"board"}{"D3"});
# $b->shade_all_p2_mvmt(); # $b->shade_all_p2_mvmt();
# $b->disp_board(); # $b->disp_board();