ntvl.pl - refactored move regex stmts
This commit is contained in:
parent
bea7ac75e5
commit
3e142f407b
59
ntvl.pl
59
ntvl.pl
@ -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();
|
||||
|
Loading…
Reference in New Issue
Block a user