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.
40 Revīzijas
1 Atzars
185KB
Koks: bf37806515
Atzari Tagi
${ item.name }
Izveidot atzaru ${ searchTerm }
no 'bf37806515'
${ noResults }
lpst/LPST.pm

903 rindas
21KB
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. my $MAX_FT_SUMMON  = 16;

  12. 

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

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

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

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

  17. 

  18. my $SHADE_1_CHR = $GRAY_BOX_CHR;

  19. my $SHADE_2_CHR = $X_BOX_CHR;

  20. 

  21. my $PAD_AXIS = "     ";

  22. my $PAD_EVEN = "    ";

  23. my $PAD_ODD =  "   ";

  24. 

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

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

  27. my $HEX_3 = '|    |';

  28. 

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

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

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

  32. 

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

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

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

  36. 

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

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

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

  40. 

  41. my $HL_1 = "|____ ";

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

  43. 

  44. my $SUB_CHR = "_";

  45. 

  46. my $BLANK_CELL_CHR = $ALT_US;

  47. 

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

  49. my $PREF_2 = '  ';

  50. my $PREF_3 = '  ';

  51. 

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

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

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

  55. 

  56. # Pieces

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  74. 

  75. 

  76. my @MG_PI = (

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

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

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

  80.     );

  81. 

  82. # Players

  83. my $P1 = "P1";

  84. my $P2 = "P2";

  85. 

  86. my %OPPL = (

  87.     $P1 => $P2,

  88.     $P2 => $P1

  89.     );

  90. 

  91. my %HAND = (

  92.     $P1 => [],

  93.     $P2 => []

  94.     );

  95. 

  96. my $DIV = ":";

  97. 

  98. my %AXIS = (

  99.     "A" => 1,

  100.     "B" => 2,

  101.     "C" => 3,

  102.     "D" => 4,

  103.     "E" => 5,

  104.     "F" => 6,

  105.     "G" => 7,

  106.     "H" => 8,

  107.     "I" => 9,

  108.     "J" => 10,

  109.     "K" => 11

  110.     );

  111. my %AXIS_RV = map {

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

  113. } keys(%AXIS);

  114. 

  115. package MoveStruct;

  116. use warnings;

  117. use strict;

  118. 

  119. sub new {

  120.     my $class = shift;

  121.     my $self = { @_ };

  122.     

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

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

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

  126. 

  127.     return bless $self, $class;

  128. }

  129. 

  130. package LPST;    

  131. 

  132. #

  133. #     /--\ +1 

  134. #    | __ |

  135. #    |    |+1

  136. #     \--/ 

  137. #   -1 -1     

  138. #

  139. 

  140. # ODD

  141. # UP: 0, +1

  142. # DOWN: -1, -1

  143. 

  144. # EVEN

  145. # UP: +1, +1

  146. # DOWN: +0, -1

  147. 

  148. # [Row move, Diag move]

  149. 

  150. # Special cells

  151. my $EMPTY_CELL = "_";

  152. 

  153. # Shade enum

  154. my $SHADE_3_ENUM = 0b011;

  155. my $SHADE_2_ENUM = 0b010;

  156. my $SHADE_1_ENUM = 0b001;

  157. my $EMPTY_ENUM = 0;

  158. 

  159. my %SHADE = (

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

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

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

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

  164.     );

  165. 

  166. my $MOVE_ENUM = $SHADE_1_ENUM;   

  167. my $BLOCK_ENUM = $SHADE_2_ENUM; 

  168. my $MOVBLOCK_ENUM = $SHADE_3_ENUM;   

  169. 

  170. my $ERR_C_1 = -1;

  171. 

  172. my %MOVE = (

  173.     $MG_A => [

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

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

  176. 	],

  177.     $MG_Q  => [

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

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

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

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

  182.     ],

  183.     $MG_I => [

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

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

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

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

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

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

  190.     ],

  191.     $MG_IT => [

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

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

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

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

  196.     ],

  197.     $MG_N  => [

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

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

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

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

  202.     ],

  203.     $MG_H  => [

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

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

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

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

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

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

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

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

  212.     ],

  213.     $MG_RC => [

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

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

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

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

  218. 	MoveStruct->new("mov" => [ 0,-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_S  => [

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

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

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

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

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

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

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

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

  232.     ],

  233.     $MG_HS => [

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

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

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

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

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

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

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

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

  242.     ],

  243.     $MG_RO => [

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

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

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

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

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

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

  250.     ],

  251.     $MG_B  => [

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

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

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

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

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

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

  258.     ],

  259.     $MG_P  => [

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

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

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

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

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

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

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

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

  268.     ],

  269.     $MG_IM => [

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

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

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

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

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

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

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

  277.     ],

  278.     $MG_F  => [

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

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

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

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

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

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

  285. 	

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

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

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

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

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

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

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

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

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

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

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

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

  298.     ],

  299.     $MG_QS => [

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  318.     ],

  319.     $MG_AU => [

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  336.     ],

  337.     $MG_SY => [

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  354.     ]

  355.     );

  356. 

  357. 

  358. my %sc = ();

  359. my %board;

  360. 

  361. # Display pieces

  362. #==================================================

  363. 

  364. sub get_pi_str($){

  365.     my $p = shift;

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

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

  368.     return $p;

  369. }

  370. 

  371. sub sub_pi_str($$$){

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

  373.     my $s0;

  374. 

  375.     $p = get_pi_str($p);

  376.     $s0 = $hex;

  377.     

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

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

  380.     }

  381.     

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

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

  384.     }

  385. 

  386.     return $s0;

  387. }

  388. 

  389. # Display shade

  390. #==================================================

  391. 

  392. sub apply_shade($$){

  393.     my $not = shift;

  394.     my $en = shift;

  395. 

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

  397.     $sc{$not} = $MOVBLOCK_ENUM unless $sc{$not} == $en;

  398. }

  399. 

  400. sub get_shade_en($){

  401.     my $not = shift;

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

  403.     return $EMPTY_ENUM;

  404. }

  405. 

  406. sub get_shade_hex($){

  407.     my $en = shift;

  408.     return $SHADE{$en};

  409. }

  410. 

  411. sub get_cell_shade($$){

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

  413.     my $not;

  414.     

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

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

  417. }

  418. 

  419. 

  420. 

  421. 

  422. # Display lines

  423. #==================================================

  424. 

  425. sub disp_1($$){

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

  427.     my $hex;

  428. 

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

  430.     

  431.     return $hex;

  432. }

  433. 

  434. sub disp_2($$){

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

  436.     my $p;

  437.     my $not;

  438.     my $hex;

  439. 

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

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

  442. 

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

  444.     

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

  446. }

  447. 

  448. sub disp_3($$){

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

  450.     my $hex;

  451.     

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

  453.     

  454.     return $hex;

  455. }

  456. 

  457. sub disp_y_axis($$$$){

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

  459.     my $n0;

  460.     

  461.     $n0 = length($r0);

  462.     

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

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

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

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

  467. 

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

  469. }

  470. 

  471. # Display cell

  472. #==================================================

  473. 

  474. sub add_cell($$$$$){

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

  476. 

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

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

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

  480. 

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

  482. }

  483. 

  484. sub disp_0($){

  485.     my $r0;

  486. 

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

  488. 

  489.     $r0 = shift;

  490. 

  491.     # Append the y axis

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

  493. 

  494.     # Iterate through the cells

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

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

  497.     }

  498.     

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

  500. }

  501. 

  502. # Display row

  503. #==================================================

  504. 

  505. sub disp_row($){

  506.     my $row;

  507.     my $r0;

  508. 

  509.     $r0 = shift;

  510. 

  511.     $row = disp_0($r0);

  512. 

  513.     # Handle trailing characters

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

  515. 	# Trim the start of the first line

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

  517. 	# Trim the end of the first line

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

  519.     }else{

  520. 	# Trim the end of the last line

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

  522.     }

  523.     

  524.     return $row;

  525. }

  526. 

  527. sub disp_trailing_row(){

  528.     my $s0;

  529.     my $s1;

  530.     

  531.     $s0 = $PAD_EVEN.$PREF_1;

  532. 

  533.     # Clear some chars from

  534.     # our hex patterns

  535.     $s1 = $HEX_1;

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

  537. 

  538.     # Append hex pattern to

  539.     # trailing row

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

  541. 	$s0 .= $s1;

  542.     }

  543.     # Clear one last pair of

  544.     # chrs

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

  546.     $s0 .= "\n";

  547.     

  548.     return $s0;

  549. }

  550. 

  551. sub disp_x_axis(){

  552.     my $s0;

  553.     

  554.     $s0 = $PAD_AXIS;

  555.     $s0 .= join(

  556. 	$PAD_AXIS, map{

  557. 	    $AXIS_RV{$_}

  558. 	}(1..11));

  559.     $s0 .= "\n";

  560.     

  561.     $s0 .= $PAD_AXIS;

  562.     $s0 .= join(

  563. 	"", map{

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

  565. 	}(1..11));

  566.     $s0 .= "\n";

  567.     

  568.     return $s0

  569. }

  570. 

  571. # Display board

  572. #==================================================

  573. 

  574. sub disp_board(){

  575.     my $b;

  576.     

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

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

  579.     }

  580.     $b .= disp_trailing_row();

  581.     $b .= disp_x_axis();

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

  583. 

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

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

  586.     }

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

  588. }

  589. 

  590. 

  591. 

  592. 

  593. # Caclulate movement

  594. #==================================================

  595. sub pi_split($$){

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

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

  598. }

  599. 

  600. sub cell_pi($){

  601.     my $not = shift;

  602.     return pi_split($not, 1);

  603. }

  604. 

  605. sub cell_pl($){

  606.     my $not = shift;

  607.     return pi_split($not, 0);

  608. }

  609. 

  610. sub cell_index_rev($$){

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

  612. }

  613. 

  614. sub cell_index($){

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

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

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

  618. }

  619. 

  620. sub apply_shift($$){

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

  622.     my $r0;

  623.     my $c0;

  624. 

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

  626. 

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

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

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

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

  631. }

  632. 

  633. sub calc_new_cell($$){

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

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

  636.     

  637.     my $x_shift;

  638.     my $y_shift;

  639. 

  640.     my $n0;

  641.     my $ni;

  642. 

  643.     # get y_shift

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

  645.     

  646.     # get x_shift

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

  648.     

  649.     # make x_shift adjustment

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

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

  652.     

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

  654. 

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

  656. }

  657. 

  658. sub get_mov($$){

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

  660. 

  661.     my @mv1;

  662. 

  663.     @mv1 = grep {

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

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

  666. 

  667.     return \@mv1;

  668. }

  669. 

  670. sub find_all_mov($$){

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

  672.     my $pi;

  673.     my @mv1;

  674. 

  675.     $pi = cell_pi($not);

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

  677. 

  678.     return grep {

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

  680.     } map {

  681. 	[

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

  683. 	 $_->{"type"}

  684. 	]

  685.     } @mv1;

  686. }

  687. 

  688. sub shade_pi_mvmt($$){

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

  690.     my $c1;

  691.     my @mv1;

  692.     

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

  694.     for my $mv (@mv1){

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

  696.     }

  697. }

  698. 

  699. sub shade_all_mvmt($$){

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

  701.     my @pi1;

  702.     

  703.     # $pl = shift;

  704. 

  705.     @pi1 = grep {

  706. 	cell_pl($_) eq $pl

  707.     } keys(%board);

  708. 

  709.     for my $el (@pi1){

  710. 	shade_pi_mvmt($el, $en);

  711.     }

  712. }

  713. 

  714. sub shade_all_p1_mvmt($){

  715.     shade_all_mvmt($P1, $MOVBLOCK_ENUM);

  716. }

  717. 

  718. sub get_block_cell($){

  719.     my $pl;

  720. 

  721.     $pl = shift;

  722.     

  723.     return map {

  724. 	$_->[0]

  725.     } map {

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

  727.     } grep {

  728. 	cell_pl($_) eq $pl

  729.     } keys(%board);

  730. }

  731. 

  732. sub check_valid_card($){

  733.     my $s1 = shift;

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

  735. 	$_ =~ /^$s1$/i

  736.     } @MG_PI;

  737. }

  738. 

  739. sub check_valid_cell($){

  740.     my $hx1 = shift;

  741. 

  742.     die "invalid cell - $hx1" unless grep {

  743. 	$hx1 =~ /^$_$/i

  744.     } keys %board;

  745.     die "piece in cell $hx1" if $board{$hx1} ne $EMPTY_CELL;

  746. }

  747. 

  748. sub check_valid_player($){

  749.     my $apl = shift;

  750.     die "invalid player - $apl" unless grep {

  751. 	$apl =~ /^$_$/

  752.     } keys %HAND;

  753. }

  754. 

  755. sub check_block($$){

  756.     my ($s0, $apl) = (shift, shift);

  757.     for my $c0 (get_block_cell($OPPL{$apl})){

  758. 	die "summon to cell $s0 is blocked" if $s0 eq $c0;

  759.     }

  760. }

  761. 

  762. sub check_sz($$){

  763.     my ($hx1, $apl) = (shift, shift);

  764.     my ($c0, $r0) = cell_index($hx1);

  765. 

  766.     die "$hx1 not in start zone" if($r0 > 3 && $apl eq $P1);

  767.     die "$hx1 not in start zone" if($r0 < 8 && $apl eq $P2);

  768. }

  769. 

  770. sub draw($$){

  771.     my ($self, $s0, $apl) = (shift, shift, shift);

  772. 

  773.     my $i = 0;

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

  775. 	$i++;

  776. 	check_valid_card($s1);

  777. 	push(@{$HAND{$apl}}, $s1);

  778.     }

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

  780. }

  781. 

  782. sub summon($$$){

  783.     my ($self, $s0, $apl) = (shift, shift, shift);

  784.     my ($pi, $hx1) = $s0 =~ /([A-Za-z]{1,2})([A-Za-z][0-9]{1,})/;

  785.     $hx1 = uc $hx1;

  786.     check_valid_cell($hx1);

  787.     check_valid_player($apl);

  788.     check_block($hx1, $apl);

  789.     $board{uc $hx1} = $apl.$DIV.$pi;

  790. }

  791. 

  792. sub sz_summon($$$){

  793.     my ($self, $s0, $apl) = (shift, shift, shift);

  794.     my ($pi, $hx1) = $s0 =~ /([A-Za-z]{1,2})([A-Za-z][0-9]{1,})/;

  795.     $hx1 = uc $hx1;

  796.     check_sz($hx1, $apl);

  797.     summon($self, $s0, $apl);

  798. }

  799. 

  800. sub ft_summon($$$){

  801.     my ($self, $s0, $apl) = (shift, shift, shift);

  802.     die "Must summon queen on first turn" unless $s0 =~ /$MG_Q[A-ka-k]{1,2}[0-9]{1,2}/;

  803.     die "Max summons on first turn is $MAX_FT_SUMMON" if ( scalar (() = $s0 =~ /\*/g) > $MAX_FT_SUMMON );

  804. 

  805.     for my $mv1 ($s0 =~ /[A-Za-z]{2,3}[0-9]{1,2}\*/g){

  806. 	sz_summon($self, $mv1, $apl);

  807. 	# printf("%s\n", $mv1);

  808.     }

  809. }

  810. 

  811. sub new {

  812.     my $class = shift;

  813.     my $self = { @_ };

  814. 

  815.     # Creates a hash of the the form

  816.     # $board{cell_notation} = piece_enum

  817.     %board = map {

  818. 	$_ => $EMPTY_CELL

  819.     } map {

  820. 	my $l0;

  821. 	$l0 = $_;

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

  823.     } map {

  824. 	$AXIS_RV{$_}

  825.     }(1...11);

  826. 

  827.     return bless $self, $class;

  828. }

  829. 

  830. sub uniq($){

  831.     my %h0;

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

  833. }

  834. 

  835. sub P1 {

  836.     return $P1;

  837. }

  838. sub P2 {

  839.     return $P2;

  840. }

  841. 

  842. sub MG_A {

  843.     return $MG_A;

  844. }

  845. sub MG_I{

  846.     return $MG_I;

  847. }

  848. sub MG_N{

  849.     return $MG_N;

  850. }

  851. sub MG_IT{

  852.     return $MG_I;

  853. }

  854. sub MG_H{

  855.     return $MG_H;

  856. }

  857. sub MG_S{

  858.     return $MG_S;

  859. }

  860. sub MG_RC{

  861.     return $MG_RO;

  862. }

  863. sub MG_HS{

  864.     return $MG_H;

  865. }

  866. sub MG_RO{

  867.     return $MG_RC;

  868. }

  869. sub MG_B{

  870.     return $MG_B;

  871. }

  872. sub MG_P{

  873.     return $MG_P;

  874. }

  875. sub MG_IM{

  876.     return $MG_I;

  877. }

  878. sub MG_F{

  879.     return $MG_F;

  880. }

  881. sub MG_QS{

  882.     return $MG_QS;

  883. }

  884. sub MG_AU{

  885.     return $MG_A;

  886. }

  887. sub MG_SY{

  888.     return $MG_SY;

  889. }

  890. sub MG_Q{

  891.     return $MG_Q;

  892. }

  893. 

  894. 

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

  896. 

  897. return 1;

  898. 

  899. 

  900. 

  901.