ntvl.pl - refactored move regex stmts

This commit is contained in:
gashapwn 2021-04-08 14:04:31 +00:00
parent bea7ac75e5
commit 3e142f407b

59
ntvl.pl
View File

@ -18,21 +18,57 @@ my $SACRIFICE = 0b00001000;
# my $SPELL = 0b10000000;
my $DRAW = 0b01000000;
sub mt1($$){
my ($s0, $tc) = (shift, shift);
sub is_summon($){
return $_[0] =~ /\*/ ? $SUMMON : 0;
}
return $SUMMON if $s0 =~ /\*/;
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}/;
sub is_move($){
return $_[0] =~ /([A-Za-z]{1,2}[0-9]{1,2}){2}/ ? $MOVE : 0;
}
return $DRAW if $tc <= 1;
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 ($s0, $apl) = (shift, shift);
die "invalid draw() syntax $s0" unless $s0 =~ /^([A-Za-z]{1,2} ){1,3}[A-Za-z]{1,2}$/;
}
sub mt2($$$){
my ($s0, $tc, $apl) = (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($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);
my $mt0;
# 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;
}
@ -47,7 +83,8 @@ sub f1($){
$tc = 0;
for my $s0 (split(/\n/, $ns0)){
# $mt0 = mt1($s0, $tc);
mt2($s0, $tc, $apl);
$apl = f2($s0, $tc, $apl);
# printf(">>%s\n", $s0);
$tc++;
@ -58,7 +95,7 @@ my $ns0;
$ns0 = "";
$ns0 .= "A I It Au\n";
$ns0 .= "H S Im Im\n";
$ns0 .= "A S Im Rc\n";
f1($ns0);
@ -74,4 +111,4 @@ $b = LPST->new();
# $board{$m2} = $P2.$DIV.$c2;
# $b->shade_all_p1_mvmt();
$b->disp_board();
# $b->disp_board();