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

LPST.pm - draw() now checks for duplicate cards. ntvl.pl - updated test cases

Browse Source
This commit is contained in:
gashapwn 2021-04-09 00:47:26 +00:00
parent 3e142f407b
commit c057039549
2 changed files with 42 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
LPST.pm
View File

@ -7,6 +7,8 @@ use utf8;
my $ARRAY = "ARRAY"; my $ARRAY = "ARRAY";
my $HAND_SIZE = 5;
my $X_BOX_CHR = chr(0x2573); my $X_BOX_CHR = chr(0x2573);
my $GRAY_BOX_CHR = chr(0x2591); my $GRAY_BOX_CHR = chr(0x2591);
my $ALT_US = chr(0x2017); my $ALT_US = chr(0x2017);
@ -69,6 +71,13 @@ my $MG_AU = "Au"; # Automaton
my $MG_SY = "Sy"; # Sylph my $MG_SY = "Sy"; # Sylph
my $MG_Q = "Q"; # Queen my $MG_Q = "Q"; # Queen
my @MG_PI = (
$MG_A, $MG_I, $MG_N, $MG_IT, $MG_H, $MG_S,
$MG_RC, $MG_HS, $MG_RO, $MG_B, $MG_P, $MG_IM,
$MG_F, $MG_QS, $MG_AU, $MG_SY, $MG_Q
);
# Players # Players
my $P1 = "P1"; my $P1 = "P1";
my $P2 = "P2"; my $P2 = "P2";
@ -708,6 +717,17 @@ sub get_block_cell($){
} keys(%board); } keys(%board);
} }
sub draw($$){
my ($self, $s0) = (shift, shift);
my $i = 0;
for my $s1 (uniq( [split(/ /, $s0)] )){
$i++;
die "invalid card - $s1" unless grep { $_ =~ /^$s1$/ } @MG_PI;
}
die "draw() $s0 - hand size less than $HAND_SIZE. Possible duplicate card?" if $i < $HAND_SIZE;
}
sub new { sub new {
my $class = shift; my $class = shift;
my $self = { @_ }; my $self = { @_ };
@ -727,6 +747,12 @@ sub new {
return bless $self, $class; return bless $self, $class;
} }
sub uniq($){
my %h0;
return grep { !$h0{$_}++ } @{$_[0]};
}
sub P1 { sub P1 {
return $P1; return $P1;
} }

32
ntvl.pl
View File

@ -8,8 +8,6 @@ use strict;
use lib './'; use lib './';
use LPST; use LPST;
my $b;
# Move types # Move types
my $SUMMON = 0b00000001; my $SUMMON = 0b00000001;
my $MOVE = 0b00000010; my $MOVE = 0b00000010;
@ -38,20 +36,21 @@ sub is_draw($){
return $_[0] <= 1 ? $DRAW : 0; return $_[0] <= 1 ? $DRAW : 0;
} }
sub draw($$){ sub draw($$$){
my ($s0, $apl) = (shift, shift); my ($b, $s0, $apl) = (shift, shift, shift);
die "invalid draw() syntax $s0" unless $s0 =~ /^([A-Za-z]{1,2} ){1,3}[A-Za-z]{1,2}$/; die "invalid draw() syntax $s0" unless $s0 =~ /^([A-Za-z]{1,2} ){4}[A-Za-z]{1,2}$/;
$b->draw($s0);
} }
sub mt2($$$){ sub mt2($$$$){
my ($s0, $tc, $apl) = (shift, shift, shift); my ($b, $s0, $tc, $apl) = (shift, shift, shift, shift);
# return $MOVE if $s0 =~ /([A-Za-z]{1,2}[0-9]{1,2}){2}/; # return $MOVE if $s0 =~ /([A-Za-z]{1,2}[0-9]{1,2}){2}/;
# return $CAPTURE if $s0 =~ /\~/; # return $CAPTURE if $s0 =~ /\~/;
# return $SACRIFICE if $s0 =~ /([A-Za-z]{1,2}[0-9]{1,2}' ?){2}/; # return $SACRIFICE if $s0 =~ /([A-Za-z]{1,2}[0-9]{1,2}' ?){2}/;
# return $DRAW if $tc <= 1; # return $DRAW if $tc <= 1;
draw($s0, $apl) if is_draw($tc) draw($b, $s0, $apl) if is_draw($tc);
} }
sub mt1($$$){ sub mt1($$$){
@ -73,8 +72,8 @@ sub f2($$$){
return LPST->P1; return LPST->P1;
} }
sub f1($){ sub f1($$){
my $ns0 = shift; my ($b, $ns0) = (shift, shift);
my $apl; my $apl;
my $tc; my $tc;
@ -83,7 +82,7 @@ sub f1($){
$tc = 0; $tc = 0;
for my $s0 (split(/\n/, $ns0)){ for my $s0 (split(/\n/, $ns0)){
mt2($s0, $tc, $apl); mt2($b, $s0, $tc, $apl);
$apl = f2($s0, $tc, $apl); $apl = f2($s0, $tc, $apl);
# printf(">>%s\n", $s0); # printf(">>%s\n", $s0);
@ -94,19 +93,20 @@ sub f1($){
my $ns0; my $ns0;
$ns0 = ""; $ns0 = "";
$ns0 .= "A I It Au\n"; $ns0 .= "A I It Au N\n";
$ns0 .= "A S Im Rc\n"; $ns0 .= "A S Im Rc It\n";
f1($ns0);
my $m1 = "C10"; my $m1 = "C10";
my $m2 = "B3"; my $m2 = "B3";
my $c1 = LPST->MG_SY; my $c1 = LPST->MG_SY;
my $c2 = LPST->MG_A; my $c2 = LPST->MG_A;
my $b;
$b = LPST->new(); $b = LPST->new();
f1($b, $ns0);
# $board{$m1} = $P1.$DIV.$c1; # $board{$m1} = $P1.$DIV.$c1;
# $board{$m2} = $P2.$DIV.$c2; # $board{$m2} = $P2.$DIV.$c2;