@@ -1,119 +0,0 @@ | |||||
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(); |
@@ -2,3 +2,4 @@ | |||||
p[0-9].pl | p[0-9].pl | ||||
p[0-9][0-9].pl | p[0-9][0-9].pl | ||||
notes.txt | notes.txt | ||||
#* |
@@ -8,6 +8,7 @@ use utf8; | |||||
my $ARRAY = "ARRAY"; | my $ARRAY = "ARRAY"; | ||||
my $HAND_SIZE = 5; | my $HAND_SIZE = 5; | ||||
my $MAX_FT_SUMMON = 16; | |||||
my $X_BOX_CHR = chr(0x2573); | my $X_BOX_CHR = chr(0x2573); | ||||
my $GRAY_BOX_CHR = chr(0x2591); | my $GRAY_BOX_CHR = chr(0x2591); | ||||
@@ -392,7 +393,8 @@ sub apply_shade($$){ | |||||
my $not = shift; | my $not = shift; | ||||
my $en = shift; | my $en = shift; | ||||
$sc{$not} = $en unless (grep /^$not$/, keys(%sc)); | |||||
$sc{$not} = $en unless grep(/^$not$/, keys(%sc)); | |||||
$sc{$not} = $MOVBLOCK_ENUM unless $sc{$not} == $en; | |||||
} | } | ||||
sub get_shade_en($){ | sub get_shade_en($){ | ||||
@@ -740,6 +742,7 @@ sub check_valid_cell($){ | |||||
die "invalid cell - $hx1" unless grep { | die "invalid cell - $hx1" unless grep { | ||||
$hx1 =~ /^$_$/i | $hx1 =~ /^$_$/i | ||||
} keys %board; | } keys %board; | ||||
die "piece in cell $hx1" if $board{$hx1} ne $EMPTY_CELL; | |||||
} | } | ||||
sub check_valid_player($){ | sub check_valid_player($){ | ||||
@@ -760,8 +763,8 @@ sub check_sz($$){ | |||||
my ($hx1, $apl) = (shift, shift); | my ($hx1, $apl) = (shift, shift); | ||||
my ($c0, $r0) = cell_index($hx1); | 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); | |||||
die "$hx1 not in start zone" if($r0 > 3 && $apl eq $P1); | |||||
die "$hx1 not in start zone" if($r0 < 8 && $apl eq $P2); | |||||
} | } | ||||
sub draw($$){ | sub draw($$){ | ||||
@@ -785,6 +788,7 @@ sub summon($$$){ | |||||
check_block($hx1, $apl); | check_block($hx1, $apl); | ||||
$board{uc $hx1} = $apl.$DIV.$pi; | $board{uc $hx1} = $apl.$DIV.$pi; | ||||
} | } | ||||
sub sz_summon($$$){ | sub sz_summon($$$){ | ||||
my ($self, $s0, $apl) = (shift, shift, shift); | my ($self, $s0, $apl) = (shift, shift, shift); | ||||
my ($pi, $hx1) = $s0 =~ /([A-Za-z]{1,2})([A-Za-z][0-9]{1,})/; | my ($pi, $hx1) = $s0 =~ /([A-Za-z]{1,2})([A-Za-z][0-9]{1,})/; | ||||
@@ -793,6 +797,17 @@ sub sz_summon($$$){ | |||||
summon($self, $s0, $apl); | summon($self, $s0, $apl); | ||||
} | } | ||||
sub ft_summon($$$){ | |||||
my ($self, $s0, $apl) = (shift, shift, shift); | |||||
die "Must summon queen on first turn" unless $s0 =~ /$MG_Q[A-ka-k]{1,2}[0-9]{1,2}/; | |||||
die "Max summons on first turn is $MAX_FT_SUMMON" if ( scalar (() = $s0 =~ /\*/g) > $MAX_FT_SUMMON ); | |||||
for my $mv1 ($s0 =~ /[A-Za-z]{2,3}[0-9]{1,2}\*/g){ | |||||
sz_summon($self, $mv1, $apl); | |||||
# printf("%s\n", $mv1); | |||||
} | |||||
} | |||||
sub new { | sub new { | ||||
my $class = shift; | my $class = shift; | ||||
my $self = { @_ }; | my $self = { @_ }; | ||||
@@ -14,7 +14,8 @@ my $MOVE = 0b00000010; | |||||
my $CAPTURE = 0b00000100; | my $CAPTURE = 0b00000100; | ||||
my $SACRIFICE = 0b00001000; | my $SACRIFICE = 0b00001000; | ||||
# my $SPELL = 0b10000000; | # my $SPELL = 0b10000000; | ||||
my $DRAW = 0b01000000; | |||||
my $DRAW = 0b00010000; | |||||
my $FT = 0b00100001; | |||||
sub is_summon($){ | sub is_summon($){ | ||||
return $_[0] =~ /\*/ ? $SUMMON : 0; | return $_[0] =~ /\*/ ? $SUMMON : 0; | ||||
@@ -36,6 +37,16 @@ sub is_draw($){ | |||||
return $_[0] <= 1 ? $DRAW : 0; | 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($$$){ | sub draw($$$){ | ||||
my ($b, $s0, $apl) = (shift, shift, shift); | 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}$/; | die "invalid draw() syntax $s0" unless $s0 =~ /^([A-Za-z]{1,2} ){4}[A-Za-z]{1,2}$/; | ||||
@@ -50,6 +61,7 @@ sub mt2($$$$){ | |||||
# return $SACRIFICE if $s0 =~ /([A-Za-z]{1,2}[0-9]{1,2}' ?){2}/; | # return $SACRIFICE if $s0 =~ /([A-Za-z]{1,2}[0-9]{1,2}' ?){2}/; | ||||
# return $DRAW if $tc <= 1; | # return $DRAW if $tc <= 1; | ||||
ft($b, $s0, $apl) if is_ft($tc); | |||||
draw($b, $s0, $apl) if is_draw($tc); | draw($b, $s0, $apl) if is_draw($tc); | ||||
} | } | ||||
@@ -95,9 +107,11 @@ my $ns0; | |||||
$ns0 = ""; | $ns0 = ""; | ||||
$ns0 .= "A I It Au N\n"; | $ns0 .= "A I It Au N\n"; | ||||
$ns0 .= "A S Im Rc It\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 $m1 = "c10"; | |||||
my $m2 = "b3"; | |||||
my $c1 = LPST->MG_SY; | my $c1 = LPST->MG_SY; | ||||
my $c2 = LPST->MG_A; | my $c2 = LPST->MG_A; | ||||
@@ -107,12 +121,5 @@ $b = LPST->new(); | |||||
f1($b, $ns0); | f1($b, $ns0); | ||||
$b->summon("Ak10*", "P1"); | |||||
$b->sz_summon("Ak3*", "P1"); | |||||
# $board{$m1} = $P1.$DIV.$c1; | |||||
# $board{$m2} = $P2.$DIV.$c2; | |||||
# $b->shade_all_p1_mvmt(); | |||||
# $b->disp_board(); | |||||
$b->shade_all_p1_mvmt(); | |||||
$b->disp_board(); |