gashapwn
/
lpst
1
0
Bifurcation 0
Code Tickets 0 Demandes d'ajout 0 Versions 0 Wiki Activité
Implementation of Lucifers Pastime
Vous ne pouvez pas sélectionner plus de 25 sujets Les noms de sujets doivent commencer par une lettre ou un nombre, peuvent contenir des tirets ('-') et peuvent comporter jusqu'à 35 caractères.
25 Révisions
1 Branche
185KB
Aborescence: 0f942f4fb8
Branches Tags
${ item.name }
Créer la branche ${ searchTerm }
de '0f942f4fb8'
${ noResults }
lpst/lpst.pl

640 lignes
15KB
Brut Annotations Historique 

  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. 	    MoveStruct->new("mov" => [ 3, 0], "type" => $MOVE_ENUM),

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

  260.     ],

  261.     $MG_AU => [

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

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

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

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

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

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

  268.     ],

  269.     $MG_SY => [

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

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

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

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

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

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

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

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

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

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

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

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

  282.     ]

  283.     );

  284. 

  285. 

  286. my %sc = ();

  287. my %board;

  288. 

  289. # Display pieces

  290. #==================================================

  291. 

  292. # I hate this function

  293. sub f_1($$$){

  294.     my $p = shift;

  295.     my $c0 = shift;

  296.     my $hex = shift;

  297.     my $s0;

  298.     

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

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

  301.     $s0 = $hex;

  302. 

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

  304. 

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

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

  307.     }

  308. 

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

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

  311.     }

  312. 

  313.     return $s0;

  314. }

  315. 

  316. # Display shade

  317. #==================================================

  318. 

  319. sub shade_cell($$){

  320.     my $not = shift;

  321.     my $en = shift;

  322. 

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

  324. }

  325. 

  326. sub shade_t($){

  327.     my $not = shift;

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

  329.     return $EMPTY_ENUM;

  330. }

  331. 

  332. sub get_shade_chr($){

  333.     my $en = shift;

  334.     return $SHADE{$en};

  335. }

  336. 

  337. sub shade_lookup($$){

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

  339.     my $not;

  340.     

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

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

  343. }

  344. 

  345. 

  346. 

  347. 

  348. # Display lines

  349. #==================================================

  350. 

  351. sub disp_1($$){

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

  353.     my $hex;

  354. 

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

  356.     

  357.     return $hex;

  358.     # return $HEX_1;

  359. }

  360. 

  361. sub disp_2($$){

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

  363.     my $p;

  364.     my $not;

  365.     my $hex;

  366. 

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

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

  369. 

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

  371.     

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

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

  374.     # return $HEX_2;

  375. }

  376. 

  377. sub disp_3($$){

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

  379.     my $hex;

  380.     

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

  382.     

  383.     return $hex;

  384. }

  385. 

  386. sub disp_y_axis($$$$){

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

  388.     my $n0;

  389.     

  390.     $n0 = length($r0);

  391.     

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

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

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

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

  396. 

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

  398. }

  399. 

  400. # Display cell

  401. #==================================================

  402. 

  403. sub add_cell($$$$$){

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

  405. 

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

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

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

  409. 

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

  411. }

  412. 

  413. sub disp_0($){

  414.     my $r0;

  415. 

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

  417. 

  418.     $r0 = shift;

  419. 

  420.     # Append the y axis

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

  422. 

  423.     # Iterate through the cells

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

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

  426.     }

  427.     

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

  429. }

  430. 

  431. # Display row

  432. #==================================================

  433. 

  434. sub disp_row($){

  435.     my $row;

  436.     my $r0;

  437. 

  438.     $r0 = shift;

  439. 

  440.     $row = disp_0($r0);

  441. 

  442.     # Handle trailing characters

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

  444. 	# Trim the start of the first line

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

  446. 	# Trim the end of the first line

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

  448.     }else{

  449. 	# Trim the end of the last line

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

  451.     }

  452.     

  453.     return $row;

  454. }

  455. 

  456. sub disp_trailing_row(){

  457.     my $s0;

  458.     my $s1;

  459.     

  460.     $s0 = $PAD_EVEN.$PREF_1;

  461. 

  462.     # Clear some chars from

  463.     # our hex patterns

  464.     $s1 = $HEX_1;

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

  466. 

  467.     # Append hex pattern to

  468.     # trailing row

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

  470. 	$s0 .= $s1;

  471.     }

  472.     # Clear one last pair of

  473.     # chrs

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

  475.     $s0 .= "\n";

  476.     

  477.     return $s0;

  478. }

  479. 

  480. sub disp_x_axis(){

  481.     my $s0;

  482.     

  483.     $s0 = $PAD_AXIS;

  484.     $s0 .= join(

  485. 	$PAD_AXIS, map{

  486. 	    $AXIS_RV{$_}

  487. 	}(1..11));

  488.     $s0 .= "\n";

  489.     

  490.     $s0 .= $PAD_AXIS;

  491.     $s0 .= join(

  492. 	"", map{

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

  494. 	}(1..11));

  495.     $s0 .= "\n";

  496.     

  497.     return $s0

  498. }

  499. 

  500. # Display board

  501. #==================================================

  502. 

  503. sub disp_board(){

  504.     my $b;

  505.     

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

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

  508.     }

  509.     $b .= disp_trailing_row();

  510.     $b .= disp_x_axis();

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

  512. 

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

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

  515.     }

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

  517. }

  518. 

  519. 

  520. 

  521. 

  522. # Caclulate movement

  523. #==================================================

  524. sub cell_pi($){

  525.     my $not = shift;

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

  527. }

  528. 

  529. sub cell_pl($){

  530.     my $not = shift;

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

  532. }

  533. 

  534. sub cell_index_rev($$){

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

  536. }

  537. 

  538. sub cell_index($){

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

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

  541. }

  542. 

  543. sub apply_shift($$){

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

  545.     my $r0;

  546.     my $c0;

  547. 

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

  549. 

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

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

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

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

  554. }

  555. 

  556. sub calc_move($$){

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

  558.     my $r0;

  559.     my $c0;

  560.     

  561.     my $x_shift;

  562.     my $y_shift;

  563. 

  564.     my $n0;

  565.     my $ni;

  566.     

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

  568. 

  569.     # get y_shift

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

  571.     

  572.     # get x_shift

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

  574.     

  575.     # make x_shift adjustment

  576. 

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

  578.     # $ni *= -1;

  579. 

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

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

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

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

  584.     

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

  586. }

  587. 

  588. 

  589. 

  590. sub shade_move($$){

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

  592.     my $c1;

  593.     my @mv1;

  594. 

  595.     $c1 = cell_pi($not);

  596. 

  597.     @mv1 = grep {

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

  599.     } map {

  600. 	[

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

  602. 	 $_->{"type"}

  603. 	]

  604.     } grep {

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

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

  607.     

  608.     for my $mv (@mv1){

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

  610.     }

  611. }

  612. 

  613. # Main starts here!

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

  615. 

  616. # Creates a hash of the the form

  617. # $board{cell_notation} = piece_enum

  618. %board = map {

  619.     $_ => $EMPTY_CELL

  620. } map {

  621.     my $l0;

  622.     $l0 = $_;

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

  624. } map {

  625.     $AXIS_RV{$_}

  626. }(1...11);

  627. 

  628. my $m1 = "F7";

  629. # my $m1 = "A1";

  630. my $c1 = $MG_QS;

  631. 

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

  633. shade_move($m1, $MOVBLOCK_ENUM);

  634. 

  635. disp_board();

  636. 

  637. 

  638.