139 lines
2.9 KiB
Perl
139 lines
2.9 KiB
Perl
#!/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 = 0b00010000;
|
|
my $FT = 0b00100001;
|
|
|
|
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 is_ft($){
|
|
return $_[0] <= 3 && $_[0] > 1? $FT : 0;
|
|
}
|
|
|
|
sub mov($$$){
|
|
my ($b, $s0, $apl) = (shift, shift, shift);
|
|
die "invalid mov() syntax $s0" unless $s0 =~ /^[A-Za-z]{1,2}([A-Za-z][0-9]{1,2}){2}$/;
|
|
$b->mov($s0, $apl);
|
|
}
|
|
|
|
sub ft($$$){
|
|
my ($b, $s0, $apl) = (shift, shift, shift);
|
|
die "invalid ft() syntax $s0" unless $s0 =~ /^([A-Za-z]{2,3}[0-9]{1,2}\*(, )?){1,}$/;
|
|
$b->ft_summon($s0, $apl);
|
|
}
|
|
|
|
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;
|
|
return mov($b, $s0, $apl) if is_move($s0);
|
|
return ft($b, $s0, $apl) if is_ft($tc);
|
|
return draw($b, $s0, $apl) if is_draw($tc);
|
|
|
|
die "invalid syntax at \$tc: $tc - $s0";
|
|
}
|
|
|
|
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 Im Au H\n";
|
|
$ns0 .= "A S Im Rc It\n";
|
|
$ns0 .= "Aa1*, Ab1*, Ac1*, Ad1*, Ae1*, Qf1*, Ag1*, Ah1*, Ai1*, Aj1*, Ak1*, Ad2*, Ai2*, Aj2*, Ak2*, Ad3*\n";
|
|
$ns0 .= "Aa11*, Ab11*, Ac11*, Ad11*, Ae11*, Qf11*\n";
|
|
$ns0 .= "Aa1a2\n";
|
|
$ns0 .= "Qf11g11\n";
|
|
$ns0 .= "Aa2a3\n";
|
|
$ns0 .= "Qg11f10\n";
|
|
$ns0 .= "Aa3a4\n";
|
|
$ns0 .= "Qf10e10\n";
|
|
$ns0 .= "Aa4a5\n";
|
|
$ns0 .= "Qe10d10\n";
|
|
$ns0 .= "Aa5a6\n";
|
|
# $ns0 .= "Qd10e9\n";
|
|
|
|
my $b;
|
|
|
|
$b = LPST->new();
|
|
|
|
f1($b, $ns0);
|
|
|
|
$b->shade_all_p2_mvmt();
|
|
$b->disp_board();
|