|
- #!/usr/bin/perl
-
- use warnings;
- use strict;
-
- use utf8;
-
- my $ARRAY = "ARRAY";
-
- 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
-
- # 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);
-
- 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 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 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;
-
-
-
-
|