gashapwn/lpst
1
0
Vork 0
Code Kwesties Pull-aanvragen Publicaties Wiki Activiteit
b3ee9aa4c8
lpst/LPST.pm

989 regels
24 KiB
Perl
Ruw Blame Geschiedenis

#!/usr/bin/perl
package LPST;
use warnings;
use strict;
use utf8;
my $ARRAY = "ARRAY";
my $HAND_SIZE = 5;
my $MAX_FT_SUMMON = 16;
my $X_BOX_CHR = chr(0x2573);
my $GRAY_BOX_CHR = chr(0x2591);
my $ALT_US = chr(0x2017);
my $ALT_PIPE = chr(0x2016);
my $SHADE_1_CHR = $GRAY_BOX_CHR;
my $SHADE_2_CHR = $X_BOX_CHR;
my $PAD_AXIS = " ";
my $PAD_EVEN = " ";
my $PAD_ODD = " ";
my $HEX_1 = '-/--\-';
my $HEX_2 = '| __ |';
my $HEX_3 = '| |';
my $HEX_S1_1 = '-/--\-';
my $HEX_S1_2 = sprintf("|%s%s%s%s|", $SHADE_1_CHR, $SHADE_1_CHR, $SHADE_1_CHR, $SHADE_1_CHR);
my $HEX_S1_3 = sprintf("|%s%s%s%s|", $SHADE_1_CHR, $SHADE_1_CHR, $SHADE_1_CHR, $SHADE_1_CHR);
my $HEX_S2_1 = '-/--\-';
my $HEX_S2_2 = sprintf("|%s%s%s%s|", $SHADE_2_CHR, $SHADE_2_CHR, $SHADE_2_CHR, $SHADE_2_CHR);
my $HEX_S2_3 = sprintf("|%s%s%s%s|", $SHADE_2_CHR, $SHADE_2_CHR, $SHADE_2_CHR, $SHADE_2_CHR);
my $HEX_S3_1 = '-/--\-';
my $HEX_S3_2 = sprintf("|%s%s%s%s|", $SHADE_2_CHR, $SHADE_2_CHR, $SHADE_1_CHR, $SHADE_1_CHR);
my $HEX_S3_3 = sprintf("|%s%s%s%s|", $SHADE_2_CHR, $SHADE_2_CHR, $SHADE_1_CHR, $SHADE_1_CHR);
my $HL_1 = "|____ ";
my $HL_2 = $ALT_PIPE.$ALT_US.$ALT_US.$ALT_US.$ALT_US." ";
my $SUB_CHR = "_";
my $BLANK_CELL_CHR = $ALT_US;
my $PREF_1 = substr($HEX_1, -2, 2);
my $PREF_2 = ' ';
my $PREF_3 = ' ';
my $TRAIL_1 = substr($HEX_1, 0, 1);
my $TRAIL_2 = substr($HEX_1, -1, 1);
my $TRAIL_3 = substr($HEX_1, 0, 2);
# Pieces
my $MG_A = "A"; # Apprentice
my $MG_I = "I"; # Iron Maiden
my $MG_N = "N"; # Nekomata
my $MG_IT = "It"; # Ittan-Momen
my $MG_H = "H"; # Harpy
my $MG_S = "S"; # Slime
my $MG_RC = "Rc"; # Redcap
my $MG_HS = "Hs"; # Holstaur
my $MG_RO = "Ro"; # Red Oni
my $MG_B = "B"; # Blue Oni
my $MG_P = "P"; # Preistess
my $MG_IM = "Im"; # Imp
my $MG_F = "F"; # False Angel
my $MG_QS = "Qs"; # Queen slime
my $MG_AU = "Au"; # Automaton
my $MG_SY = "Sy"; # Sylph
my $MG_Q = "Q"; # Queen
my @MG_PI = (
$MG_A, $MG_I, $MG_N, $MG_IT, $MG_H, $MG_S,
$MG_RC, $MG_HS, $MG_RO, $MG_B, $MG_P, $MG_IM,
$MG_F, $MG_QS, $MG_AU, $MG_SY, $MG_Q
);
# Players
my $P1 = "P1";
my $P2 = "P2";
my %OPPL = (
$P1 => $P2,
$P2 => $P1
);
my %HAND = (
$P1 => [],
$P2 => []
);
my $DIV = ":";
my %AXIS = (
"A" => 1,
"B" => 2,
"C" => 3,
"D" => 4,
"E" => 5,
"F" => 6,
"G" => 7,
"H" => 8,
"I" => 9,
"J" => 10,
"K" => 11
);
my %AXIS_RV = map {
$AXIS{$_} => $_
} keys(%AXIS);
package MoveStruct;
use warnings;
use strict;
sub new {
my $class = shift;
my $self = { @_ };
die "invalid MoveStruct {\"mov\"}" unless $self->{"mov"};
die "invalid MoveStruct ->{\"type\"}" unless $self->{"type"};
die "invalid MoveStruct type" unless ref($self->{"mov"}) eq $ARRAY;
return bless $self, $class;
}
package LPST;
#
# /--\ +1
# | __ |
# | |+1
# \--/
# -1 -1
#
# ODD
# UP: 0, +1
# DOWN: -1, -1
# EVEN
# UP: +1, +1
# DOWN: +0, -1
# [Row move, Diag move]
# Special cells
my $EMPTY_CELL = "_";
# Shade enum
my $SHADE_3_ENUM = 0b011;
my $SHADE_2_ENUM = 0b010;
my $SHADE_1_ENUM = 0b001;
my $EMPTY_ENUM = 0;
my %SHADE = (
$SHADE_1_ENUM => [$HEX_S1_1, $HEX_S1_2, $HEX_S1_3],
$SHADE_2_ENUM => [$HEX_S2_1, $HEX_S2_2, $HEX_S2_3],
$SHADE_3_ENUM => [$HEX_S3_1, $HEX_S3_2, $HEX_S3_3],
$EMPTY_ENUM => [$HEX_1, $HEX_2, $HEX_3]
);
my $MOVE_ENUM = $SHADE_1_ENUM;
my $BLOCK_ENUM = $SHADE_2_ENUM;
my $MOVBLOCK_ENUM = $SHADE_3_ENUM;
my $ERR_C_1 = -1;
my %MOVE = (
$MG_A => [
MoveStruct->new("mov" => [-1, 1], "type" => $MOVBLOCK_ENUM),
MoveStruct->new("mov" => [ 0, 1], "type" => $MOVBLOCK_ENUM)
],
$MG_Q => [
MoveStruct->new("mov" => [ 0, 1], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 1, 0], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [-1, 0], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 0,-1], "type" => $MOVE_ENUM)
],
$MG_I => [
MoveStruct->new("mov" => [-1, 0], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [-1, 1], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [ 0, 1], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [ 0,-1], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [ 1, 0], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [ 1,-1], "type" => $BLOCK_ENUM)
],
$MG_IT => [
MoveStruct->new("mov" => [ 0,-1], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 1,-1], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [-1, 1], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [ 0, 1], "type" => $BLOCK_ENUM)
],
$MG_N => [
MoveStruct->new("mov" => [-1, 2], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 1,-2], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [-1, 1], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [ 0, 1], "type" => $BLOCK_ENUM)
],
$MG_H => [
MoveStruct->new("mov" => [-3, 2], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [-1,-2], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 1, 2], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 3,-2], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 0,-1], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [ 1,-1], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [-1, 1], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [ 0, 1], "type" => $BLOCK_ENUM)
],
$MG_RC => [
MoveStruct->new("mov" => [-1, 0], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [-2, 0], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 1, 0], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 2, 0], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 0,-1], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [ 1,-1], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [-1, 1], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [ 0, 1], "type" => $BLOCK_ENUM)
],
$MG_S => [
MoveStruct->new("mov" => [-1, 1], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [-2, 2], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 0, 1], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 0, 2], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 0,-1], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 0,-2], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 1,-1], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 2,-2], "type" => $MOVE_ENUM),
],
$MG_HS => [
MoveStruct->new("mov" => [-3, 1], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [-2,-1], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 2, 1], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 3,-1], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [-2, 1], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [ 1, 1], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [-1, 1], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [ 0, 1], "type" => $BLOCK_ENUM)
],
$MG_RO => [
MoveStruct->new("mov" => [-1, 1], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 0, 1], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 1, 1], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 1,-2], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [-1, 0], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [ 1, 0], "type" => $BLOCK_ENUM)
],
$MG_B => [
MoveStruct->new("mov" => [-1, 1], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 0, 1], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 0,-2], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 2,-2], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 0,-1], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [ 1,-1], "type" => $BLOCK_ENUM)
],
$MG_P => [
MoveStruct->new("mov" => [-4, 2], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [-2, 1], "type" => $MOVBLOCK_ENUM),
MoveStruct->new("mov" => [-2,-2], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [-1,-1], "type" => $MOVBLOCK_ENUM),
MoveStruct->new("mov" => [ 1, 1], "type" => $MOVBLOCK_ENUM),
MoveStruct->new("mov" => [ 2,-1], "type" => $MOVBLOCK_ENUM),
MoveStruct->new("mov" => [ 2, 2], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 4,-2], "type" => $MOVE_ENUM)
],
$MG_IM => [
MoveStruct->new("mov" => [-2, 1], "type" => $MOVBLOCK_ENUM),
MoveStruct->new("mov" => [-1,-1], "type" => $MOVBLOCK_ENUM),
MoveStruct->new("mov" => [-1, 2], "type" => $MOVBLOCK_ENUM),
MoveStruct->new("mov" => [ 1, 1], "type" => $MOVBLOCK_ENUM),
MoveStruct->new("mov" => [ 1,-1], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 1,-2], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [ 2,-1], "type" => $MOVBLOCK_ENUM)
],
$MG_F => [
MoveStruct->new("mov" => [-1, 0], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [-1, 1], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 0, 1], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 0,-1], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 1, 0], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 1,-1], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 0, 2], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [ 0,-2], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [ 1, 1], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [ 1,-2], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [ 2, 0], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [ 2,-1], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [ 2,-2], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [-1, 2], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [-1,-1], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [-2, 0], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [-2, 1], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [-2, 2], "type" => $BLOCK_ENUM)
],
$MG_QS => [
MoveStruct->new("mov" => [-3, 3], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [-2, 2], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [-2, 0], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [-1, 0], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [-1, 1], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 0, 1], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 0, 2], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 0, 3], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 0,-1], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 0,-2], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 0,-3], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 1, 0], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 1,-1], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 2, 0], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 2,-2], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 3,-3], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 3, 0], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [-3, 0], "type" => $MOVE_ENUM)
],
$MG_AU => [
MoveStruct->new("mov" => [-1, 0], "type" => $MOVBLOCK_ENUM),
MoveStruct->new("mov" => [-1, 1], "type" => $MOVBLOCK_ENUM),
MoveStruct->new("mov" => [ 0, 1], "type" => $MOVBLOCK_ENUM),
MoveStruct->new("mov" => [ 0,-1], "type" => $MOVBLOCK_ENUM),
MoveStruct->new("mov" => [ 1, 0], "type" => $MOVBLOCK_ENUM),
MoveStruct->new("mov" => [ 1,-1], "type" => $MOVBLOCK_ENUM),
MoveStruct->new("mov" => [ 0, 2], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [ 0,-2], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [ 1, 1], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [ 1,-2], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [ 2,-1], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [ 2,-2], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [-1, 2], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [-1,-1], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [-2, 1], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [-2, 2], "type" => $BLOCK_ENUM)
],
$MG_SY => [
MoveStruct->new("mov" => [-4, 4], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [-3, 3], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [-3, 2], "type" => $MOVBLOCK_ENUM),
MoveStruct->new("mov" => [-1,-2], "type" => $MOVBLOCK_ENUM),
MoveStruct->new("mov" => [ 0,-4], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 0,-3], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 0, 3], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 0, 4], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 1, 2], "type" => $MOVBLOCK_ENUM),
MoveStruct->new("mov" => [ 3,-2], "type" => $MOVBLOCK_ENUM),
MoveStruct->new("mov" => [ 3,-3], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [ 4,-4], "type" => $MOVE_ENUM),
MoveStruct->new("mov" => [-1, 1], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [ 0, 1], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [ 0,-1], "type" => $BLOCK_ENUM),
MoveStruct->new("mov" => [ 1,-1], "type" => $BLOCK_ENUM)
]
);
my %board;
# Display pieces
#==================================================
sub get_pi_str($){
my ($p) = (shift);
$p =~ s/($P1|$P2)$DIV//;
$p .= "_" if length($p) < 2;
return $p;
}
sub sub_pi_str($$$){
my ($p, $c0, $hex) = (shift, shift, shift);
my $s0;
$p = get_pi_str($p);
$s0 = $hex;
unless($p eq "__"){
substr($s0, 2,2) = $p;
}
if($c0 % 2 == 0){
$s0 =~ s/$SUB_CHR/$BLANK_CELL_CHR/g;
}
return $s0;
}
# Display shade
#==================================================
sub apply_shade($$$){
my ($self, $not, $en) = (shift, shift, shift);
$self->{"sc"}{$not} = $en unless grep(/^$not$/, keys( %{$self->{"sc"}} ));
$self->{"sc"}{$not} = $MOVBLOCK_ENUM unless $self->{"sc"}{$not} == $en;
}
sub get_shade_en($$){
my ($self, $not) = (shift, shift);
return $self->{"sc"}{$not} if (grep /^$not$/, keys( %{$self->{"sc"}} ));
return $EMPTY_ENUM;
}
sub get_shade_hex($){
my $en = shift;
return $SHADE{$en};
}
sub get_cell_shade($$$){
my ($self, $r0, $c0) = (shift, shift, shift);
my $not;
$not = cell_index_rev($c0, $r0);
return get_shade_hex($self->get_shade_en($not));
}
# Display lines
#==================================================
sub disp_1($$$){
my ($self, $r0, $c0) = (shift, shift, shift);
my $hex;
$hex = $self->get_cell_shade($r0, $c0)->[0];
return $hex;
}
sub disp_2($$$){
my ($self, $r0, $c0) = (shift, shift, shift);
my $p;
my $not;
my $hex;
$hex = $self->get_cell_shade($r0, $c0)->[1];
$not = cell_index_rev($c0, $r0);
$p = $self->{"board"}{$not};
return sub_pi_str($p, $c0, $hex);
}
sub disp_3($$$){
my ($self, $r0, $c0) = (shift, shift, shift);
my $hex;
$hex = $self->get_cell_shade($r0, $c0)->[2];
return $hex;
}
sub disp_y_axis($$$$){
my ($s0, $s1, $s2, $r0) = @_;
my $n0;
$n0 = length($r0);
$s0 = $r0 % 2 == 1 ? $PAD_ODD : $PAD_EVEN.$PREF_1;
$s1 = $r0 % 2 == 1 ? $PAD_ODD : $PAD_EVEN.$PREF_2;
$s1 =~ s/^ {$n0}/$r0/;
$s2 = $r0 % 2 == 1 ? $PAD_ODD : $PAD_EVEN.$PREF_3;
return ($s0, $s1, $s2);
}
# Display cell
#==================================================
sub add_cell($$$$$$){
my ($self, $s0, $s1, $s2, $r0, $c0) = @_;
$s0 .= $self->disp_1($r0, $c0);
$s1 .= $self->disp_2($r0, $c0);
$s2 .= $self->disp_3($r0, $c0);
return ($s0, $s1, $s2);
}
sub disp_0($){
my ($self, $r0) = (shift, shift);
my ($s0, $s1, $s2);
# Append the y axis
($s0, $s1, $s2) = disp_y_axis($s0, $s1, $s2, $r0);
# Iterate through the cells
for my $i (1..11){
($s0, $s1, $s2) = $self->add_cell($s0, $s1, $s2, $r0, $i);
}
return $s0."\n".$s1."\n".$s2."\n";
}
# Display row
#==================================================
sub disp_row($$){
my $row;
my ($self, $r0) = (shift, shift);
# $r0 = shift;
$row = $self->disp_0($r0);
# Handle trailing characters
if($r0 % 2 == 1){
# Trim the start of the first line
$row =~ s/$TRAIL_1/ /;
# Trim the end of the first line
$row =~ s/\n/$TRAIL_3\n/
}else{
# Trim the end of the last line
$row =~ s/$TRAIL_2\n/ \n/m;
}
return $row;
}
sub disp_trailing_row(){
my $s0;
my $s1;
$s0 = $PAD_EVEN.$PREF_1;
# Clear some chars from
# our hex patterns
$s1 = $HEX_1;
substr($s1, 2,2) = " ";
# Append hex pattern to
# trailing row
for my $i (1..11){
$s0 .= $s1;
}
# Clear one last pair of
# chrs
substr($s0, -2,2) = " ";
$s0 .= "\n";
return $s0;
}
sub disp_x_axis(){
my $s0;
$s0 = $PAD_AXIS;
$s0 .= join(
$PAD_AXIS, map{
$AXIS_RV{$_}
}(1..11));
$s0 .= "\n";
$s0 .= $PAD_AXIS;
$s0 .= join(
"", map{
$_ % 2 == 1 ? $HL_1 : $HL_2
}(1..11));
$s0 .= "\n";
return $s0
}
# Display board
#==================================================
sub disp_board($){
my $self = shift;
my $b;
for my $i (map {11-$_+1} (1..11)) {
$b .= $self->disp_row($i);
}
$b .= disp_trailing_row();
$b .= disp_x_axis();
$b =~ s/$TRAIL_1$TRAIL_3\n/\n/m;
for my $i (1..11-1){
substr($b, 2+6*$i, 2) = " ";
}
printf("%s", $b);
}
# Caclulate movement
#==================================================
sub pi_split($$$){
my ($self, $not, $i0) = (shift, shift, shift);
return (split(/$DIV/, $self->{"board"}{$not}))[$i0];
}
sub cell_pi($$){
my ($self, $not) = (shift, shift);
return $self->pi_split($not, 1);
}
sub cell_pl($$){
my ($self, $not) = (shift, shift);
return $self->pi_split($not, 0);
}
sub cell_index_rev($$){
return $AXIS_RV{$_[0]}.$_[1];
}
sub cell_index($){
my $chr1 = substr($_[0], 0,1);
my $chr2 = substr($_[0], 1,length($_[0])-1);
return ($AXIS{$chr1}, $chr2);
}
sub apply_shift($$){
my ($not, $my_shift) = (shift, shift);
my $r0;
my $c0;
($c0, $r0) = cell_index($not);
$r0 += $my_shift->[1];
$c0 += $my_shift->[0];
return $ERR_C_1 if $r0 > 11 or $c0 > 11 or $r0 < 1 or $c0 < 1;
return cell_index_rev($c0, $r0);
}
sub calc_new_cell($$){
my ($not, $mov) = (shift, shift);
my ($c0, $r0) = cell_index($not);
my $x_shift;
my $y_shift;
my $n0;
my $ni;
# get y_shift
$y_shift = $mov->[1];
# get x_shift
$x_shift = $mov->[0];
# make x_shift adjustment
$ni = $y_shift != 0 ? ($y_shift / abs($y_shift)) : 1;
$n0 = ($r0 + (($ni + 1)/2) ) % 2;
$x_shift += int(($y_shift + ($n0 * $ni)) / 2);
return apply_shift($not, [$x_shift, $y_shift]);
}
sub mirror_mov($){
my $mov = shift;
return MoveStruct->new(
"mov" => [$mov->{"mov"}[0] * -1, $mov->{"mov"}[1] * -1],
"type" => $mov->{"type"}
);
}
sub get_mov($$$){
my ($pi, $en, $apl) = (shift, shift, shift);
my @mv1;
@mv1 = grep {
($_->{"type"} & $en) != 0
} @{$MOVE{$pi}};
my ($t1, $t2) = (0, 0);
if($apl eq $P2){
@mv1 = map {
mirror_mov($_)
} @mv1;
}
return \@mv1;
}
sub find_all_mov($$$){
my ($self, $not, $en) = (shift, shift, shift);
my $pi;
my @mv1;
my $apl;
$pi = $self->cell_pi($not);
$apl = $self->cell_pl($not);
@mv1 = @{ get_mov($pi, $en, $apl) };
return grep {
$_ if $_->[0] ne $ERR_C_1
} map {
[
calc_new_cell($not, $_->{"mov"}),
$_->{"type"}
]
} @mv1;
}
sub shade_pi_mvmt($$$){
my ($self, $not, $en) = (shift, shift, shift);
my $c1;
my @mv1;
@mv1 = $self->find_all_mov($not, $en);
for my $mv (@mv1){
$self->apply_shade($mv->[0], $mv->[1]);
}
}
sub shade_all_mvmt($$$){
my ($self, $pl, $en) = (shift, shift, shift);
my @pi1;
@pi1 = grep {
$self->cell_pl($_) eq $pl
} keys(%{$self->{"board"}});
for my $el (@pi1){
$self->shade_pi_mvmt($el, $en);
}
}
sub shade_all_p1_mvmt($){
my $self = shift;
$self->shade_all_mvmt($P1, $MOVBLOCK_ENUM);
}
sub shade_all_p2_mvmt($){
my $self = shift;
$self->shade_all_mvmt($P2, $MOVBLOCK_ENUM);
}
sub get_block_cell($$){
my ($self, $pl) = (shift, shift);
return map {
$_->[0]
} map {
( $self->find_all_mov($_, $BLOCK_ENUM) );
} grep {
$self->cell_pl($_) eq $pl
} keys(%{$self->{"board"}});
}
sub check_valid_card($$){
my ($self, $s1) = (shift, shift);
die "invalid card/piece - $s1" unless grep {
$_ =~ /^$s1$/i
} @MG_PI;
}
sub check_empty_cell($$){
my ($self, $hx1) = (shift, shift);
$hx1 = uc $hx1;
$self->check_valid_cell($hx1);
die "piece in cell $hx1" if $self->{"board"}{$hx1} ne $EMPTY_CELL;
}
sub check_nonempty_cell($$){
my ($self, $hx1) = (shift, shift);
$hx1 = uc $hx1;
$self->check_valid_cell($hx1);
die "no piece in cell $hx1" if $self->{"board"}{$hx1} eq $EMPTY_CELL;
}
sub check_valid_cell($$){
my ($self, $hx1) = (shift, shift);
$hx1 = uc $hx1;
die "invalid cell - $hx1" unless grep {
$hx1 =~ /^$_$/i
} keys %{$self->{"board"}};
# } keys %board;
}
sub check_src_cell($$$){
my ($self, $hx1, $apl) = (shift, shift, shift);
$hx1 = uc $hx1;
$self->check_nonempty_cell($hx1);
die "This cell is not owned by $apl" if $self->cell_pl($hx1) ne $apl;
}
sub check_valid_player($$){
my ($self, $apl) = (shift, shift);
die "invalid player - $apl" unless grep {
$apl =~ /^$_$/
} keys %HAND;
}
sub check_valid_piece($$$){
my ($self, $pi, $apl) = (shift, shift, shift);
$self->check_valid_card($pi);
die "player $apl does not have $pi" unless grep {
$pi =~ /$_$/
} @{$HAND{$apl}};
}
sub check_block($$$){
my ($self, $s0, $apl) = (shift, shift, shift);
for my $c0 ($self->get_block_cell($OPPL{$apl})){
die "summon to cell $s0 is blocked" if $s0 eq $c0;
}
}
sub check_valid_mov($$$){
my ($self, $src, $dst) = (shift, shift, shift);
$src = uc $src;
die "not valid move" unless grep {$dst eq $_->[0]} $self->find_all_mov($src, $MOVE_ENUM);
}
sub check_sz($$$){
my ($self, $hx1, $apl) = (shift, shift, shift);
my ($c0, $r0) = cell_index($hx1);
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($$$){
my ($self, $s0, $apl) = (shift, shift, shift);
my $i = 0;
for my $s1 (uniq( [split(/ /, $s0)] )){
$i++;
$self->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;
$self->check_empty_cell($hx1);
$self->check_valid_player($apl);
$self->check_valid_piece($pi, $apl);
$self->check_block($hx1, $apl);
$self->{"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;
$self->check_sz($hx1, $apl);
$self->summon($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 =~ /\b[A-Za-z]{2,3}[0-9]{1,2}\*/g){
$self->sz_summon($mv1, $apl);
}
}
sub mov($$$){
my ($self, $s0, $apl) = (shift, shift, shift);
my ($src, $dst) = $s0 =~ /([A-Za-z][0-9]{1,2})([A-Za-z][0-9]{1,2})$/;
$src = uc $src;
$dst = uc $dst;
$self->check_valid_player($apl);
$self->check_src_cell($src, $apl);
$self->check_empty_cell($dst);
$self->check_valid_mov($src, $dst);
$self->{"board"}{$dst} = $self->cell_pl($src).$DIV.$self->cell_pi($src);
$self->{"board"}{$src} = $EMPTY_CELL;
}
sub new {
my $class = shift;
my $self = { @_ };
$self->{"board"} = { map {
$_ => $EMPTY_CELL
} map {
my $l0;
$l0 = $_;
(map {$l0.$_} ("1".."11"))
} map {
$AXIS_RV{$_}
}(1...11) };
# Creates a hash of the the form
# $board{cell_notation} = piece_enum
%board = map {
$_ => $EMPTY_CELL
} map {
my $l0;
$l0 = $_;
(map {$l0.$_} ("1".."11"))
} map {
$AXIS_RV{$_}
}(1...11);
$self->{"sc"} = {};
# Both players start with a
# queen
push(@{$HAND{$P1}}, "Q");
push(@{$HAND{$P2}}, "Q");
return bless $self, $class;
}
sub uniq($){
my %h0;
return grep { !$h0{$_}++ } @{$_[0]};
}
sub P1 {
return $P1;
}
sub P2 {
return $P2;
}
sub MG_A {
return $MG_A;
}
sub MG_I{
return $MG_I;
}
sub MG_N{
return $MG_N;
}
sub MG_IT{
return $MG_I;
}
sub MG_H{
return $MG_H;
}
sub MG_S{
return $MG_S;
}
sub MG_RC{
return $MG_RO;
}
sub MG_HS{
return $MG_H;
}
sub MG_RO{
return $MG_RC;
}
sub MG_B{
return $MG_B;
}
sub MG_P{
return $MG_P;
}
sub MG_IM{
return $MG_I;
}
sub MG_F{
return $MG_F;
}
sub MG_QS{
return $MG_QS;
}
sub MG_AU{
return $MG_A;
}
sub MG_SY{
return $MG_SY;
}
sub MG_Q{
return $MG_Q;
}
binmode(STDOUT, ":utf8");
return 1;
Verwijs in nieuw issue Bekijk Git Blame Permalink kopiëren