#!/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 $ALT_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 main; # # /--\ +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 #================================================== # I hate this function sub f_1($$$){ my $p = shift; my $c0 = shift; my $hex = shift; my $s0; $p =~ s/($P1|$P2)$DIV//; $p .= "_" if length($p) < 2; $s0 = $hex; $s0 =~ s/$SUB_CHR{1,2}/$p/; 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 shade_cell($$){ my $not = shift; my $en = shift; $sc{$not} = $en unless (grep /^$not$/, keys(%sc)); } # TODO rename/rethink these 3 functions sub shade_t($){ my $not = shift; return $sc{$not} if (grep /^$not$/, keys(%sc)); return $EMPTY_ENUM; } sub get_shade_chr($){ my $en = shift; return $SHADE{$en}; } sub shade_lookup($$){ my ($r0, $c0) = (shift, shift); my $not; $not = cell_index_rev($c0, $r0); return get_shade_chr(shade_t($not)); } # Display lines #================================================== sub disp_1($$){ my ($r0, $c0) = (shift, shift); my $hex; $hex = shade_lookup($r0, $c0)->[0]; return $hex; # return $HEX_1; } sub disp_2($$){ my ($r0, $c0) = (shift, shift); my $p; my $not; my $hex; $hex = shade_lookup($r0, $c0)->[1]; $not = cell_index_rev($c0, $r0); $p = $board{$not}; return f_1($p, $c0, $hex); # my ($r0, $c0) = (shift, shift); # return $HEX_2; } sub disp_3($$){ my ($r0, $c0) = (shift, shift); my $hex; $hex = shade_lookup($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 #================================================== # TODO: rename / rethink these 4 functions sub gm1($){ my $not = shift; my $pi; $pi = cell_pi($not); if($pi){ return gm2($pi); } return (); } sub gm2(){ my $pi = shift; return grep { $_ if ($_->{"type"} & $MOVE_ENUM) eq $MOVE_ENUM } @{$MOVE{$pi}} } sub gb1($){ my $not = shift; my $pi; $pi = cell_pi($not); if($pi){ return gb2($pi); } return (); } sub gb2($){ my $pi = shift; return grep { $_ if ($_->{"type"} & $BLOCK_ENUM) eq $BLOCK_ENUM } @{$MOVE{$pi}} } sub not_split($$){ my ($not, $i0) = (shift, shift); return (split(/$DIV/, $board{$not}))[$i0]; } sub cell_pi($){ my $not = shift; return not_split($not, 1); } sub cell_pl($){ my $not = shift; return not_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); # my ($chr1, $chr2) = (split(//, $_[0])); 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_move($$){ my ($not, $mov) = (shift, shift); my $r0; my $c0; my $x_shift; my $y_shift; my $n0; my $ni; ($c0, $r0) = cell_index($not); # 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; # $ni *= -1; # moving down: $ni == -1 want value of 0 # moving up: $ni == +1 want value of 1 $n0 = ($r0 + (($ni + 1)/2) ) % 2; $x_shift += int(($y_shift + ($n0 * $ni)) / 2); return apply_shift($not, [$x_shift, $y_shift]); } sub find_all_mov($$){ return grep { $_ if $_->[0] ne $ERR_C_1; } map { [ calc_move($_[1], $_->{"mov"}), $_->{"type"} ] } @{$_[0]}; } sub shade_mvmt($$){ my ($not, $en) = (shift, shift); my $c1; my @mv1; $c1 = cell_pi($not); @mv1 = grep { ($_->{"type"} & $en) eq $_->{"type"} } @{$MOVE{$c1}}; @mv1 = find_all_mov(\@mv1, $not); for my $mv (@mv1){ shade_cell($mv->[0], $mv->[1]); } } sub get_block_cell(){ return map { $_->[0] } map { ( find_all_mov([gb1($_)], $_) ); } keys(%board); } # Main starts here! #================================================== binmode(STDOUT, ":utf8"); # 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); # my $m1 = "F7"; my $m1 = "C10"; my $m2 = "C3"; my $c1 = $MG_SY; my $c2 = $MG_A; $board{$m1} = $P1.$DIV.$c1; $board{$m2} = $P1.$DIV.$c2; for my $el (get_block_cell()){ printf("%s\n", $el); } shade_mvmt($m1, $MOVBLOCK_ENUM); disp_board();