LPST.pm - added summons ntvl.pl - updated test cases
This commit is contained in:
parent
7f92f1f269
commit
9f4d008df5
119
#ntvl.pl#
Normal file
119
#ntvl.pl#
Normal file
@ -0,0 +1,119 @@
|
||||
ggggg#!/usr/bin/perl
|
||||
|
||||
package main;
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use lib './';
|
||||
use LPST;
|
||||
|
||||
# Move types
|
||||
my $SUMMON = 0b00000001;
|
||||
my $MOVE = 0b00000010;
|
||||
my $CAPTURE = 0b00000100;
|
||||
my $SACRIFICE = 0b00001000;
|
||||
# my $SPELL = 0b10000000;
|
||||
my $DRAW = 0b01000000;
|
||||
|
||||
sub is_summon($){
|
||||
return $_[0] =~ /\*/ ? $SUMMON : 0;
|
||||
}
|
||||
|
||||
sub is_move($){
|
||||
return $_[0] =~ /([A-Za-z]{1,2}[0-9]{1,2}){2}/ ? $MOVE : 0;
|
||||
}
|
||||
|
||||
sub is_capture($){
|
||||
return $_[0] =~ /\~/ ? $CAPTURE : 0;
|
||||
}
|
||||
|
||||
sub is_sacrifice($){
|
||||
return $_[0] =~ /([A-Za-z]{1,2}[0-9]{1,2}' ?){2}/ ? $SACRIFICE : 0;
|
||||
}
|
||||
|
||||
sub is_draw($){
|
||||
return $_[0] <= 1 ? $DRAW : 0;
|
||||
}
|
||||
|
||||
sub draw($$$){
|
||||
my ($b, $s0, $apl) = (shift, shift, shift);
|
||||
die "invalid draw() syntax $s0" unless $s0 =~ /^([A-Za-z]{1,2} ){4}[A-Za-z]{1,2}$/;
|
||||
$b->draw($s0, $apl);
|
||||
}
|
||||
|
||||
sub mt2($$$$){
|
||||
my ($b, $s0, $tc, $apl) = (shift, shift, shift, shift);
|
||||
|
||||
# return $MOVE if $s0 =~ /([A-Za-z]{1,2}[0-9]{1,2}){2}/;
|
||||
# return $CAPTURE if $s0 =~ /\~/;
|
||||
# return $SACRIFICE if $s0 =~ /([A-Za-z]{1,2}[0-9]{1,2}' ?){2}/;
|
||||
# return $DRAW if $tc <= 1;
|
||||
|
||||
draw($b, $s0, $apl) if is_draw($tc);
|
||||
}
|
||||
|
||||
sub mt1($$$){
|
||||
my ($s0, $tc, $apl) = (shift, shift, shift);
|
||||
return is_summon($s0) ||
|
||||
is_move($s0) ||
|
||||
is_capture($s0) ||
|
||||
is_sacrifice($s0) ||
|
||||
is_draw($tc);
|
||||
}
|
||||
|
||||
sub f2($$$){
|
||||
my ($s0, $tc, $apl) = (shift, shift, shift);
|
||||
|
||||
# All the special cirucmstances
|
||||
# where a player moves twice are handled by spell cards
|
||||
# so this logic will do for now
|
||||
return LPST->P2 if $apl eq LPST->P1;
|
||||
return LPST->P1;
|
||||
}
|
||||
|
||||
sub f1($$){
|
||||
my ($b, $ns0) = (shift, shift);
|
||||
my $apl;
|
||||
my $tc;
|
||||
|
||||
$apl = LPST->P1;
|
||||
|
||||
$tc = 0;
|
||||
|
||||
for my $s0 (split(/\n/, $ns0)){
|
||||
mt2($b, $s0, $tc, $apl);
|
||||
|
||||
$apl = f2($s0, $tc, $apl);
|
||||
# printf(">>%s\n", $s0);
|
||||
$tc++;
|
||||
}
|
||||
}
|
||||
|
||||
my $ns0;
|
||||
|
||||
$ns0 = "";
|
||||
$ns0 .= "A I It Au N\n";
|
||||
$ns0 .= "A S Im Rc It\n";
|
||||
|
||||
my $m1 = "C10";
|
||||
my $m2 = "B3";
|
||||
my $c1 = LPST->MG_SY;
|
||||
my $c2 = LPST->MG_A;
|
||||
|
||||
my $b;
|
||||
|
||||
$b = LPST->new();
|
||||
|
||||
f1($b, $ns0);
|
||||
|
||||
# theres a problem here
|
||||
# with 2 character piece names
|
||||
# and parsing...
|
||||
$b->summon("Ak10*", "P1");
|
||||
|
||||
# $board{$m1} = $P1.$DIV.$c1;
|
||||
# $board{$m2} = $P2.$DIV.$c2;
|
||||
|
||||
# $b->shade_all_p1_mvmt();
|
||||
$b->disp_board();
|
68
LPST.pm
68
LPST.pm
@ -82,6 +82,11 @@ my @MG_PI = (
|
||||
my $P1 = "P1";
|
||||
my $P2 = "P2";
|
||||
|
||||
my %OPPL = (
|
||||
$P1 => $P2,
|
||||
$P2 => $P1
|
||||
);
|
||||
|
||||
my %HAND = (
|
||||
$P1 => [],
|
||||
$P2 => []
|
||||
@ -722,20 +727,72 @@ sub get_block_cell($){
|
||||
} keys(%board);
|
||||
}
|
||||
|
||||
sub check_valid_card($){
|
||||
my $s1 = shift;
|
||||
die "invalid card - $s1" unless grep {
|
||||
$_ =~ /^$s1$/i
|
||||
} @MG_PI;
|
||||
}
|
||||
|
||||
sub check_valid_cell($){
|
||||
my $hx1 = shift;
|
||||
|
||||
die "invalid cell - $hx1" unless grep {
|
||||
$hx1 =~ /^$_$/i
|
||||
} keys %board;
|
||||
}
|
||||
|
||||
sub check_valid_player($){
|
||||
my $apl = shift;
|
||||
die "invalid player - $apl" unless grep {
|
||||
$apl =~ /^$_$/
|
||||
} keys %HAND;
|
||||
}
|
||||
|
||||
sub check_block($$){
|
||||
my ($s0, $apl) = (shift, shift);
|
||||
for my $c0 (get_block_cell($OPPL{$apl})){
|
||||
die "summon to cell $s0 is blocked" if $s0 eq $c0;
|
||||
}
|
||||
}
|
||||
|
||||
sub check_sz($$){
|
||||
my ($hx1, $apl) = (shift, shift);
|
||||
my ($c0, $r0) = cell_index($hx1);
|
||||
|
||||
die "not in start zone" if($r0 > 3 && $apl eq $P1);
|
||||
die "not in start zone" if($r0 < 8 && $apl eq $P2);
|
||||
}
|
||||
|
||||
sub draw($$){
|
||||
my ($self, $s0, $apt) = (shift, shift, shift);
|
||||
my ($self, $s0, $apl) = (shift, shift, shift);
|
||||
|
||||
my $i = 0;
|
||||
for my $s1 (uniq( [split(/ /, $s0)] )){
|
||||
$i++;
|
||||
die "invalid card - $s1" unless grep {
|
||||
$_ =~ /^$s1$/
|
||||
} @MG_PI;
|
||||
$HAND{$P1} = $s1;
|
||||
check_valid_card($s1);
|
||||
push(@{$HAND{$apl}}, $s1);
|
||||
}
|
||||
die "draw() $s0 - hand size less than $HAND_SIZE. Possible duplicate card?" if $i < $HAND_SIZE;
|
||||
}
|
||||
|
||||
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_valid_cell($hx1);
|
||||
check_valid_player($apl);
|
||||
check_block($hx1, $apl);
|
||||
$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);
|
||||
}
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $self = { @_ };
|
||||
@ -760,7 +817,6 @@ sub uniq($){
|
||||
return grep { !$h0{$_}++ } @{$_[0]};
|
||||
}
|
||||
|
||||
|
||||
sub P1 {
|
||||
return $P1;
|
||||
}
|
||||
|
Loading…
Reference in New Issue
Block a user