gashapwn
/
lpst
1
0
Atdalīts 0
Kods Problēmas 0 Izmaiņu pieprasījumi 0 Laidieni 0 Vikivietne Aktivitāte
Implementation of Lucifers Pastime
Nevar pievienot vairāk kā 25 tēmas Tēmai ir jāsākas ar burtu vai ciparu, tā var saturēt domu zīmes ('-') un var būt līdz 35 simboliem gara.
38 Revīzijas
1 Atzars
185KB
Koks: 7f92f1f269
Atzari Tagi
${ item.name }
Izveidot atzaru ${ searchTerm }
no '7f92f1f269'
${ noResults }
lpst/LPST.pm

832 rindas
20KB
Neapstrādāts Vainot Vēsture 

  1. #!/usr/bin/perl

  2. 

  3. use warnings;

  4. use strict;

  5. 

  6. use utf8;

  7. 

  8. my $ARRAY = "ARRAY";

  9. 

  10. my $HAND_SIZE = 5;

  11. 

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

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

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

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

  16. 

  17. my $SHADE_1_CHR = $GRAY_BOX_CHR;

  18. my $SHADE_2_CHR = $X_BOX_CHR;

  19. 

  20. my $PAD_AXIS = "     ";

  21. my $PAD_EVEN = "    ";

  22. my $PAD_ODD =  "   ";

  23. 

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

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

  26. my $HEX_3 = '|    |';

  27. 

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

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

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

  31. 

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

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

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

  35. 

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

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

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

  39. 

  40. my $HL_1 = "|____ ";

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

  42. 

  43. my $SUB_CHR = "_";

  44. 

  45. my $BLANK_CELL_CHR = $ALT_US;

  46. 

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

  48. my $PREF_2 = '  ';

  49. my $PREF_3 = '  ';

  50. 

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

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

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

  54. 

  55. # Pieces

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  73. 

  74. 

  75. my @MG_PI = (

  76.     $MG_A,  $MG_I,  $MG_N,  $MG_IT, $MG_H, $MG_S,

  77.     $MG_RC, $MG_HS, $MG_RO, $MG_B,  $MG_P, $MG_IM,

  78.     $MG_F,  $MG_QS, $MG_AU, $MG_SY, $MG_Q

  79.     );

  80. 

  81. # Players

  82. my $P1 = "P1";

  83. my $P2 = "P2";

  84. 

  85. my %HAND = (

  86.     $P1 => [],

  87.     $P2 => []

  88.     );

  89. 

  90. my $DIV = ":";

  91. 

  92. my %AXIS = (

  93.     "A" => 1,

  94.     "B" => 2,

  95.     "C" => 3,

  96.     "D" => 4,

  97.     "E" => 5,

  98.     "F" => 6,

  99.     "G" => 7,

  100.     "H" => 8,

  101.     "I" => 9,

  102.     "J" => 10,

  103.     "K" => 11

  104.     );

  105. my %AXIS_RV = map {

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

  107. } keys(%AXIS);

  108. 

  109. package MoveStruct;

  110. use warnings;

  111. use strict;

  112. 

  113. sub new {

  114.     my $class = shift;

  115.     my $self = { @_ };

  116.     

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

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

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

  120. 

  121.     return bless $self, $class;

  122. }

  123. 

  124. package LPST;    

  125. 

  126. #

  127. #     /--\ +1 

  128. #    | __ |

  129. #    |    |+1

  130. #     \--/ 

  131. #   -1 -1     

  132. #

  133. 

  134. # ODD

  135. # UP: 0, +1

  136. # DOWN: -1, -1

  137. 

  138. # EVEN

  139. # UP: +1, +1

  140. # DOWN: +0, -1

  141. 

  142. # [Row move, Diag move]

  143. 

  144. # Special cells

  145. my $EMPTY_CELL = "_";

  146. 

  147. # Shade enum

  148. my $SHADE_3_ENUM = 0b011;

  149. my $SHADE_2_ENUM = 0b010;

  150. my $SHADE_1_ENUM = 0b001;

  151. my $EMPTY_ENUM = 0;

  152. 

  153. my %SHADE = (

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

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

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

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

  158.     );

  159. 

  160. my $MOVE_ENUM = $SHADE_1_ENUM;   

  161. my $BLOCK_ENUM = $SHADE_2_ENUM; 

  162. my $MOVBLOCK_ENUM = $SHADE_3_ENUM;   

  163. 

  164. my $ERR_C_1 = -1;

  165. 

  166. my %MOVE = (

  167.     $MG_A => [

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

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

  170. 	],

  171.     $MG_Q  => [

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

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

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

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

  176.     ],

  177.     $MG_I => [

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

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

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

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

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

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

  184.     ],

  185.     $MG_IT => [

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

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

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

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

  190.     ],

  191.     $MG_N  => [

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

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

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

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

  196.     ],

  197.     $MG_H  => [

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

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

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

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

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

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

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

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

  206.     ],

  207.     $MG_RC => [

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

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

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

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

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

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

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

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

  216.     ],

  217.     $MG_S  => [

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

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

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

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

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

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

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

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

  226.     ],

  227.     $MG_HS => [

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

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

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

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

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

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

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

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

  236.     ],

  237.     $MG_RO => [

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

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

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

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

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

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

  244.     ],

  245.     $MG_B  => [

  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" => [ 2,-2], "type" => $MOVE_ENUM),

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

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

  252.     ],

  253.     $MG_P  => [

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

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

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

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

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

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

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

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

  262.     ],

  263.     $MG_IM => [

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

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

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

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

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

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

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

  271.     ],

  272.     $MG_F  => [

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

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

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

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

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

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

  279. 	

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

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

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

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

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

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

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

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

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

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

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

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

  292.     ],

  293.     $MG_QS => [

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  312.     ],

  313.     $MG_AU => [

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  330.     ],

  331.     $MG_SY => [

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  348.     ]

  349.     );

  350. 

  351. 

  352. my %sc = ();

  353. my %board;

  354. 

  355. # Display pieces

  356. #==================================================

  357. 

  358. sub get_pi_str($){

  359.     my $p = shift;

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

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

  362.     return $p;

  363. }

  364. 

  365. sub sub_pi_str($$$){

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

  367.     my $s0;

  368. 

  369.     $p = get_pi_str($p);

  370.     $s0 = $hex;

  371.     

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

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

  374.     }

  375.     

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

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

  378.     }

  379. 

  380.     return $s0;

  381. }

  382. 

  383. # Display shade

  384. #==================================================

  385. 

  386. sub apply_shade($$){

  387.     my $not = shift;

  388.     my $en = shift;

  389. 

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

  391. }

  392. 

  393. sub get_shade_en($){

  394.     my $not = shift;

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

  396.     return $EMPTY_ENUM;

  397. }

  398. 

  399. sub get_shade_hex($){

  400.     my $en = shift;

  401.     return $SHADE{$en};

  402. }

  403. 

  404. sub get_cell_shade($$){

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

  406.     my $not;

  407.     

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

  409.     return get_shade_hex(get_shade_en($not));

  410. }

  411. 

  412. 

  413. 

  414. 

  415. # Display lines

  416. #==================================================

  417. 

  418. sub disp_1($$){

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

  420.     my $hex;

  421. 

  422.     $hex = get_cell_shade($r0, $c0)->[0];

  423.     

  424.     return $hex;

  425. }

  426. 

  427. sub disp_2($$){

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

  429.     my $p;

  430.     my $not;

  431.     my $hex;

  432. 

  433.     $hex = get_cell_shade($r0, $c0)->[1];

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

  435. 

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

  437.     

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

  439. }

  440. 

  441. sub disp_3($$){

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

  443.     my $hex;

  444.     

  445.     $hex = get_cell_shade($r0, $c0)->[2];

  446.     

  447.     return $hex;

  448. }

  449. 

  450. sub disp_y_axis($$$$){

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

  452.     my $n0;

  453.     

  454.     $n0 = length($r0);

  455.     

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

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

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

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

  460. 

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

  462. }

  463. 

  464. # Display cell

  465. #==================================================

  466. 

  467. sub add_cell($$$$$){

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

  469. 

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

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

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

  473. 

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

  475. }

  476. 

  477. sub disp_0($){

  478.     my $r0;

  479. 

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

  481. 

  482.     $r0 = shift;

  483. 

  484.     # Append the y axis

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

  486. 

  487.     # Iterate through the cells

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

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

  490.     }

  491.     

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

  493. }

  494. 

  495. # Display row

  496. #==================================================

  497. 

  498. sub disp_row($){

  499.     my $row;

  500.     my $r0;

  501. 

  502.     $r0 = shift;

  503. 

  504.     $row = disp_0($r0);

  505. 

  506.     # Handle trailing characters

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

  508. 	# Trim the start of the first line

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

  510. 	# Trim the end of the first line

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

  512.     }else{

  513. 	# Trim the end of the last line

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

  515.     }

  516.     

  517.     return $row;

  518. }

  519. 

  520. sub disp_trailing_row(){

  521.     my $s0;

  522.     my $s1;

  523.     

  524.     $s0 = $PAD_EVEN.$PREF_1;

  525. 

  526.     # Clear some chars from

  527.     # our hex patterns

  528.     $s1 = $HEX_1;

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

  530. 

  531.     # Append hex pattern to

  532.     # trailing row

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

  534. 	$s0 .= $s1;

  535.     }

  536.     # Clear one last pair of

  537.     # chrs

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

  539.     $s0 .= "\n";

  540.     

  541.     return $s0;

  542. }

  543. 

  544. sub disp_x_axis(){

  545.     my $s0;

  546.     

  547.     $s0 = $PAD_AXIS;

  548.     $s0 .= join(

  549. 	$PAD_AXIS, map{

  550. 	    $AXIS_RV{$_}

  551. 	}(1..11));

  552.     $s0 .= "\n";

  553.     

  554.     $s0 .= $PAD_AXIS;

  555.     $s0 .= join(

  556. 	"", map{

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

  558. 	}(1..11));

  559.     $s0 .= "\n";

  560.     

  561.     return $s0

  562. }

  563. 

  564. # Display board

  565. #==================================================

  566. 

  567. sub disp_board(){

  568.     my $b;

  569.     

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

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

  572.     }

  573.     $b .= disp_trailing_row();

  574.     $b .= disp_x_axis();

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

  576. 

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

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

  579.     }

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

  581. }

  582. 

  583. 

  584. 

  585. 

  586. # Caclulate movement

  587. #==================================================

  588. sub pi_split($$){

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

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

  591. }

  592. 

  593. sub cell_pi($){

  594.     my $not = shift;

  595.     return pi_split($not, 1);

  596. }

  597. 

  598. sub cell_pl($){

  599.     my $not = shift;

  600.     return pi_split($not, 0);

  601. }

  602. 

  603. sub cell_index_rev($$){

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

  605. }

  606. 

  607. sub cell_index($){

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

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

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

  611. }

  612. 

  613. sub apply_shift($$){

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

  615.     my $r0;

  616.     my $c0;

  617. 

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

  619. 

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

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

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

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

  624. }

  625. 

  626. sub calc_new_cell($$){

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

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

  629.     

  630.     my $x_shift;

  631.     my $y_shift;

  632. 

  633.     my $n0;

  634.     my $ni;

  635. 

  636.     # get y_shift

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

  638.     

  639.     # get x_shift

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

  641.     

  642.     # make x_shift adjustment

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

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

  645.     

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

  647. 

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

  649. }

  650. 

  651. sub get_mov($$){

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

  653. 

  654.     my @mv1;

  655. 

  656.     @mv1 = grep {

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

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

  659. 

  660.     return \@mv1;

  661. }

  662. 

  663. sub find_all_mov($$){

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

  665.     my $pi;

  666.     my @mv1;

  667. 

  668.     $pi = cell_pi($not);

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

  670. 

  671.     return grep {

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

  673.     } map {

  674. 	[

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

  676. 	 $_->{"type"}

  677. 	]

  678.     } @mv1;

  679. }

  680. 

  681. sub shade_pi_mvmt($$){

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

  683.     my $c1;

  684.     my @mv1;

  685.     

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

  687.     for my $mv (@mv1){

  688. 	apply_shade($mv->[0], $mv->[1]);

  689.     }

  690. }

  691. 

  692. sub shade_all_mvmt($$){

  693.     my ($pl, $en) = (shift, shift);

  694.     my @pi1;

  695.     

  696.     # $pl = shift;

  697. 

  698.     @pi1 = grep {

  699. 	cell_pl($_) eq $pl

  700.     } keys(%board);

  701. 

  702.     for my $el (@pi1){

  703. 	shade_pi_mvmt($el, $en);

  704.     }

  705. }

  706. 

  707. sub shade_all_p1_mvmt($){

  708.     shade_all_mvmt($P1, $MOVBLOCK_ENUM);

  709. }

  710. 

  711. sub get_block_cell($){

  712.     my $pl;

  713. 

  714.     $pl = shift;

  715.     

  716.     return map {

  717. 	$_->[0]

  718.     } map {

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

  720.     } grep {

  721. 	cell_pl($_) eq $pl

  722.     } keys(%board);

  723. }

  724. 

  725. sub draw($$){

  726.     my ($self, $s0, $apt) = (shift, shift, shift);

  727. 

  728.     my $i = 0;

  729.     for my $s1 (uniq( [split(/ /, $s0)] )){

  730. 	$i++;

  731. 	die "invalid card - $s1" unless grep {

  732. 	    $_ =~ /^$s1$/

  733. 	} @MG_PI;

  734. 	$HAND{$P1} = $s1;

  735.     }

  736.     die "draw() $s0 - hand size less than $HAND_SIZE. Possible duplicate card?" if $i < $HAND_SIZE;

  737. }

  738. 

  739. sub new {

  740.     my $class = shift;

  741.     my $self = { @_ };

  742. 

  743.     # Creates a hash of the the form

  744.     # $board{cell_notation} = piece_enum

  745.     %board = map {

  746. 	$_ => $EMPTY_CELL

  747.     } map {

  748. 	my $l0;

  749. 	$l0 = $_;

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

  751.     } map {

  752. 	$AXIS_RV{$_}

  753.     }(1...11);

  754. 

  755.     return bless $self, $class;

  756. }

  757. 

  758. sub uniq($){

  759.     my %h0;

  760.     return grep { !$h0{$_}++ } @{$_[0]};

  761. }

  762. 

  763. 

  764. sub P1 {

  765.     return $P1;

  766. }

  767. sub P2 {

  768.     return $P2;

  769. }

  770. 

  771. sub MG_A {

  772.     return $MG_A;

  773. }

  774. sub MG_I{

  775.     return $MG_I;

  776. }

  777. sub MG_N{

  778.     return $MG_N;

  779. }

  780. sub MG_IT{

  781.     return $MG_I;

  782. }

  783. sub MG_H{

  784.     return $MG_H;

  785. }

  786. sub MG_S{

  787.     return $MG_S;

  788. }

  789. sub MG_RC{

  790.     return $MG_RO;

  791. }

  792. sub MG_HS{

  793.     return $MG_H;

  794. }

  795. sub MG_RO{

  796.     return $MG_RC;

  797. }

  798. sub MG_B{

  799.     return $MG_B;

  800. }

  801. sub MG_P{

  802.     return $MG_P;

  803. }

  804. sub MG_IM{

  805.     return $MG_I;

  806. }

  807. sub MG_F{

  808.     return $MG_F;

  809. }

  810. sub MG_QS{

  811.     return $MG_QS;

  812. }

  813. sub MG_AU{

  814.     return $MG_A;

  815. }

  816. sub MG_SY{

  817.     return $MG_SY;

  818. }

  819. sub MG_Q{

  820.     return $MG_Q;

  821. }

  822. 

  823. 

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

  825. 

  826. return 1;

  827. 

  828. 

  829. 

  830.