Implementation of Lucifers Pastime
選択できるのは25トピックまでです。 トピックは、先頭が英数字で、英数字とダッシュ('-')を使用した35文字以内のものにしてください。

738 行
19KB

  1. #!/usr/bin/perl
  2. use warnings;
  3. use strict;
  4. use utf8;
  5. my $ARRAY = "ARRAY";
  6. my $X_BOX_CHR = chr(0x2573);
  7. my $GRAY_BOX_CHR = chr(0x2591);
  8. my $ALT_US = chr(0x2017);
  9. my $ALT_PIPE = chr(0x2016);
  10. my $SHADE_1_CHR = $GRAY_BOX_CHR;
  11. my $SHADE_2_CHR = $X_BOX_CHR;
  12. my $PAD_AXIS = " ";
  13. my $PAD_EVEN = " ";
  14. my $PAD_ODD = " ";
  15. my $HEX_1 = '-/--\-';
  16. my $HEX_2 = '| __ |';
  17. my $HEX_3 = '| |';
  18. my $HEX_S1_1 = '-/--\-';
  19. my $HEX_S1_2 = sprintf("|%s%s%s%s|", $SHADE_1_CHR, $SHADE_1_CHR, $SHADE_1_CHR, $SHADE_1_CHR);
  20. my $HEX_S1_3 = sprintf("|%s%s%s%s|", $SHADE_1_CHR, $SHADE_1_CHR, $SHADE_1_CHR, $SHADE_1_CHR);
  21. my $HEX_S2_1 = '-/--\-';
  22. my $HEX_S2_2 = sprintf("|%s%s%s%s|", $SHADE_2_CHR, $SHADE_2_CHR, $SHADE_2_CHR, $SHADE_2_CHR);
  23. my $HEX_S2_3 = sprintf("|%s%s%s%s|", $SHADE_2_CHR, $SHADE_2_CHR, $SHADE_2_CHR, $SHADE_2_CHR);
  24. my $HEX_S3_1 = '-/--\-';
  25. my $HEX_S3_2 = sprintf("|%s%s%s%s|", $SHADE_2_CHR, $SHADE_2_CHR, $SHADE_1_CHR, $SHADE_1_CHR);
  26. my $HEX_S3_3 = sprintf("|%s%s%s%s|", $SHADE_2_CHR, $SHADE_2_CHR, $SHADE_1_CHR, $SHADE_1_CHR);
  27. my $HL_1 = "|____ ";
  28. my $HL_2 = $ALT_PIPE.$ALT_US.$ALT_US.$ALT_US.$ALT_US." ";
  29. my $SUB_CHR = "_";
  30. my $BLANK_CELL_CHR = $ALT_US;
  31. my $PREF_1 = substr($HEX_1, -2, 2);
  32. my $PREF_2 = ' ';
  33. my $PREF_3 = ' ';
  34. my $TRAIL_1 = substr($HEX_1, 0, 1);
  35. my $TRAIL_2 = substr($HEX_1, -1, 1);
  36. my $TRAIL_3 = substr($HEX_1, 0, 2);
  37. # Pieces
  38. my $MG_A = "A"; # Apprentice
  39. my $MG_I = "I"; # Iron Maiden
  40. my $MG_N = "N"; # Nekomata
  41. my $MG_IT = "It"; # Ittan-Momen
  42. my $MG_H = "H"; # Harpy
  43. my $MG_S = "S"; # Slime
  44. my $MG_RC = "Rc"; # Redcap
  45. my $MG_HS = "Hs"; # Holstaur
  46. my $MG_RO = "Ro"; # Red Oni
  47. my $MG_B = "B"; # Blue Oni
  48. my $MG_P = "P"; # Preistess
  49. my $MG_IM = "Im"; # Imp
  50. my $MG_F = "F"; # False Angel
  51. my $MG_QS = "Qs"; # Queen slime
  52. my $MG_AU = "Au"; # Automaton
  53. my $MG_SY = "Sy"; # Sylph
  54. my $MG_Q = "Q"; # Queen
  55. # Players
  56. my $P1 = "P1";
  57. my $P2 = "P2";
  58. my $DIV = ":";
  59. my %AXIS = (
  60. "A" => 1,
  61. "B" => 2,
  62. "C" => 3,
  63. "D" => 4,
  64. "E" => 5,
  65. "F" => 6,
  66. "G" => 7,
  67. "H" => 8,
  68. "I" => 9,
  69. "J" => 10,
  70. "K" => 11
  71. );
  72. my %AXIS_RV = map {
  73. $AXIS{$_} => $_
  74. } keys(%AXIS);
  75. package MoveStruct;
  76. use warnings;
  77. use strict;
  78. sub new {
  79. my $class = shift;
  80. my $self = { @_ };
  81. die "invalid MoveStruct {\"mov\"}" unless $self->{"mov"};
  82. die "invalid MoveStruct ->{\"type\"}" unless $self->{"type"};
  83. die "invalid MoveStruct type" unless ref($self->{"mov"}) eq $ARRAY;
  84. return bless $self, $class;
  85. }
  86. package LPST;
  87. #
  88. # /--\ +1
  89. # | __ |
  90. # | |+1
  91. # \--/
  92. # -1 -1
  93. #
  94. # ODD
  95. # UP: 0, +1
  96. # DOWN: -1, -1
  97. # EVEN
  98. # UP: +1, +1
  99. # DOWN: +0, -1
  100. # [Row move, Diag move]
  101. # Special cells
  102. my $EMPTY_CELL = "_";
  103. # Shade enum
  104. my $SHADE_3_ENUM = 0b011;
  105. my $SHADE_2_ENUM = 0b010;
  106. my $SHADE_1_ENUM = 0b001;
  107. my $EMPTY_ENUM = 0;
  108. my %SHADE = (
  109. $SHADE_1_ENUM => [$HEX_S1_1, $HEX_S1_2, $HEX_S1_3],
  110. $SHADE_2_ENUM => [$HEX_S2_1, $HEX_S2_2, $HEX_S2_3],
  111. $SHADE_3_ENUM => [$HEX_S3_1, $HEX_S3_2, $HEX_S3_3],
  112. $EMPTY_ENUM => [$HEX_1, $HEX_2, $HEX_3]
  113. );
  114. my $MOVE_ENUM = $SHADE_1_ENUM;
  115. my $BLOCK_ENUM = $SHADE_2_ENUM;
  116. my $MOVBLOCK_ENUM = $SHADE_3_ENUM;
  117. my $ERR_C_1 = -1;
  118. my %MOVE = (
  119. $MG_A => [
  120. MoveStruct->new("mov" => [-1, 1], "type" => $MOVBLOCK_ENUM),
  121. MoveStruct->new("mov" => [ 0, 1], "type" => $MOVBLOCK_ENUM)
  122. ],
  123. $MG_Q => [
  124. MoveStruct->new("mov" => [ 0, 1], "type" => $MOVE_ENUM),
  125. MoveStruct->new("mov" => [ 1, 0], "type" => $MOVE_ENUM),
  126. MoveStruct->new("mov" => [-1, 0], "type" => $MOVE_ENUM),
  127. MoveStruct->new("mov" => [ 0,-1], "type" => $MOVE_ENUM)
  128. ],
  129. $MG_I => [
  130. MoveStruct->new("mov" => [-1, 0], "type" => $BLOCK_ENUM),
  131. MoveStruct->new("mov" => [-1, 1], "type" => $BLOCK_ENUM),
  132. MoveStruct->new("mov" => [ 0, 1], "type" => $BLOCK_ENUM),
  133. MoveStruct->new("mov" => [ 0,-1], "type" => $BLOCK_ENUM),
  134. MoveStruct->new("mov" => [ 1, 0], "type" => $BLOCK_ENUM),
  135. MoveStruct->new("mov" => [ 1,-1], "type" => $BLOCK_ENUM)
  136. ],
  137. $MG_IT => [
  138. MoveStruct->new("mov" => [ 0,-1], "type" => $MOVE_ENUM),
  139. MoveStruct->new("mov" => [ 1,-1], "type" => $MOVE_ENUM),
  140. MoveStruct->new("mov" => [-1, 1], "type" => $BLOCK_ENUM),
  141. MoveStruct->new("mov" => [ 0, 1], "type" => $BLOCK_ENUM)
  142. ],
  143. $MG_N => [
  144. MoveStruct->new("mov" => [-1, 2], "type" => $MOVE_ENUM),
  145. MoveStruct->new("mov" => [ 1,-2], "type" => $MOVE_ENUM),
  146. MoveStruct->new("mov" => [-1, 1], "type" => $BLOCK_ENUM),
  147. MoveStruct->new("mov" => [ 0, 1], "type" => $BLOCK_ENUM)
  148. ],
  149. $MG_H => [
  150. MoveStruct->new("mov" => [-3, 2], "type" => $MOVE_ENUM),
  151. MoveStruct->new("mov" => [-1,-2], "type" => $MOVE_ENUM),
  152. MoveStruct->new("mov" => [ 1, 2], "type" => $MOVE_ENUM),
  153. MoveStruct->new("mov" => [ 3,-2], "type" => $MOVE_ENUM),
  154. MoveStruct->new("mov" => [ 0,-1], "type" => $BLOCK_ENUM),
  155. MoveStruct->new("mov" => [ 1,-1], "type" => $BLOCK_ENUM),
  156. MoveStruct->new("mov" => [-1, 1], "type" => $BLOCK_ENUM),
  157. MoveStruct->new("mov" => [ 0, 1], "type" => $BLOCK_ENUM)
  158. ],
  159. $MG_RC => [
  160. MoveStruct->new("mov" => [-1, 0], "type" => $MOVE_ENUM),
  161. MoveStruct->new("mov" => [-2, 0], "type" => $MOVE_ENUM),
  162. MoveStruct->new("mov" => [ 1, 0], "type" => $MOVE_ENUM),
  163. MoveStruct->new("mov" => [ 2, 0], "type" => $MOVE_ENUM),
  164. MoveStruct->new("mov" => [ 0,-1], "type" => $BLOCK_ENUM),
  165. MoveStruct->new("mov" => [ 1,-1], "type" => $BLOCK_ENUM),
  166. MoveStruct->new("mov" => [-1, 1], "type" => $BLOCK_ENUM),
  167. MoveStruct->new("mov" => [ 0, 1], "type" => $BLOCK_ENUM)
  168. ],
  169. $MG_S => [
  170. MoveStruct->new("mov" => [-1, 1], "type" => $MOVE_ENUM),
  171. MoveStruct->new("mov" => [-2, 2], "type" => $MOVE_ENUM),
  172. MoveStruct->new("mov" => [ 0, 1], "type" => $MOVE_ENUM),
  173. MoveStruct->new("mov" => [ 0, 2], "type" => $MOVE_ENUM),
  174. MoveStruct->new("mov" => [ 0,-1], "type" => $MOVE_ENUM),
  175. MoveStruct->new("mov" => [ 0,-2], "type" => $MOVE_ENUM),
  176. MoveStruct->new("mov" => [ 1,-1], "type" => $MOVE_ENUM),
  177. MoveStruct->new("mov" => [ 2,-2], "type" => $MOVE_ENUM),
  178. ],
  179. $MG_HS => [
  180. MoveStruct->new("mov" => [-3, 1], "type" => $MOVE_ENUM),
  181. MoveStruct->new("mov" => [-2,-1], "type" => $MOVE_ENUM),
  182. MoveStruct->new("mov" => [ 2, 1], "type" => $MOVE_ENUM),
  183. MoveStruct->new("mov" => [ 3,-1], "type" => $MOVE_ENUM),
  184. MoveStruct->new("mov" => [-2, 1], "type" => $BLOCK_ENUM),
  185. MoveStruct->new("mov" => [ 1, 1], "type" => $BLOCK_ENUM),
  186. MoveStruct->new("mov" => [-1, 1], "type" => $BLOCK_ENUM),
  187. MoveStruct->new("mov" => [ 0, 1], "type" => $BLOCK_ENUM)
  188. ],
  189. $MG_RO => [
  190. MoveStruct->new("mov" => [-1, 1], "type" => $MOVE_ENUM),
  191. MoveStruct->new("mov" => [ 0, 1], "type" => $MOVE_ENUM),
  192. MoveStruct->new("mov" => [ 1, 1], "type" => $MOVE_ENUM),
  193. MoveStruct->new("mov" => [ 1,-2], "type" => $MOVE_ENUM),
  194. MoveStruct->new("mov" => [-1, 0], "type" => $BLOCK_ENUM),
  195. MoveStruct->new("mov" => [ 1, 0], "type" => $BLOCK_ENUM)
  196. ],
  197. $MG_B => [
  198. MoveStruct->new("mov" => [-1, 1], "type" => $MOVE_ENUM),
  199. MoveStruct->new("mov" => [ 0, 1], "type" => $MOVE_ENUM),
  200. MoveStruct->new("mov" => [ 0,-2], "type" => $MOVE_ENUM),
  201. MoveStruct->new("mov" => [ 2,-2], "type" => $MOVE_ENUM),
  202. MoveStruct->new("mov" => [ 0,-1], "type" => $BLOCK_ENUM),
  203. MoveStruct->new("mov" => [ 1,-1], "type" => $BLOCK_ENUM)
  204. ],
  205. $MG_P => [
  206. MoveStruct->new("mov" => [-4, 2], "type" => $MOVE_ENUM),
  207. MoveStruct->new("mov" => [-2, 1], "type" => $MOVBLOCK_ENUM),
  208. MoveStruct->new("mov" => [-2,-2], "type" => $MOVE_ENUM),
  209. MoveStruct->new("mov" => [-1,-1], "type" => $MOVBLOCK_ENUM),
  210. MoveStruct->new("mov" => [ 1, 1], "type" => $MOVBLOCK_ENUM),
  211. MoveStruct->new("mov" => [ 2,-1], "type" => $MOVBLOCK_ENUM),
  212. MoveStruct->new("mov" => [ 2, 2], "type" => $MOVE_ENUM),
  213. MoveStruct->new("mov" => [ 4,-2], "type" => $MOVE_ENUM)
  214. ],
  215. $MG_IM => [
  216. MoveStruct->new("mov" => [-2, 1], "type" => $MOVBLOCK_ENUM),
  217. MoveStruct->new("mov" => [-1,-1], "type" => $MOVBLOCK_ENUM),
  218. MoveStruct->new("mov" => [-1, 2], "type" => $MOVBLOCK_ENUM),
  219. MoveStruct->new("mov" => [ 1, 1], "type" => $MOVBLOCK_ENUM),
  220. MoveStruct->new("mov" => [ 1,-1], "type" => $MOVE_ENUM),
  221. MoveStruct->new("mov" => [ 1,-2], "type" => $BLOCK_ENUM),
  222. MoveStruct->new("mov" => [ 2,-1], "type" => $MOVBLOCK_ENUM)
  223. ],
  224. $MG_F => [
  225. MoveStruct->new("mov" => [-1, 0], "type" => $MOVE_ENUM),
  226. MoveStruct->new("mov" => [-1, 1], "type" => $MOVE_ENUM),
  227. MoveStruct->new("mov" => [ 0, 1], "type" => $MOVE_ENUM),
  228. MoveStruct->new("mov" => [ 0,-1], "type" => $MOVE_ENUM),
  229. MoveStruct->new("mov" => [ 1, 0], "type" => $MOVE_ENUM),
  230. MoveStruct->new("mov" => [ 1,-1], "type" => $MOVE_ENUM),
  231. MoveStruct->new("mov" => [ 0, 2], "type" => $BLOCK_ENUM),
  232. MoveStruct->new("mov" => [ 0,-2], "type" => $BLOCK_ENUM),
  233. MoveStruct->new("mov" => [ 1, 1], "type" => $BLOCK_ENUM),
  234. MoveStruct->new("mov" => [ 1,-2], "type" => $BLOCK_ENUM),
  235. MoveStruct->new("mov" => [ 2, 0], "type" => $BLOCK_ENUM),
  236. MoveStruct->new("mov" => [ 2,-1], "type" => $BLOCK_ENUM),
  237. MoveStruct->new("mov" => [ 2,-2], "type" => $BLOCK_ENUM),
  238. MoveStruct->new("mov" => [-1, 2], "type" => $BLOCK_ENUM),
  239. MoveStruct->new("mov" => [-1,-1], "type" => $BLOCK_ENUM),
  240. MoveStruct->new("mov" => [-2, 0], "type" => $BLOCK_ENUM),
  241. MoveStruct->new("mov" => [-2, 1], "type" => $BLOCK_ENUM),
  242. MoveStruct->new("mov" => [-2, 2], "type" => $BLOCK_ENUM)
  243. ],
  244. $MG_QS => [
  245. MoveStruct->new("mov" => [-3, 3], "type" => $MOVE_ENUM),
  246. MoveStruct->new("mov" => [-2, 2], "type" => $MOVE_ENUM),
  247. MoveStruct->new("mov" => [-2, 0], "type" => $MOVE_ENUM),
  248. MoveStruct->new("mov" => [-1, 0], "type" => $MOVE_ENUM),
  249. MoveStruct->new("mov" => [-1, 1], "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" => [ 0,-1], "type" => $MOVE_ENUM),
  254. MoveStruct->new("mov" => [ 0,-2], "type" => $MOVE_ENUM),
  255. MoveStruct->new("mov" => [ 0,-3], "type" => $MOVE_ENUM),
  256. MoveStruct->new("mov" => [ 1, 0], "type" => $MOVE_ENUM),
  257. MoveStruct->new("mov" => [ 1,-1], "type" => $MOVE_ENUM),
  258. MoveStruct->new("mov" => [ 2, 0], "type" => $MOVE_ENUM),
  259. MoveStruct->new("mov" => [ 2,-2], "type" => $MOVE_ENUM),
  260. MoveStruct->new("mov" => [ 3,-3], "type" => $MOVE_ENUM),
  261. MoveStruct->new("mov" => [ 3, 0], "type" => $MOVE_ENUM),
  262. MoveStruct->new("mov" => [-3, 0], "type" => $MOVE_ENUM)
  263. ],
  264. $MG_AU => [
  265. MoveStruct->new("mov" => [-1, 0], "type" => $MOVBLOCK_ENUM),
  266. MoveStruct->new("mov" => [-1, 1], "type" => $MOVBLOCK_ENUM),
  267. MoveStruct->new("mov" => [ 0, 1], "type" => $MOVBLOCK_ENUM),
  268. MoveStruct->new("mov" => [ 0,-1], "type" => $MOVBLOCK_ENUM),
  269. MoveStruct->new("mov" => [ 1, 0], "type" => $MOVBLOCK_ENUM),
  270. MoveStruct->new("mov" => [ 1,-1], "type" => $MOVBLOCK_ENUM),
  271. MoveStruct->new("mov" => [ 0, 2], "type" => $BLOCK_ENUM),
  272. MoveStruct->new("mov" => [ 0,-2], "type" => $BLOCK_ENUM),
  273. MoveStruct->new("mov" => [ 1, 1], "type" => $BLOCK_ENUM),
  274. MoveStruct->new("mov" => [ 1,-2], "type" => $BLOCK_ENUM),
  275. MoveStruct->new("mov" => [ 2,-1], "type" => $BLOCK_ENUM),
  276. MoveStruct->new("mov" => [ 2,-2], "type" => $BLOCK_ENUM),
  277. MoveStruct->new("mov" => [-1, 2], "type" => $BLOCK_ENUM),
  278. MoveStruct->new("mov" => [-1,-1], "type" => $BLOCK_ENUM),
  279. MoveStruct->new("mov" => [-2, 1], "type" => $BLOCK_ENUM),
  280. MoveStruct->new("mov" => [-2, 2], "type" => $BLOCK_ENUM)
  281. ],
  282. $MG_SY => [
  283. MoveStruct->new("mov" => [-4, 4], "type" => $MOVE_ENUM),
  284. MoveStruct->new("mov" => [-3, 3], "type" => $MOVE_ENUM),
  285. MoveStruct->new("mov" => [-3, 2], "type" => $MOVBLOCK_ENUM),
  286. MoveStruct->new("mov" => [-1,-2], "type" => $MOVBLOCK_ENUM),
  287. MoveStruct->new("mov" => [ 0,-4], "type" => $MOVE_ENUM),
  288. MoveStruct->new("mov" => [ 0,-3], "type" => $MOVE_ENUM),
  289. MoveStruct->new("mov" => [ 0, 3], "type" => $MOVE_ENUM),
  290. MoveStruct->new("mov" => [ 0, 4], "type" => $MOVE_ENUM),
  291. MoveStruct->new("mov" => [ 1, 2], "type" => $MOVBLOCK_ENUM),
  292. MoveStruct->new("mov" => [ 3,-2], "type" => $MOVBLOCK_ENUM),
  293. MoveStruct->new("mov" => [ 3,-3], "type" => $MOVE_ENUM),
  294. MoveStruct->new("mov" => [ 4,-4], "type" => $MOVE_ENUM),
  295. MoveStruct->new("mov" => [-1, 1], "type" => $BLOCK_ENUM),
  296. MoveStruct->new("mov" => [ 0, 1], "type" => $BLOCK_ENUM),
  297. MoveStruct->new("mov" => [ 0,-1], "type" => $BLOCK_ENUM),
  298. MoveStruct->new("mov" => [ 1,-1], "type" => $BLOCK_ENUM)
  299. ]
  300. );
  301. my %sc = ();
  302. my %board;
  303. # Display pieces
  304. #==================================================
  305. sub get_pi_str($){
  306. my $p = shift;
  307. $p =~ s/($P1|$P2)$DIV//;
  308. $p .= "_" if length($p) < 2;
  309. return $p;
  310. }
  311. sub sub_pi_str($$$){
  312. my ($p, $c0, $hex) = (shift, shift, shift);
  313. my $s0;
  314. $p = get_pi_str($p);
  315. $s0 = $hex;
  316. unless($p eq "__"){
  317. substr($s0, 2,2) = $p;
  318. }
  319. if($c0 % 2 == 0){
  320. $s0 =~ s/$SUB_CHR/$BLANK_CELL_CHR/g;
  321. }
  322. return $s0;
  323. }
  324. # Display shade
  325. #==================================================
  326. sub apply_shade($$){
  327. my $not = shift;
  328. my $en = shift;
  329. $sc{$not} = $en unless (grep /^$not$/, keys(%sc));
  330. }
  331. sub get_shade_en($){
  332. my $not = shift;
  333. return $sc{$not} if (grep /^$not$/, keys(%sc));
  334. return $EMPTY_ENUM;
  335. }
  336. sub get_shade_hex($){
  337. my $en = shift;
  338. return $SHADE{$en};
  339. }
  340. sub get_cell_shade($$){
  341. my ($r0, $c0) = (shift, shift);
  342. my $not;
  343. $not = cell_index_rev($c0, $r0);
  344. return get_shade_hex(get_shade_en($not));
  345. }
  346. # Display lines
  347. #==================================================
  348. sub disp_1($$){
  349. my ($r0, $c0) = (shift, shift);
  350. my $hex;
  351. $hex = get_cell_shade($r0, $c0)->[0];
  352. return $hex;
  353. }
  354. sub disp_2($$){
  355. my ($r0, $c0) = (shift, shift);
  356. my $p;
  357. my $not;
  358. my $hex;
  359. $hex = get_cell_shade($r0, $c0)->[1];
  360. $not = cell_index_rev($c0, $r0);
  361. $p = $board{$not};
  362. return sub_pi_str($p, $c0, $hex);
  363. }
  364. sub disp_3($$){
  365. my ($r0, $c0) = (shift, shift);
  366. my $hex;
  367. $hex = get_cell_shade($r0, $c0)->[2];
  368. return $hex;
  369. }
  370. sub disp_y_axis($$$$){
  371. my ($s0, $s1, $s2, $r0) = @_;
  372. my $n0;
  373. $n0 = length($r0);
  374. $s0 = $r0 % 2 == 1 ? $PAD_ODD : $PAD_EVEN.$PREF_1;
  375. $s1 = $r0 % 2 == 1 ? $PAD_ODD : $PAD_EVEN.$PREF_2;
  376. $s1 =~ s/^ {$n0}/$r0/;
  377. $s2 = $r0 % 2 == 1 ? $PAD_ODD : $PAD_EVEN.$PREF_3;
  378. return ($s0, $s1, $s2);
  379. }
  380. # Display cell
  381. #==================================================
  382. sub add_cell($$$$$){
  383. my ($s0, $s1, $s2, $r0, $c0) = @_;
  384. $s0 .= disp_1($r0, $c0);
  385. $s1 .= disp_2($r0, $c0);
  386. $s2 .= disp_3($r0, $c0);
  387. return ($s0, $s1, $s2);
  388. }
  389. sub disp_0($){
  390. my $r0;
  391. my ($s0, $s1, $s2);
  392. $r0 = shift;
  393. # Append the y axis
  394. ($s0, $s1, $s2) = disp_y_axis($s0, $s1, $s2, $r0);
  395. # Iterate through the cells
  396. for my $i (1..11){
  397. ($s0, $s1, $s2) = add_cell($s0, $s1, $s2, $r0, $i);
  398. }
  399. return $s0."\n".$s1."\n".$s2."\n";
  400. }
  401. # Display row
  402. #==================================================
  403. sub disp_row($){
  404. my $row;
  405. my $r0;
  406. $r0 = shift;
  407. $row = disp_0($r0);
  408. # Handle trailing characters
  409. if($r0 % 2 == 1){
  410. # Trim the start of the first line
  411. $row =~ s/$TRAIL_1/ /;
  412. # Trim the end of the first line
  413. $row =~ s/\n/$TRAIL_3\n/
  414. }else{
  415. # Trim the end of the last line
  416. $row =~ s/$TRAIL_2\n/ \n/m;
  417. }
  418. return $row;
  419. }
  420. sub disp_trailing_row(){
  421. my $s0;
  422. my $s1;
  423. $s0 = $PAD_EVEN.$PREF_1;
  424. # Clear some chars from
  425. # our hex patterns
  426. $s1 = $HEX_1;
  427. substr($s1, 2,2) = " ";
  428. # Append hex pattern to
  429. # trailing row
  430. for my $i (1..11){
  431. $s0 .= $s1;
  432. }
  433. # Clear one last pair of
  434. # chrs
  435. substr($s0, -2,2) = " ";
  436. $s0 .= "\n";
  437. return $s0;
  438. }
  439. sub disp_x_axis(){
  440. my $s0;
  441. $s0 = $PAD_AXIS;
  442. $s0 .= join(
  443. $PAD_AXIS, map{
  444. $AXIS_RV{$_}
  445. }(1..11));
  446. $s0 .= "\n";
  447. $s0 .= $PAD_AXIS;
  448. $s0 .= join(
  449. "", map{
  450. $_ % 2 == 1 ? $HL_1 : $HL_2
  451. }(1..11));
  452. $s0 .= "\n";
  453. return $s0
  454. }
  455. # Display board
  456. #==================================================
  457. sub disp_board(){
  458. my $b;
  459. for my $i (map {11-$_+1} (1..11)) {
  460. $b .= disp_row($i);
  461. }
  462. $b .= disp_trailing_row();
  463. $b .= disp_x_axis();
  464. $b =~ s/$TRAIL_1$TRAIL_3\n/\n/m;
  465. for my $i (1..11-1){
  466. substr($b, 2+6*$i, 2) = " ";
  467. }
  468. printf("%s", $b);
  469. }
  470. # Caclulate movement
  471. #==================================================
  472. sub pi_split($$){
  473. my ($not, $i0) = (shift, shift);
  474. return (split(/$DIV/, $board{$not}))[$i0];
  475. }
  476. sub cell_pi($){
  477. my $not = shift;
  478. return pi_split($not, 1);
  479. }
  480. sub cell_pl($){
  481. my $not = shift;
  482. return pi_split($not, 0);
  483. }
  484. sub cell_index_rev($$){
  485. return $AXIS_RV{$_[0]}.$_[1];
  486. }
  487. sub cell_index($){
  488. my $chr1 = substr($_[0], 0,1);
  489. my $chr2 = substr($_[0], 1,length($_[0])-1);
  490. return ($AXIS{$chr1}, $chr2);
  491. }
  492. sub apply_shift($$){
  493. my ($not, $my_shift) = (shift, shift);
  494. my $r0;
  495. my $c0;
  496. ($r0, $c0) = cell_index($not);
  497. $r0 += $my_shift->[0];
  498. $c0 += $my_shift->[1];
  499. return $ERR_C_1 if $r0 > 11 or $c0 > 11 or $r0 < 1 or $c0 < 1;
  500. return cell_index_rev($r0, $c0);
  501. }
  502. sub calc_new_cell($$){
  503. my ($not, $mov) = (shift, shift);
  504. my ($c0, $r0) = cell_index($not);
  505. my $x_shift;
  506. my $y_shift;
  507. my $n0;
  508. my $ni;
  509. # get y_shift
  510. $y_shift = $mov->[1];
  511. # get x_shift
  512. $x_shift = $mov->[0];
  513. # make x_shift adjustment
  514. $ni = $y_shift != 0 ? ($y_shift / abs($y_shift)) : 1;
  515. $n0 = ($r0 + (($ni + 1)/2) ) % 2;
  516. $x_shift += int(($y_shift + ($n0 * $ni)) / 2);
  517. return apply_shift($not, [$x_shift, $y_shift]);
  518. }
  519. sub get_mov($$){
  520. my ($pi, $en) = (shift, shift);
  521. my @mv1;
  522. @mv1 = grep {
  523. ($_->{"type"} & $en) != 0
  524. } @{$MOVE{$pi}};
  525. return \@mv1;
  526. }
  527. sub find_all_mov($$){
  528. my ($not, $en) = (shift, shift);
  529. my $pi;
  530. my @mv1;
  531. $pi = cell_pi($not);
  532. @mv1 = @{ get_mov($pi, $en) };
  533. return grep {
  534. $_ if $_->[0] ne $ERR_C_1
  535. } map {
  536. [
  537. calc_new_cell($not, $_->{"mov"}),
  538. $_->{"type"}
  539. ]
  540. } @mv1;
  541. }
  542. sub shade_pi_mvmt($$){
  543. my ($not, $en) = (shift, shift);
  544. my $c1;
  545. my @mv1;
  546. @mv1 = find_all_mov($not, $en);
  547. for my $mv (@mv1){
  548. apply_shade($mv->[0], $mv->[1]);
  549. }
  550. }
  551. sub shade_all_mvmt($$){
  552. my ($pl, $en) = (shift, shift);
  553. my @pi1;
  554. # $pl = shift;
  555. @pi1 = grep {
  556. cell_pl($_) eq $pl
  557. } keys(%board);
  558. for my $el (@pi1){
  559. shade_pi_mvmt($el, $en);
  560. }
  561. }
  562. sub shade_all_p1_mvmt($){
  563. shade_all_mvmt($P1, $MOVBLOCK_ENUM);
  564. }
  565. sub get_block_cell($){
  566. my $pl;
  567. $pl = shift;
  568. return map {
  569. $_->[0]
  570. } map {
  571. ( find_all_mov($_, $BLOCK_ENUM) );
  572. } grep {
  573. cell_pl($_) eq $pl
  574. } keys(%board);
  575. }
  576. sub new {
  577. my $class = shift;
  578. my $self = { @_ };
  579. # Creates a hash of the the form
  580. # $board{cell_notation} = piece_enum
  581. %board = map {
  582. $_ => $EMPTY_CELL
  583. } map {
  584. my $l0;
  585. $l0 = $_;
  586. (map {$l0.$_} ("1".."11"))
  587. } map {
  588. $AXIS_RV{$_}
  589. }(1...11);
  590. return bless $self, $class;
  591. }
  592. binmode(STDOUT, ":utf8");
  593. return 1;