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

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

master
gashapwn 3 years ago
parent
42c9b7e56c
commit
b3ee9aa4c8
3 changed files with 127 additions and 119 deletions
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. +124
    -118
      LPST.pm
  2. +1
    -1
      MNU.pm
  3. +2
    -0
      test.pl

+ 124
- 118
LPST.pm View File

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


+ 1
- 1
MNU.pm View File

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


+ 2
- 0
test.pl View File

@@ -52,6 +52,8 @@ sub roll_back($){

$b = LPST->new();
NTVL->f1($b, $ns0);
# printf("%s\n", $b->{"board"}{"c3"});
printf("%s\n", $b->{"board"}{"D3"});

# $b->shade_all_p2_mvmt();
# $b->disp_board();

Write Preview
Loading…
Cancel
Save