lpst/LPST.pm

#!/usr/bin/perl

use warnings;
use strict;

use utf8;

my $ARRAY = "ARRAY";

my $HAND_SIZE = 5;

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 %sc = ();
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 $not = shift;
    my $en = shift;

    $sc{$not} = $en unless (grep /^$not$/, keys(%sc));
}

sub get_shade_en($){
    my $not = shift;
    return $sc{$not} if (grep /^$not$/, keys(%sc));
    return $EMPTY_ENUM;
}

sub get_shade_hex($){
    my $en = shift;
    return $SHADE{$en};
}

sub get_cell_shade($$){
    my ($r0, $c0) = (shift, shift);
    my $not;
    
    $not = cell_index_rev($c0, $r0);
    return get_shade_hex(get_shade_en($not));
}




# Display lines
#==================================================

sub disp_1($$){
    my ($r0, $c0) = (shift, shift);
    my $hex;

    $hex = get_cell_shade($r0, $c0)->[0];
    
    return $hex;
}

sub disp_2($$){
    my ($r0, $c0) = (shift, shift);
    my $p;
    my $not;
    my $hex;

    $hex = get_cell_shade($r0, $c0)->[1];
    $not = cell_index_rev($c0, $r0);

    $p = $board{$not};
    
    return sub_pi_str($p, $c0, $hex);
}

sub disp_3($$){
    my ($r0, $c0) = (shift, shift);
    my $hex;
    
    $hex = 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 ($s0, $s1, $s2, $r0, $c0) = @_;

    $s0 .= disp_1($r0, $c0);
    $s1 .= disp_2($r0, $c0);
    $s2 .= disp_3($r0, $c0);

    return ($s0, $s1, $s2);
}

sub disp_0($){
    my $r0;

    my ($s0, $s1, $s2);

    $r0 = shift;

    # 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) = add_cell($s0, $s1, $s2, $r0, $i);
    }
    
    return $s0."\n".$s1."\n".$s2."\n";
}

# Display row
#==================================================

sub disp_row($){
    my $row;
    my $r0;

    $r0 = shift;

    $row = 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 $b;
    
    for my $i (map {11-$_+1} (1..11)) {
	$b .= 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 ($not, $i0) = (shift, shift);
    return (split(/$DIV/, $board{$not}))[$i0];
}

sub cell_pi($){
    my $not = shift;
    return pi_split($not, 1);
}

sub cell_pl($){
    my $not = shift;
    return 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;

    ($r0, $c0) = cell_index($not);

    $r0 += $my_shift->[0];
    $c0 += $my_shift->[1];
    return $ERR_C_1 if $r0 > 11 or $c0 > 11 or $r0 < 1 or $c0 < 1;
    return cell_index_rev($r0, $c0);
}

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 get_mov($$){
    my ($pi, $en) = (shift, shift);

    my @mv1;

    @mv1 = grep {
	($_->{"type"} & $en) != 0
    } @{$MOVE{$pi}};

    return \@mv1;
}

sub find_all_mov($$){
    my ($not, $en) = (shift, shift);
    my $pi;
    my @mv1;

    $pi = cell_pi($not);
    @mv1 = @{ get_mov($pi, $en) };

    return grep {
	$_ if $_->[0] ne $ERR_C_1
    } map {
	[
	 calc_new_cell($not, $_->{"mov"}),
	 $_->{"type"}
	]
    } @mv1;
}

sub shade_pi_mvmt($$){
    my ($not, $en) = (shift, shift);
    my $c1;
    my @mv1;
    
    @mv1 = find_all_mov($not, $en);
    for my $mv (@mv1){
	apply_shade($mv->[0], $mv->[1]);
    }
}

sub shade_all_mvmt($$){
    my ($pl, $en) = (shift, shift);
    my @pi1;
    
    # $pl = shift;

    @pi1 = grep {
	cell_pl($_) eq $pl
    } keys(%board);

    for my $el (@pi1){
	shade_pi_mvmt($el, $en);
    }
}

sub shade_all_p1_mvmt($){
    shade_all_mvmt($P1, $MOVBLOCK_ENUM);
}

sub get_block_cell($){
    my $pl;

    $pl = shift;
    
    return map {
	$_->[0]
    } map {
	( find_all_mov($_, $BLOCK_ENUM) );
    } grep {
	cell_pl($_) eq $pl
    } 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, $apl) = (shift, shift, shift);

    my $i = 0;
    for my $s1 (uniq( [split(/ /, $s0)] )){
	$i++;
	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 = { @_ };

    # 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);

    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;