lpst/ntvl.pl

#!/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 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;

    ft($b, $s0, $apl) if is_ft($tc);
    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";
# $ns0 .= "Aa1*Ab1*Ac1*Ad1*Ae1*Qf1*Ag1*Ah1*Ai1*Aj1*Ak1*Ad2*Ai2*Aj2*Ak2*Ad3*\n";
$ns0 .= "Aa1*Ab1*Ac1*Ad1*Ae1*Qf1*\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);

$b->shade_all_p1_mvmt();
$b->disp_board();