gashapwn
/
lpst
1
0
Fork 0
Código Incidencias 0 Pull Requests 0 Lanzamientos 0 Wiki Actividad
Implementation of Lucifers Pastime
No puede seleccionar más de 25 temas Los temas deben comenzar con una letra o número, pueden incluir guiones ('-') y pueden tener hasta 35 caracteres de largo.
29 Commits
1 Rama
185KB
Árbol: efb3e9ec1e
Ramas Etiquetas
${ item.name }
Crear rama ${ searchTerm }
desde 'efb3e9ec1e'
${ noResults }
lpst/lpst.pl

745 líneas
19KB
Original Blame 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. 

  43. my $BLANK_CELL_CHR = $ALT_US;

  44. 

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

  46. my $PREF_2 = '  ';

  47. my $PREF_3 = '  ';

  48. 

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

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

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

  52. 

  53. # Pieces

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  71. 

  72. # Players

  73. my $P1 = "P1";

  74. my $P2 = "P2";

  75. 

  76. my $DIV = ":";

  77. 

  78. my %AXIS = (

  79.     "A" => 1,

  80.     "B" => 2,

  81.     "C" => 3,

  82.     "D" => 4,

  83.     "E" => 5,

  84.     "F" => 6,

  85.     "G" => 7,

  86.     "H" => 8,

  87.     "I" => 9,

  88.     "J" => 10,

  89.     "K" => 11

  90.     );

  91. my %AXIS_RV = map {

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

  93. } keys(%AXIS);

  94. 

  95. package MoveStruct;

  96. use warnings;

  97. use strict;

  98. 

  99. sub new {

  100.     my $class = shift;

  101.     my $self = { @_ };

  102.     

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

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

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

  106. 

  107.     return bless $self, $class;

  108. }

  109. 

  110. package main;    

  111. 

  112. #

  113. #     /--\ +1 

  114. #    | __ |

  115. #    |    |+1

  116. #     \--/ 

  117. #   -1 -1     

  118. #

  119. 

  120. # ODD

  121. # UP: 0, +1

  122. # DOWN: -1, -1

  123. 

  124. # EVEN

  125. # UP: +1, +1

  126. # DOWN: +0, -1

  127. 

  128. # [Row move, Diag move]

  129. 

  130. # Special cells

  131. my $EMPTY_CELL = "_";

  132. 

  133. # Shade enum

  134. my $SHADE_3_ENUM = 0b011;

  135. my $SHADE_2_ENUM = 0b010;

  136. my $SHADE_1_ENUM = 0b001;

  137. my $EMPTY_ENUM = 0;

  138. 

  139. my %SHADE = (

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

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

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

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

  144.     );

  145. 

  146. my $MOVE_ENUM = $SHADE_1_ENUM;   

  147. my $BLOCK_ENUM = $SHADE_2_ENUM; 

  148. my $MOVBLOCK_ENUM = $SHADE_3_ENUM;   

  149. 

  150. my $ERR_C_1 = -1;

  151. 

  152. my %MOVE = (

  153.     $MG_A => [

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

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

  156. 	],

  157.     $MG_Q  => [

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

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

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

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

  162.     ],

  163.     $MG_I => [

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

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

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

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

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

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

  170.     ],

  171.     $MG_IT => [

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

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

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

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

  176.     ],

  177.     $MG_N  => [

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

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

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

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

  182.     ],

  183.     $MG_H  => [

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

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

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

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

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

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

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

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

  192.     ],

  193.     $MG_RC => [

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

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

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

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

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

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

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

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

  202.     ],

  203.     $MG_S  => [

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

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

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

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

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

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

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

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

  212.     ],

  213.     $MG_HS => [

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

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

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

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

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

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

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

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

  222.     ],

  223.     $MG_RO => [

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

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

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

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

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

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

  230.     ],

  231.     $MG_B  => [

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

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

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

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

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

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

  238.     ],

  239.     $MG_P  => [

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

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

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

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

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

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

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

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

  248.     ],

  249.     $MG_IM => [

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

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

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

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

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

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

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

  257.     ],

  258.     $MG_F  => [

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

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

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

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

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

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

  265. 	

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

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

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

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

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

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

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

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

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

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

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

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

  278.     ],

  279.     $MG_QS => [

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  298.     ],

  299.     $MG_AU => [

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  316.     ],

  317.     $MG_SY => [

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  334.     ]

  335.     );

  336. 

  337. 

  338. my %sc = ();

  339. my %board;

  340. 

  341. # Display pieces

  342. #==================================================

  343. 

  344. sub get_pi_str($){

  345.     my $p = shift;

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

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

  348.     return $p;

  349. }

  350. 

  351. sub sub_pi_str($$$){

  352.     my ($p, $c0, $hex) = (shift, shift, shift);

  353.     my $s0;

  354. 

  355.     $p = get_pi_str($p);

  356.     $s0 = $hex;

  357.     

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

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

  360.     }

  361.     

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

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

  364.     }

  365. 

  366.     return $s0;

  367. }

  368. 

  369. # Display shade

  370. #==================================================

  371. 

  372. sub shade_cell($$){

  373.     my $not = shift;

  374.     my $en = shift;

  375. 

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

  377. }

  378. 

  379. # TODO rename/rethink these 3 functions

  380. sub shade_t($){

  381.     my $not = shift;

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

  383.     return $EMPTY_ENUM;

  384. }

  385. 

  386. sub get_shade_chr($){

  387.     my $en = shift;

  388.     return $SHADE{$en};

  389. }

  390. 

  391. sub shade_lookup($$){

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

  393.     my $not;

  394.     

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

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

  397. }

  398. 

  399. 

  400. 

  401. 

  402. # Display lines

  403. #==================================================

  404. 

  405. sub disp_1($$){

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

  407.     my $hex;

  408. 

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

  410.     

  411.     return $hex;

  412.     # return $HEX_1;

  413. }

  414. 

  415. sub disp_2($$){

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

  417.     my $p;

  418.     my $not;

  419.     my $hex;

  420. 

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

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

  423. 

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

  425.     

  426.     return sub_pi_str($p, $c0, $hex);

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

  428.     # return $HEX_2;

  429. }

  430. 

  431. sub disp_3($$){

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

  433.     my $hex;

  434.     

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

  436.     

  437.     return $hex;

  438. }

  439. 

  440. sub disp_y_axis($$$$){

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

  442.     my $n0;

  443.     

  444.     $n0 = length($r0);

  445.     

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

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

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

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

  450. 

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

  452. }

  453. 

  454. # Display cell

  455. #==================================================

  456. 

  457. sub add_cell($$$$$){

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

  459. 

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

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

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

  463. 

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

  465. }

  466. 

  467. sub disp_0($){

  468.     my $r0;

  469. 

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

  471. 

  472.     $r0 = shift;

  473. 

  474.     # Append the y axis

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

  476. 

  477.     # Iterate through the cells

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

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

  480.     }

  481.     

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

  483. }

  484. 

  485. # Display row

  486. #==================================================

  487. 

  488. sub disp_row($){

  489.     my $row;

  490.     my $r0;

  491. 

  492.     $r0 = shift;

  493. 

  494.     $row = disp_0($r0);

  495. 

  496.     # Handle trailing characters

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

  498. 	# Trim the start of the first line

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

  500. 	# Trim the end of the first line

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

  502.     }else{

  503. 	# Trim the end of the last line

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

  505.     }

  506.     

  507.     return $row;

  508. }

  509. 

  510. sub disp_trailing_row(){

  511.     my $s0;

  512.     my $s1;

  513.     

  514.     $s0 = $PAD_EVEN.$PREF_1;

  515. 

  516.     # Clear some chars from

  517.     # our hex patterns

  518.     $s1 = $HEX_1;

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

  520. 

  521.     # Append hex pattern to

  522.     # trailing row

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

  524. 	$s0 .= $s1;

  525.     }

  526.     # Clear one last pair of

  527.     # chrs

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

  529.     $s0 .= "\n";

  530.     

  531.     return $s0;

  532. }

  533. 

  534. sub disp_x_axis(){

  535.     my $s0;

  536.     

  537.     $s0 = $PAD_AXIS;

  538.     $s0 .= join(

  539. 	$PAD_AXIS, map{

  540. 	    $AXIS_RV{$_}

  541. 	}(1..11));

  542.     $s0 .= "\n";

  543.     

  544.     $s0 .= $PAD_AXIS;

  545.     $s0 .= join(

  546. 	"", map{

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

  548. 	}(1..11));

  549.     $s0 .= "\n";

  550.     

  551.     return $s0

  552. }

  553. 

  554. # Display board

  555. #==================================================

  556. 

  557. sub disp_board(){

  558.     my $b;

  559.     

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

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

  562.     }

  563.     $b .= disp_trailing_row();

  564.     $b .= disp_x_axis();

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

  566. 

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

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

  569.     }

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

  571. }

  572. 

  573. 

  574. 

  575. 

  576. # Caclulate movement

  577. #==================================================

  578. sub pi_split($$){

  579.     my ($not, $i0) = (shift, shift);

  580.     return (split(/$DIV/, $board{$not}))[$i0];

  581. }

  582. 

  583. sub cell_pi($){

  584.     my $not = shift;

  585.     return pi_split($not, 1);

  586. }

  587. 

  588. sub cell_pl($){

  589.     my $not = shift;

  590.     return pi_split($not, 0);

  591. }

  592. 

  593. sub cell_index_rev($$){

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

  595. }

  596. 

  597. sub cell_index($){

  598.     my $chr1 = substr($_[0], 0,1);

  599.     my $chr2 = substr($_[0], 1,length($_[0])-1);

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

  601. }

  602. 

  603. sub apply_shift($$){

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

  605.     my $r0;

  606.     my $c0;

  607. 

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

  609. 

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

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

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

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

  614. }

  615. 

  616. sub calc_new_cell($$){

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

  618.     my ($c0, $r0) = cell_index($not);

  619.     

  620.     my $x_shift;

  621.     my $y_shift;

  622. 

  623.     my $n0;

  624.     my $ni;

  625. 

  626.     # get y_shift

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

  628.     

  629.     # get x_shift

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

  631.     

  632.     # make x_shift adjustment

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

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

  635.     

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

  637. 

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

  639. }

  640. 

  641. sub get_mov($$){

  642.     my ($pi, $en) = (shift, shift);

  643. 

  644.     my @mv1;

  645. 

  646.     @mv1 = grep {

  647. 	($_->{"type"} & $en) != 0

  648.     } @{$MOVE{$pi}};

  649. 

  650.     return \@mv1;

  651. }

  652. 

  653. sub find_all_mov($$){

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

  655.     my $pi;

  656.     my @mv1;

  657. 

  658.     $pi = cell_pi($not);

  659.     @mv1 = @{ get_mov($pi, $en) };

  660. 

  661.     return grep {

  662. 	$_ if $_->[0] ne $ERR_C_1

  663.     } map {

  664. 	[

  665. 	 calc_new_cell($not, $_->{"mov"}),

  666. 	 $_->{"type"}

  667. 	]

  668.     } @mv1;

  669. }

  670. 

  671. sub shade_pi_mvmt($$){

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

  673.     my $c1;

  674.     my @mv1;

  675.     

  676.     @mv1 = find_all_mov($not, $en);

  677.     for my $mv (@mv1){

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

  679.     }

  680. }

  681. 

  682. sub shade_all_mvmt($){

  683.     my $pl;

  684.     my @pi1;

  685.     

  686.     $pl = shift;

  687. 

  688.     @pi1 = grep {

  689. 	cell_pl($_) eq $pl

  690.     } keys(%board);

  691. 

  692.     for my $el (@pi1){

  693. 	shade_pi_mvmt($el, $MOVBLOCK_ENUM);

  694.     }

  695. }

  696. 

  697. sub get_block_cell($){

  698.     my $pl;

  699. 

  700.     $pl = shift;

  701.     

  702.     return map {

  703. 	$_->[0]

  704.     } map {

  705. 	( find_all_mov($_, $BLOCK_ENUM) );

  706.     } grep {

  707. 	cell_pl($_) eq $pl

  708.     } keys(%board);

  709. }

  710. 

  711. 

  712. 

  713. # Main starts here!

  714. #================================================== 

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

  716. 

  717. # Creates a hash of the the form

  718. # $board{cell_notation} = piece_enum

  719. %board = map {

  720.     $_ => $EMPTY_CELL

  721. } map {

  722.     my $l0;

  723.     $l0 = $_;

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

  725. } map {

  726.     $AXIS_RV{$_}

  727. }(1...11);

  728. 

  729. # my $m1 = "F7";

  730. my $m1 = "C10";

  731. my $m2 = "B3";

  732. my $c1 = $MG_SY;

  733. my $c2 = $MG_A;

  734. 

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

  736. $board{$m2} = $P2.$DIV.$c2;

  737. 

  738. for my $el (get_block_cell($P1)){

  739.     printf("%s\n", $el);

  740. }

  741. 

  742. shade_all_mvmt($P1);

  743. disp_board();