@@ -0,0 +1,119 @@ | |||
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(); |
@@ -82,6 +82,11 @@ my @MG_PI = ( | |||
my $P1 = "P1"; | |||
my $P2 = "P2"; | |||
my %OPPL = ( | |||
$P1 => $P2, | |||
$P2 => $P1 | |||
); | |||
my %HAND = ( | |||
$P1 => [], | |||
$P2 => [] | |||
@@ -722,20 +727,72 @@ sub get_block_cell($){ | |||
} keys(%board); | |||
} | |||
sub check_valid_card($){ | |||
my $s1 = shift; | |||
die "invalid card - $s1" unless grep { | |||
$_ =~ /^$s1$/i | |||
} @MG_PI; | |||
} | |||
sub check_valid_cell($){ | |||
my $hx1 = shift; | |||
die "invalid cell - $hx1" unless grep { | |||
$hx1 =~ /^$_$/i | |||
} keys %board; | |||
} | |||
sub check_valid_player($){ | |||
my $apl = shift; | |||
die "invalid player - $apl" unless grep { | |||
$apl =~ /^$_$/ | |||
} keys %HAND; | |||
} | |||
sub check_block($$){ | |||
my ($s0, $apl) = (shift, shift); | |||
for my $c0 (get_block_cell($OPPL{$apl})){ | |||
die "summon to cell $s0 is blocked" if $s0 eq $c0; | |||
} | |||
} | |||
sub check_sz($$){ | |||
my ($hx1, $apl) = (shift, shift); | |||
my ($c0, $r0) = cell_index($hx1); | |||
die "not in start zone" if($r0 > 3 && $apl eq $P1); | |||
die "not in start zone" if($r0 < 8 && $apl eq $P2); | |||
} | |||
sub draw($$){ | |||
my ($self, $s0, $apt) = (shift, shift, shift); | |||
my ($self, $s0, $apl) = (shift, shift, shift); | |||
my $i = 0; | |||
for my $s1 (uniq( [split(/ /, $s0)] )){ | |||
$i++; | |||
die "invalid card - $s1" unless grep { | |||
$_ =~ /^$s1$/ | |||
} @MG_PI; | |||
$HAND{$P1} = $s1; | |||
check_valid_card($s1); | |||
push(@{$HAND{$apl}}, $s1); | |||
} | |||
die "draw() $s0 - hand size less than $HAND_SIZE. Possible duplicate card?" if $i < $HAND_SIZE; | |||
} | |||
sub summon($$$){ | |||
my ($self, $s0, $apl) = (shift, shift, shift); | |||
my ($pi, $hx1) = $s0 =~ /([A-Za-z]{1,2})([A-Za-z][0-9]{1,})/; | |||
$hx1 = uc $hx1; | |||
check_valid_cell($hx1); | |||
check_valid_player($apl); | |||
check_block($hx1, $apl); | |||
$board{uc $hx1} = $apl.$DIV.$pi; | |||
} | |||
sub sz_summon($$$){ | |||
my ($self, $s0, $apl) = (shift, shift, shift); | |||
my ($pi, $hx1) = $s0 =~ /([A-Za-z]{1,2})([A-Za-z][0-9]{1,})/; | |||
$hx1 = uc $hx1; | |||
check_sz($hx1, $apl); | |||
summon($self, $s0, $apl); | |||
} | |||
sub new { | |||
my $class = shift; | |||
my $self = { @_ }; | |||
@@ -760,7 +817,6 @@ sub uniq($){ | |||
return grep { !$h0{$_}++ } @{$_[0]}; | |||
} | |||
sub P1 { | |||
return $P1; | |||
} | |||
@@ -107,6 +107,10 @@ $b = LPST->new(); | |||
f1($b, $ns0); | |||
$b->summon("Ak10*", "P1"); | |||
$b->sz_summon("Ak3*", "P1"); | |||
# $board{$m1} = $P1.$DIV.$c1; | |||
# $board{$m2} = $P2.$DIV.$c2; | |||