lpst/lpst.pl

#!/usr/bin/perl

use warnings;
use strict;


my $PAD_EVEN = "    ";
my $PAD_ODD =  "   ";

my $HEX_1 = '-/--\-';
my $HEX_2 = '| __ |';
my $HEX_3 = '|    |';

my $PREF_1 = '\-';
my $PREF_2 = '  ';
my $PREF_3 = '  ';

# Pieces
my $MG_A  =  0;  # Apprentice
my $MG_I  =  1;  # Iron Maiden
my $MG_N  =  2;  # Nekomata
my $MG_IT =  3;  # Ittan-Momen
my $MG_H  =  4;  # Harpy
my $MG_S  =  5;  # Slime
my $MG_RC =  6;  # Redcap
my $MG_RO =  7;  # Red Oni
my $MG_HS =  8;  # Holstaur
my $MG_B  =  9;  # Blue Oni
my $MG_P  = 10;  # Preistess
my $MG_IM = 11;  # Imp
my $MG_F  = 12;  # False Angel
my $MG_QS = 13;  # Queen slime
my $MG_AU = 14;  # Automaton
my $MG_SY = 15;  # Sylph
my $MG_Q  = 16;  # Queen

my %AXIS = (
    "A" => 1,
    "B" => 2,
    "C" => 3,
    "D" => 4,
    "E" => 5,
    "F" => 6,
    "G" => 7,
    "H" => 8,
    "I" => 9,
    "J" => 10,
    "K" => 11
    );

#
#     /--\ +1 
#    | __ |
#    |    |+1
#     \--/ 
#   -1 -1     
#

# [Row change, Col change]

my %MOVE = (
    $MG_A => [
	[-1, 1],
	[ 0, 1]
	],
	$MG_Q  => [
	    [ 0, 1],
	    [ 1, 0],
	    [-1, 0],
	    [ 0,-1],
	],
	$MG_I => [
	    [0,0]
	],
	$MG_IT => [
	    [ 0,-1],
	    [ 1,-1]
	],
	$MG_N  => [
	    [-1, 2],
	    [ 1,-2]
	],
	$MG_H  => [
	    [-3, 2],
	    [-1,-2],
	    [ 1, 2],
	    [ 3,-2]
	],
	$MG_RC => [
	    [-1, 0],
	    [-2, 0],
	    [ 0, 1],
	    [ 0, 2]
	],
	$MG_S  => [
	    [-1, 1],
	    [-2, 2],
	    [ 0, 1],
	    [ 0, 2],
	    [ 0,-1],
	    [ 0,-2],
	    [ 1,-1],
	    [ 2,-2],
	],
	$MG_HS => [
	    [-3, 1],
	    [-2,-1],
	    [ 2, 1],
	    [ 3,-1]
	],
	$MG_RO => [
	    [-1, 1],
	    [ 0, 1],
	    [ 1, 1],
	    [ 1,-2]
	],
	$MG_B  => [
	    [-1, 1],
	    [ 0, 1],
	    [ 0,-2],
	    [ 1,-2]
	],
	$MG_P  => [
	    [-4, 2],
	    [-2, 1],
	    [-2,-2],
	    [-1,-1],
	    [ 1, 1],
	    [ 2,-1],
	    [ 2, 2],
	    [ 4,-2]
	],
	$MG_IM => [
	    [-2, 1],
	    [-1,-1],
	    [-1, 2],
	    [ 1, 1],
	    [ 1,-1],
	    [ 1,-2],
	    [ 2,-1]
	],
	$MG_F  => [
	    [-1, 0],
	    [-1, 1],
	    [ 0, 1],
	    [ 0,-1],
	    [ 1, 0],
	    [ 1,-1]
	],
	$MG_QS => [
	    [-3, 3],
	    [-2, 2],
	    [-2, 0],
	    [-1, 0],
	    [-1, 1],
	    [ 0, 1],
	    [ 0, 2],
	    [ 0, 3],
	    [ 0,-1],
	    [ 0,-2],
	    [ 0,-3],
	    [ 1, 0],
	    [ 1,-1],
	    [ 2, 0],
	    [ 2,-2],
	    [ 3,-3],
	],
	$MG_AU => [
	    [-1, 0],
	    [-1, 1],
	    [ 0, 1],
	    [ 0,-1],
	    [ 1, 0],
	    [ 1,-1]
	],
	$MG_SY => [
	    [-4, 4],
	    [-3, 3],
	    [-3, 2],
	    [-1,-2],
	    [ 0,-2],
	    [ 0,-3],
	    [ 0, 3],
	    [ 0, 4],
	    [ 1, 2],
	    [ 3,-2],
	    [ 3,-3],
	    [ 4,-4]
	]
);

# Special cells
my $EMPTY_CELL = 900;

my %board;


sub disp_1(){
    return $HEX_1
}

sub disp_2(){
    return $HEX_2
}

sub disp_3(){
    return $HEX_3;
}

sub add_pad($$$$){
    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);
}

sub add_cell($$$$$){
    my ($s0, $s1, $s2, $r0, $c0) = @_;
    
    $s0 .= disp_1();
    $s1 .= disp_2();
    $s2 .= disp_3();

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

sub disp_0($){
    my $r0;

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

    $r0 = shift;

    ($s0, $s1, $s2) = add_pad($s0, $s1, $s2, $r0);
    for my $i (1..11){
	($s0, $s1, $s2) = add_cell($s0, $s1, $s2, $r0, $i);
    }
    
    return $s0."\n".$s1."\n".$s2."\n";
}

sub disp_row($){
    return disp_0(shift);
}

sub disp_board(){
    for my $i (map {11-$_+1} (1..11)) {
	printf("%s", disp_row($i));
    }
}
    

sub cell_index($){
    my ($chr1, $chr2) = (split(//, $_[0]));
    return ($AXIS{$chr1}, $chr2);
}

%board = map {
    $_ => $EMPTY_CELL
} map {
    my $l0;
    $l0 = $_;
    (map {$l0.$_} ("1".."11"))
} ("A".."K");

disp_board()

# disp_0("C1");

# printf(">>%s, %s\n", cell_index("C1"));