gashapwn
/
lpst
1
0
Fork 0
Código Issues 0 Pull requests 0 Versões 0 Wiki Atividade
Implementation of Lucifers Pastime
Você não pode selecionar mais de 25 tópicos Os tópicos devem começar com uma letra ou um número, podem incluir traços ('-') e podem ter até 35 caracteres.
23 Commits
1 Branch
185KB
Tag: 8dbc330d45
Branches Tags
${ item.name }
Criar branch ${ searchTerm }
de 8dbc330d45
${ noResults }
lpst/lpst.pl

643 linhas
15KB
Original Anotar Histórico 

  1. #!/usr/bin/perl

  2. 

  3. use warnings;

  4. use strict;

  5. 

  6. use utf8;

  7. 

  8. my $ARRAY = "ARRAY";

  9. 

  10. my $X_BOX_CHR = chr(0x2573);

  11. my $GRAY_BOX_CHR = chr(0x2591);

  12. my $ALT_US = chr(0x2017);

  13. my $ALT_PIPE = chr(0x2016);

  14. 

  15. my $SHADE_1_CHR = $GRAY_BOX_CHR;

  16. my $SHADE_2_CHR = $X_BOX_CHR;

  17. 

  18. my $PAD_AXIS = "     ";

  19. my $PAD_EVEN = "    ";

  20. my $PAD_ODD =  "   ";

  21. 

  22. my $HEX_1 = '-/--\-';

  23. my $HEX_2 = '| __ |';

  24. my $HEX_3 = '|    |';

  25. 

  26. my $HEX_S1_1 = '-/--\-';

  27. my $HEX_S1_2 = sprintf("|%s%s%s%s|", $SHADE_1_CHR, $SHADE_1_CHR, $SHADE_1_CHR, $SHADE_1_CHR);

  28. my $HEX_S1_3 = sprintf("|%s%s%s%s|", $SHADE_1_CHR, $SHADE_1_CHR, $SHADE_1_CHR, $SHADE_1_CHR);

  29. 

  30. my $HEX_S2_1 = '-/--\-';

  31. my $HEX_S2_2 = sprintf("|%s%s%s%s|", $SHADE_2_CHR, $SHADE_2_CHR, $SHADE_2_CHR, $SHADE_2_CHR);

  32. my $HEX_S2_3 = sprintf("|%s%s%s%s|", $SHADE_2_CHR, $SHADE_2_CHR, $SHADE_2_CHR, $SHADE_2_CHR);

  33. 

  34. my $HEX_S3_1 = '-/--\-';

  35. my $HEX_S3_2 = sprintf("|%s%s%s%s|", $SHADE_2_CHR, $SHADE_2_CHR, $SHADE_1_CHR, $SHADE_1_CHR);

  36. my $HEX_S3_3 = sprintf("|%s%s%s%s|", $SHADE_2_CHR, $SHADE_2_CHR, $SHADE_1_CHR, $SHADE_1_CHR);

  37. 

  38. my $HL_1 = "|____ ";

  39. my $HL_2 = $ALT_PIPE.$ALT_US.$ALT_US.$ALT_US.$ALT_US." ";

  40. 

  41. my $SUB_CHR = "_";

  42. my $ALT_SUB_CHR = "=";

  43. 

  44. my $BLANK_CELL_CHR = $ALT_US;

  45. 

  46. my $PREF_1 = substr($HEX_1, -2, 2);

  47. my $PREF_2 = '  ';

  48. my $PREF_3 = '  ';

  49. 

  50. my $TRAIL_1 = substr($HEX_1, 0, 1);

  51. my $TRAIL_2 = substr($HEX_1, -1, 1);

  52. my $TRAIL_3 = substr($HEX_1, 0, 2);

  53. 

  54. # Pieces

  55. my $MG_A  =  "A";   # Apprentice

  56. my $MG_I  =  "I";   # Iron Maiden

  57. my $MG_N  =  "N";   # Nekomata

  58. my $MG_IT =  "It";  # Ittan-Momen

  59. my $MG_H  =  "H";   # Harpy

  60. my $MG_S  =  "S";   # Slime

  61. my $MG_RC =  "Rc";  # Redcap

  62. my $MG_HS =  "Hs";  # Holstaur

  63. my $MG_RO =  "Ro";  # Red Oni

  64. my $MG_B  =  "B";   # Blue Oni

  65. my $MG_P  =  "P";   # Preistess

  66. my $MG_IM =  "Im";  # Imp

  67. my $MG_F  =  "F";   # False Angel

  68. my $MG_QS =  "Qs";  # Queen slime

  69. my $MG_AU =  "Au";  # Automaton

  70. my $MG_SY =  "Sy";  # Sylph

  71. my $MG_Q  =  "Q";   # Queen

  72. 

  73. # Players

  74. my $P1 = "P1";

  75. my $P2 = "P2";

  76. 

  77. my $DIV = ":";

  78. 

  79. my %AXIS = (

  80.     "A" => 1,

  81.     "B" => 2,

  82.     "C" => 3,

  83.     "D" => 4,

  84.     "E" => 5,

  85.     "F" => 6,

  86.     "G" => 7,

  87.     "H" => 8,

  88.     "I" => 9,

  89.     "J" => 10,

  90.     "K" => 11

  91.     );

  92. my %AXIS_RV = map {

  93.     $AXIS{$_} => $_

  94. } keys(%AXIS);

  95. 

  96. package MoveStruct;

  97. use warnings;

  98. use strict;

  99. 

  100. sub new {

  101.     my $class = shift;

  102.     my $self = { @_ };

  103.     

  104.     die "invalid MoveStruct {\"mov\"}" unless $self->{"mov"};

  105.     die "invalid MoveStruct ->{\"type\"}" unless $self->{"type"};

  106.     die "invalid MoveStruct type" unless ref($self->{"mov"}) eq $ARRAY;

  107. 

  108.     return bless $self, $class;

  109. }

  110. 

  111. package main;    

  112. 

  113. #

  114. #     /--\ +1 

  115. #    | __ |

  116. #    |    |+1

  117. #     \--/ 

  118. #   -1 -1     

  119. #

  120. 

  121. # ODD

  122. # UP: 0, +1

  123. # DOWN: -1, -1

  124. 

  125. # EVEN

  126. # UP: +1, +1

  127. # DOWN: +0, -1

  128. 

  129. # [Row move, Diag move]

  130. 

  131. # Special cells

  132. my $EMPTY_CELL = "_";

  133. 

  134. # Shade enum

  135. my $SHADE_3_ENUM = 0b011;

  136. my $SHADE_2_ENUM = 0b010;

  137. my $SHADE_1_ENUM = 0b001;

  138. my $EMPTY_ENUM = 0;

  139. 

  140. my %SHADE = (

  141.     $SHADE_1_ENUM => [$HEX_S1_1, $HEX_S1_2, $HEX_S1_3],

  142.     $SHADE_2_ENUM => [$HEX_S2_1, $HEX_S2_2, $HEX_S2_3],

  143.     $SHADE_3_ENUM => [$HEX_S3_1, $HEX_S3_2, $HEX_S3_3],

  144.     $EMPTY_ENUM  => [$HEX_1, $HEX_2, $HEX_3]

  145.     );

  146. 

  147. my $MOVE_ENUM = $SHADE_1_ENUM;   

  148. my $BLOCK_ENUM = $SHADE_2_ENUM; 

  149. my $MOVBLOCK_ENUM = $SHADE_3_ENUM;   

  150. 

  151. my $ERR_C_1 = -1;

  152. 

  153. my %MOVE = (

  154.     $MG_A => [

  155. 	MoveStruct->new("mov" => [-1, 1], "type" => $MOVE_ENUM),

  156. 	MoveStruct->new("mov" => [ 0, 1], "type" => $MOVE_ENUM)

  157. 	],

  158.     $MG_Q  => [

  159. 	MoveStruct->new("mov" => [ 0, 1], "type" => $MOVE_ENUM),

  160. 	MoveStruct->new("mov" => [ 1, 0], "type" => $MOVE_ENUM),

  161. 	MoveStruct->new("mov" => [-1, 0], "type" => $MOVE_ENUM),

  162. 	MoveStruct->new("mov" => [ 0,-1], "type" => $MOVE_ENUM)

  163.     ],

  164.     $MG_I => [

  165. 	MoveStruct->new("mov" => [0,0], "type" => $MOVE_ENUM)

  166.     ],

  167.     $MG_IT => [

  168. 	MoveStruct->new("mov" => [ 0,-1], "type" => $MOVE_ENUM),

  169. 	MoveStruct->new("mov" => [ 1,-1], "type" => $MOVE_ENUM)

  170.     ],

  171.     $MG_N  => [

  172. 	MoveStruct->new("mov" => [-1, 2], "type" => $MOVE_ENUM),

  173. 	MoveStruct->new("mov" => [ 1,-2], "type" => $MOVE_ENUM)

  174.     ],

  175.     $MG_H  => [

  176. 	MoveStruct->new("mov" => [-3, 2], "type" => $MOVE_ENUM),

  177. 	MoveStruct->new("mov" => [-1,-2], "type" => $MOVE_ENUM),

  178. 	MoveStruct->new("mov" => [ 1, 2], "type" => $MOVE_ENUM),

  179. 	MoveStruct->new("mov" => [ 3,-2], "type" => $MOVE_ENUM)

  180.     ],

  181.     $MG_RC => [

  182. 	MoveStruct->new("mov" => [-1, 0], "type" => $MOVE_ENUM),

  183. 	MoveStruct->new("mov" => [-2, 0], "type" => $MOVE_ENUM),

  184. 	MoveStruct->new("mov" => [ 1, 0], "type" => $MOVE_ENUM),

  185. 	MoveStruct->new("mov" => [ 2, 0], "type" => $MOVE_ENUM)

  186.     ],

  187.     $MG_S  => [

  188. 	MoveStruct->new("mov" => [-1, 1], "type" => $MOVE_ENUM),

  189. 	MoveStruct->new("mov" => [-2, 2], "type" => $MOVE_ENUM),

  190. 	MoveStruct->new("mov" => [ 0, 1], "type" => $MOVE_ENUM),

  191. 	MoveStruct->new("mov" => [ 0, 2], "type" => $MOVE_ENUM),

  192. 	MoveStruct->new("mov" => [ 0,-1], "type" => $MOVE_ENUM),

  193. 	MoveStruct->new("mov" => [ 0,-2], "type" => $MOVE_ENUM),

  194. 	MoveStruct->new("mov" => [ 1,-1], "type" => $MOVE_ENUM),

  195. 	MoveStruct->new("mov" => [ 2,-2], "type" => $MOVE_ENUM),

  196.     ],

  197.     $MG_HS => [

  198. 	MoveStruct->new("mov" => [-3, 1], "type" => $MOVE_ENUM),

  199. 	MoveStruct->new("mov" => [-2,-1], "type" => $MOVE_ENUM),

  200. 	MoveStruct->new("mov" => [ 2, 1], "type" => $MOVE_ENUM),

  201. 	MoveStruct->new("mov" => [ 3,-1], "type" => $MOVE_ENUM)

  202.     ],

  203.     $MG_RO => [

  204. 	MoveStruct->new("mov" => [-1, 1], "type" => $MOVE_ENUM),

  205. 	MoveStruct->new("mov" => [ 0, 1], "type" => $MOVE_ENUM),

  206. 	MoveStruct->new("mov" => [ 1, 1], "type" => $MOVE_ENUM),

  207. 	MoveStruct->new("mov" => [ 1,-2], "type" => $MOVE_ENUM)

  208.     ],

  209.     $MG_B  => [

  210. 	MoveStruct->new("mov" => [-1, 1], "type" => $MOVE_ENUM),

  211. 	MoveStruct->new("mov" => [ 0, 1], "type" => $MOVE_ENUM),

  212. 	MoveStruct->new("mov" => [ 0,-2], "type" => $MOVE_ENUM),

  213. 	MoveStruct->new("mov" => [ 2,-2], "type" => $MOVE_ENUM)

  214.     ],

  215.     $MG_P  => [

  216. 	MoveStruct->new("mov" => [-4, 2], "type" => $MOVE_ENUM),

  217. 	MoveStruct->new("mov" => [-2, 1], "type" => $MOVE_ENUM),

  218. 	MoveStruct->new("mov" => [-2,-2], "type" => $MOVE_ENUM),

  219. 	MoveStruct->new("mov" => [-1,-1], "type" => $MOVE_ENUM),

  220. 	MoveStruct->new("mov" => [ 1, 1], "type" => $MOVE_ENUM),

  221. 	MoveStruct->new("mov" => [ 2,-1], "type" => $MOVE_ENUM),

  222. 	MoveStruct->new("mov" => [ 2, 2], "type" => $MOVE_ENUM),

  223. 	MoveStruct->new("mov" => [ 4,-2], "type" => $MOVE_ENUM)

  224.     ],

  225.     $MG_IM => [

  226. 	MoveStruct->new("mov" => [-2, 1], "type" => $MOVE_ENUM),

  227. 	MoveStruct->new("mov" => [-1,-1], "type" => $MOVE_ENUM),

  228. 	MoveStruct->new("mov" => [-1, 2], "type" => $MOVE_ENUM),

  229. 	MoveStruct->new("mov" => [ 1, 1], "type" => $MOVE_ENUM),

  230. 	MoveStruct->new("mov" => [ 1,-1], "type" => $MOVE_ENUM),

  231. 	MoveStruct->new("mov" => [ 2,-1], "type" => $MOVE_ENUM)

  232.     ],

  233.     $MG_F  => [

  234. 	MoveStruct->new("mov" => [-1, 0], "type" => $MOVE_ENUM),

  235. 	MoveStruct->new("mov" => [-1, 1], "type" => $MOVE_ENUM),

  236. 	MoveStruct->new("mov" => [ 0, 1], "type" => $MOVE_ENUM),

  237. 	MoveStruct->new("mov" => [ 0,-1], "type" => $MOVE_ENUM),

  238. 	MoveStruct->new("mov" => [ 1, 0], "type" => $MOVE_ENUM),

  239. 	MoveStruct->new("mov" => [ 1,-1], "type" => $MOVE_ENUM)

  240.     ],

  241. 	$MG_QS => [

  242. 	    MoveStruct->new("mov" => [-3, 3], "type" => $MOVE_ENUM),

  243. 	    MoveStruct->new("mov" => [-2, 2], "type" => $MOVE_ENUM),

  244. 	    MoveStruct->new("mov" => [-2, 0], "type" => $MOVE_ENUM),

  245. 	    MoveStruct->new("mov" => [-1, 0], "type" => $MOVE_ENUM),

  246. 	    MoveStruct->new("mov" => [-1, 1], "type" => $MOVE_ENUM),

  247. 	    MoveStruct->new("mov" => [ 0, 1], "type" => $MOVE_ENUM),

  248. 	    MoveStruct->new("mov" => [ 0, 2], "type" => $MOVE_ENUM),

  249. 	    MoveStruct->new("mov" => [ 0, 3], "type" => $MOVE_ENUM),

  250. 	    MoveStruct->new("mov" => [ 0,-1], "type" => $MOVE_ENUM),

  251. 	    MoveStruct->new("mov" => [ 0,-2], "type" => $MOVE_ENUM),

  252. 	    MoveStruct->new("mov" => [ 0,-3], "type" => $MOVE_ENUM),

  253. 	    MoveStruct->new("mov" => [ 1, 0], "type" => $MOVE_ENUM),

  254. 	    MoveStruct->new("mov" => [ 1,-1], "type" => $MOVE_ENUM),

  255. 	    MoveStruct->new("mov" => [ 2, 0], "type" => $MOVE_ENUM),

  256. 	    MoveStruct->new("mov" => [ 2,-2], "type" => $MOVE_ENUM),

  257. 	    MoveStruct->new("mov" => [ 3,-3], "type" => $MOVE_ENUM)

  258. 	],

  259. 	$MG_AU => [

  260. 	    MoveStruct->new("mov" => [-1, 0], "type" => $MOVE_ENUM),

  261. 	    MoveStruct->new("mov" => [-1, 1], "type" => $MOVE_ENUM),

  262. 	    MoveStruct->new("mov" => [ 0, 1], "type" => $MOVE_ENUM),

  263. 	    MoveStruct->new("mov" => [ 0,-1], "type" => $MOVE_ENUM),

  264. 	    MoveStruct->new("mov" => [ 1, 0], "type" => $MOVE_ENUM),

  265. 	    MoveStruct->new("mov" => [ 1,-1], "type" => $MOVE_ENUM)

  266.     ],

  267. 	$MG_SY => [

  268. 	    MoveStruct->new("mov" => [-4, 4], "type" => $MOVE_ENUM),

  269. 	    MoveStruct->new("mov" => [-3, 3], "type" => $MOVE_ENUM),

  270. 	    MoveStruct->new("mov" => [-3, 2], "type" => $MOVE_ENUM),

  271. 	    MoveStruct->new("mov" => [-1,-2], "type" => $MOVE_ENUM),

  272. 	    MoveStruct->new("mov" => [ 0,-4], "type" => $MOVE_ENUM),

  273. 	    MoveStruct->new("mov" => [ 0,-3], "type" => $MOVE_ENUM),

  274. 	    MoveStruct->new("mov" => [ 0, 3], "type" => $MOVE_ENUM),

  275. 	    MoveStruct->new("mov" => [ 0, 4], "type" => $MOVE_ENUM),

  276. 	    MoveStruct->new("mov" => [ 1, 2], "type" => $MOVE_ENUM),

  277. 	    MoveStruct->new("mov" => [ 3,-2], "type" => $MOVE_ENUM),

  278. 	    MoveStruct->new("mov" => [ 3,-3], "type" => $MOVE_ENUM),

  279. 	    MoveStruct->new("mov" => [ 4,-4], "type" => $MOVE_ENUM)

  280.     ]

  281.     );

  282. 

  283. 

  284. my %sc = ();

  285. my %board;

  286. 

  287. # Display pieces

  288. #==================================================

  289. 

  290. # I hate this function

  291. sub f_1($$$){

  292.     my $p = shift;

  293.     my $c0 = shift;

  294.     my $hex = shift;

  295.     my $s0;

  296.     

  297.     $p =~ s/($P1|$P2)$DIV//;

  298.     $p .= "_" if length($p) < 2;

  299.     $s0 = $hex;

  300. 

  301.     $s0 =~ s/$SUB_CHR{1,2}/$p/;

  302. 

  303.     unless($p eq "__"){

  304. 	substr($s0, 2,2) = $p;

  305.     }

  306. 

  307.     if($c0 % 2 == 0){

  308. 	$s0 =~ s/$SUB_CHR/$BLANK_CELL_CHR/g;

  309.     }

  310. 

  311.     return $s0;

  312. }

  313. 

  314. # Display shade

  315. #==================================================

  316. 

  317. sub shade_cell($$){

  318.     my $not = shift;

  319.     my $en = shift;

  320. 

  321.     $sc{$not} = $en unless (grep /^$not$/, keys(%sc));

  322. }

  323. 

  324. sub shade_t($){

  325.     my $not = shift;

  326.     return $sc{$not} if (grep /^$not$/, keys(%sc));

  327.     return $EMPTY_ENUM;

  328. }

  329. 

  330. sub get_shade_chr($){

  331.     my $en = shift;

  332.     return $SHADE{$en};

  333. }

  334. 

  335. sub shade_lookup($$){

  336.     my ($r0, $c0) = (shift, shift);

  337.     my $not;

  338.     

  339.     $not = cell_index_rev($c0, $r0);

  340.     return get_shade_chr(shade_t($not));

  341. }

  342. 

  343. 

  344. 

  345. 

  346. # Display lines

  347. #==================================================

  348. 

  349. sub disp_1($$){

  350.     my ($r0, $c0) = (shift, shift);

  351.     my $hex;

  352. 

  353.     $hex = shade_lookup($r0, $c0)->[0];

  354.     

  355.     return $hex;

  356.     # return $HEX_1;

  357. }

  358. 

  359. sub disp_2($$){

  360.     my ($r0, $c0) = (shift, shift);

  361.     my $p;

  362.     my $not;

  363.     my $hex;

  364. 

  365.     $hex = shade_lookup($r0, $c0)->[1];

  366.     $not = cell_index_rev($c0, $r0);

  367. 

  368.     $p = $board{$not};

  369.     

  370.     return f_1($p, $c0, $hex);

  371.     # my ($r0, $c0) = (shift, shift);

  372.     # return $HEX_2;

  373. }

  374. 

  375. sub disp_3($$){

  376.     my ($r0, $c0) = (shift, shift);

  377.     my $hex;

  378.     

  379.     $hex = shade_lookup($r0, $c0)->[2];

  380.     

  381.     return $hex;

  382. }

  383. 

  384. sub disp_y_axis($$$$){

  385.     my ($s0, $s1, $s2, $r0) = @_;

  386.     my $n0;

  387.     

  388.     $n0 = length($r0);

  389.     

  390.     $s0 = $r0 % 2 == 1 ? $PAD_ODD : $PAD_EVEN.$PREF_1;

  391.     $s1 = $r0 % 2 == 1 ? $PAD_ODD : $PAD_EVEN.$PREF_2;

  392.     $s1 =~ s/^ {$n0}/$r0/;

  393.     $s2 = $r0 % 2 == 1 ? $PAD_ODD : $PAD_EVEN.$PREF_3;

  394. 

  395.     return ($s0, $s1, $s2);

  396. }

  397. 

  398. # Display cell

  399. #==================================================

  400. 

  401. sub add_cell($$$$$){

  402.     my ($s0, $s1, $s2, $r0, $c0) = @_;

  403. 

  404.     $s0 .= disp_1($r0, $c0);

  405.     $s1 .= disp_2($r0, $c0);

  406.     $s2 .= disp_3($r0, $c0);

  407. 

  408.     return ($s0, $s1, $s2);

  409. }

  410. 

  411. sub disp_0($){

  412.     my $r0;

  413. 

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

  415. 

  416.     $r0 = shift;

  417. 

  418.     # Append the y axis

  419.     ($s0, $s1, $s2) = disp_y_axis($s0, $s1, $s2, $r0);

  420. 

  421.     # Iterate through the cells

  422.     for my $i (1..11){

  423. 	($s0, $s1, $s2) = add_cell($s0, $s1, $s2, $r0, $i);

  424.     }

  425.     

  426.     return $s0."\n".$s1."\n".$s2."\n";

  427. }

  428. 

  429. # Display row

  430. #==================================================

  431. 

  432. sub disp_row($){

  433.     my $row;

  434.     my $r0;

  435. 

  436.     $r0 = shift;

  437. 

  438.     $row = disp_0($r0);

  439. 

  440.     # Handle trailing characters

  441.     if($r0 % 2 == 1){

  442. 	# Trim the start of the first line

  443. 	$row =~ s/$TRAIL_1/ /;

  444. 	# Trim the end of the first line

  445. 	$row =~ s/\n/$TRAIL_3\n/

  446.     }else{

  447. 	# Trim the end of the last line

  448. 	$row =~ s/$TRAIL_2\n/ \n/m;

  449.     }

  450.     

  451.     return $row;

  452. }

  453. 

  454. sub disp_trailing_row(){

  455.     my $s0;

  456.     my $s1;

  457.     

  458.     $s0 = $PAD_EVEN.$PREF_1;

  459. 

  460.     # Clear some chars from

  461.     # our hex patterns

  462.     $s1 = $HEX_1;

  463.     substr($s1, 2,2) = "  ";

  464. 

  465.     # Append hex pattern to

  466.     # trailing row

  467.     for my $i (1..11){	

  468. 	$s0 .= $s1;

  469.     }

  470.     # Clear one last pair of

  471.     # chrs

  472.     substr($s0, -2,2) = "  ";

  473.     $s0 .= "\n";

  474.     

  475.     return $s0;

  476. }

  477. 

  478. sub disp_x_axis(){

  479.     my $s0;

  480.     

  481.     $s0 = $PAD_AXIS;

  482.     $s0 .= join(

  483. 	$PAD_AXIS, map{

  484. 	    $AXIS_RV{$_}

  485. 	}(1..11));

  486.     $s0 .= "\n";

  487.     

  488.     $s0 .= $PAD_AXIS;

  489.     $s0 .= join(

  490. 	"", map{

  491. 	    $_ % 2 == 1 ? $HL_1 : $HL_2

  492. 	}(1..11));

  493.     $s0 .= "\n";

  494.     

  495.     return $s0

  496. }

  497. 

  498. # Display board

  499. #==================================================

  500. 

  501. sub disp_board(){

  502.     my $b;

  503.     

  504.     for my $i (map {11-$_+1} (1..11)) {

  505. 	$b .= disp_row($i);

  506.     }

  507.     $b .= disp_trailing_row();

  508.     $b .= disp_x_axis();

  509.     $b =~ s/$TRAIL_1$TRAIL_3\n/\n/m;

  510. 

  511.     for my $i (1..11-1){

  512. 	substr($b, 2+6*$i, 2) = "  ";

  513.     }

  514.     printf("%s", $b);

  515. }

  516. 

  517. 

  518. 

  519. 

  520. # Caclulate movement

  521. #==================================================

  522. sub cell_pi($){

  523.     my $not = shift;

  524.     return (split(/$DIV/, $board{$not}))[1]

  525. }

  526. 

  527. sub cell_pl($){

  528.     my $not = shift;

  529.     return (split(/$DIV/, $board{$not}))[0]

  530. }

  531. 

  532. sub cell_index_rev($$){

  533.     return $AXIS_RV{$_[0]}.$_[1];

  534. }

  535. 

  536. sub cell_index($){

  537.     my ($chr1, $chr2) = (split(//, $_[0]));

  538.     return ($AXIS{$chr1}, $chr2);

  539. }

  540. 

  541. sub apply_shift($$){

  542.     my ($not, $my_shift) = (shift, shift);

  543.     my $r0;

  544.     my $c0;

  545. 

  546.     ($r0, $c0) = cell_index($not);

  547. 

  548.     $r0 += $my_shift->[0];

  549.     $c0 += $my_shift->[1];

  550.     return $ERR_C_1 if $r0 > 11 or $c0 > 11 or $r0 < 1 or $c0 < 1;

  551.     return cell_index_rev($r0, $c0);

  552. }

  553. 

  554. sub calc_move($$){

  555.     my ($not, $mov) = (shift, shift);

  556.     my $r0;

  557.     my $c0;

  558.     

  559.     my $x_shift;

  560.     my $y_shift;

  561. 

  562.     my $n0;

  563.     my $ni;

  564.     

  565.     ($c0, $r0) = cell_index($not);

  566. 

  567.     # get y_shift

  568.     $y_shift = $mov->[1];

  569.     

  570.     # get x_shift

  571.     $x_shift = $mov->[0];

  572.     

  573.     # make x_shift adjustment

  574. 

  575.     $ni = $y_shift != 0 ? ($y_shift / abs($y_shift)) : 1;

  576.     # $ni *= -1;

  577. 

  578.     # moving down: $ni == -1 want value of 0

  579.     # moving up: $ni == +1  want value of 1

  580.     $n0 = ($r0 + (($ni + 1)/2) ) % 2;

  581.     $x_shift += int(($y_shift + ($n0 * $ni)) / 2);

  582.     

  583.     return apply_shift($not, [$x_shift, $y_shift]);

  584. }

  585. 

  586. 

  587. 

  588. sub shade_move($$){

  589.     my ($not, $en) = (shift, shift);

  590.     my $c1;

  591.     my @mv1;

  592.     my @mv2;

  593. 

  594.     $c1 = cell_pi($not);

  595. 

  596.     @mv1 = map {

  597. 	$_

  598.     } grep {

  599. 	($_->{"type"} && $en) eq $en

  600.     }@{$MOVE{$c1}};

  601. 

  602.     @mv2 = grep {

  603. 	$_ if $_->[0] ne $ERR_C_1;

  604.     } map {

  605. 	[

  606. 	 calc_move($not, $_->{"mov"}),

  607. 	 $_->{"type"}

  608. 	]

  609.     } @mv1;

  610.     

  611.     for my $mv (@mv2){

  612. 	shade_cell($mv->[0], $mv->[1]);

  613.     }

  614. }

  615. 

  616. # Main starts here!

  617. binmode(STDOUT, ":utf8");

  618. 

  619. # Creates a hash of the the form

  620. # $board{cell_notation} = piece_enum

  621. %board = map {

  622.     $_ => $EMPTY_CELL

  623. } map {

  624.     my $l0;

  625.     $l0 = $_;

  626.     (map {$l0.$_} ("1".."11"))

  627. } map {

  628.     $AXIS_RV{$_}

  629. }(1...11);

  630. 

  631. # my $m1 = "F7";

  632. my $m1 = "A1";

  633. my $c1 = $MG_QS;

  634. 

  635. $board{$m1} = $P1.$DIV.$c1;

  636. shade_move($m1, $MOVE_ENUM);

  637. 

  638. disp_board();

  639. 

  640. 

  641.