#!/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"));