#!/usr/bin/perl use warnings; use strict; my $PAD_AXIS = " "; my $PAD_EVEN = " "; my $PAD_ODD = " "; my $HEX_1 = '-/--\-'; my $HEX_2 = '| __ |'; my $HEX_3 = '| |'; my $SUB_CHR = "_"; 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_RO = "Hs"; # Red Oni my $MG_HS = "Ro"; # Holstaur 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 # Players my $P1 = "P1"; my $P2 = "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); # # /--\ +1 # | __ | # | |+1 # \--/ # -1 -1 # # [Row mvoe, Diag move] 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 = "_"; my %board; # Display pieces #================================================== sub f_1($){ my $p = shift; my $s0; $p =~ s/($P1|$P2)$DIV//; $p .= "_" if length($p) < 2; $s0 = $HEX_2; $s0 =~ s/$SUB_CHR{1,2}/$p/; return $s0; } # Display lines #================================================== sub disp_1($$){ my ($r0, $c0) = (shift, shift); return $HEX_1; } sub disp_2($$){ my ($r0, $c0) = (shift, shift); my $p; $p = $board{$r0}{$c0}; return f_1($p); # my ($r0, $c0) = (shift, shift); # return $HEX_2; } sub disp_3($$){ my ($r0, $c0) = (shift, shift); return $HEX_3; } 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"; 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); } sub cell_index($){ my ($chr1, $chr2) = (split(//, $_[0])); return ($AXIS{$chr1}, $chr2); } # 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); $board{"C3"} = $P1.$DIV.$MG_A; printf("%s\n", $board{"C3"}); # disp_board(); # disp_0("C1"); # printf(">>%s, %s\n", cell_index("C1"));