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

699 行
18KB

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