|
- #!/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 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";
-
- my $b;
-
- $b = LPST->new();
-
- f1($b, $ns0);
-
- $b->shade_all_p2_mvmt();
- $b->disp_board();
|