Implementation of Lucifers Pastime
Nelze vybrat více než 25 témat Téma musí začínat písmenem nebo číslem, může obsahovat pomlčky („-“) a může být dlouhé až 35 znaků.

115 řádky
2.1KB

  1. #!/usr/bin/perl
  2. package main;
  3. use warnings;
  4. use strict;
  5. use lib './';
  6. use LPST;
  7. # Move types
  8. my $SUMMON = 0b00000001;
  9. my $MOVE = 0b00000010;
  10. my $CAPTURE = 0b00000100;
  11. my $SACRIFICE = 0b00001000;
  12. # my $SPELL = 0b10000000;
  13. my $DRAW = 0b01000000;
  14. sub is_summon($){
  15. return $_[0] =~ /\*/ ? $SUMMON : 0;
  16. }
  17. sub is_move($){
  18. return $_[0] =~ /([A-Za-z]{1,2}[0-9]{1,2}){2}/ ? $MOVE : 0;
  19. }
  20. sub is_capture($){
  21. return $_[0] =~ /\~/ ? $CAPTURE : 0;
  22. }
  23. sub is_sacrifice($){
  24. return $_[0] =~ /([A-Za-z]{1,2}[0-9]{1,2}' ?){2}/ ? $SACRIFICE : 0;
  25. }
  26. sub is_draw($){
  27. return $_[0] <= 1 ? $DRAW : 0;
  28. }
  29. sub draw($$$){
  30. my ($b, $s0, $apl) = (shift, shift, shift);
  31. die "invalid draw() syntax $s0" unless $s0 =~ /^([A-Za-z]{1,2} ){4}[A-Za-z]{1,2}$/;
  32. $b->draw($s0, $apl);
  33. }
  34. sub mt2($$$$){
  35. my ($b, $s0, $tc, $apl) = (shift, shift, shift, shift);
  36. # return $MOVE if $s0 =~ /([A-Za-z]{1,2}[0-9]{1,2}){2}/;
  37. # return $CAPTURE if $s0 =~ /\~/;
  38. # return $SACRIFICE if $s0 =~ /([A-Za-z]{1,2}[0-9]{1,2}' ?){2}/;
  39. # return $DRAW if $tc <= 1;
  40. draw($b, $s0, $apl) if is_draw($tc);
  41. }
  42. sub mt1($$$){
  43. my ($s0, $tc, $apl) = (shift, shift, shift);
  44. return is_summon($s0) ||
  45. is_move($s0) ||
  46. is_capture($s0) ||
  47. is_sacrifice($s0) ||
  48. is_draw($tc);
  49. }
  50. sub f2($$$){
  51. my ($s0, $tc, $apl) = (shift, shift, shift);
  52. # All the special cirucmstances
  53. # where a player moves twice are handled by spell cards
  54. # so this logic will do for now
  55. return LPST->P2 if $apl eq LPST->P1;
  56. return LPST->P1;
  57. }
  58. sub f1($$){
  59. my ($b, $ns0) = (shift, shift);
  60. my $apl;
  61. my $tc;
  62. $apl = LPST->P1;
  63. $tc = 0;
  64. for my $s0 (split(/\n/, $ns0)){
  65. mt2($b, $s0, $tc, $apl);
  66. $apl = f2($s0, $tc, $apl);
  67. # printf(">>%s\n", $s0);
  68. $tc++;
  69. }
  70. }
  71. my $ns0;
  72. $ns0 = "";
  73. $ns0 .= "A I It Au N\n";
  74. $ns0 .= "A S Im Rc It\n";
  75. my $m1 = "C10";
  76. my $m2 = "B3";
  77. my $c1 = LPST->MG_SY;
  78. my $c2 = LPST->MG_A;
  79. my $b;
  80. $b = LPST->new();
  81. f1($b, $ns0);
  82. # $board{$m1} = $P1.$DIV.$c1;
  83. # $board{$m2} = $P2.$DIV.$c2;
  84. # $b->shade_all_p1_mvmt();
  85. # $b->disp_board();