ggggg#!/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 = 0b01000000; 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 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; 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"; my $m1 = "C10"; my $m2 = "B3"; my $c1 = LPST->MG_SY; my $c2 = LPST->MG_A; my $b; $b = LPST->new(); f1($b, $ns0); # theres a problem here # with 2 character piece names # and parsing... $b->summon("Ak10*", "P1"); # $board{$m1} = $P1.$DIV.$c1; # $board{$m2} = $P2.$DIV.$c2; # $b->shade_all_p1_mvmt(); $b->disp_board();