Implementation of Lucifers Pastime
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

115 line
2.0KB

  1. #!/usr/bin/perl
  2. package main;
  3. use warnings;
  4. use strict;
  5. use lib './';
  6. use LPST;
  7. my $b;
  8. # Move types
  9. my $SUMMON = 0b00000001;
  10. my $MOVE = 0b00000010;
  11. my $CAPTURE = 0b00000100;
  12. my $SACRIFICE = 0b00001000;
  13. # my $SPELL = 0b10000000;
  14. my $DRAW = 0b01000000;
  15. sub is_summon($){
  16. return $_[0] =~ /\*/ ? $SUMMON : 0;
  17. }
  18. sub is_move($){
  19. return $_[0] =~ /([A-Za-z]{1,2}[0-9]{1,2}){2}/ ? $MOVE : 0;
  20. }
  21. sub is_capture($){
  22. return $_[0] =~ /\~/ ? $CAPTURE : 0;
  23. }
  24. sub is_sacrifice($){
  25. return $_[0] =~ /([A-Za-z]{1,2}[0-9]{1,2}' ?){2}/ ? $SACRIFICE : 0;
  26. }
  27. sub is_draw($){
  28. return $_[0] <= 1 ? $DRAW : 0;
  29. }
  30. sub draw($$){
  31. my ($s0, $apl) = (shift, shift);
  32. die "invalid draw() syntax $s0" unless $s0 =~ /^([A-Za-z]{1,2} ){1,3}[A-Za-z]{1,2}$/;
  33. }
  34. sub mt2($$$){
  35. my ($s0, $tc, $apl) = (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($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 $ns0 = shift;
  60. my $apl;
  61. my $tc;
  62. $apl = LPST->P1;
  63. $tc = 0;
  64. for my $s0 (split(/\n/, $ns0)){
  65. mt2($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";
  74. $ns0 .= "A S Im Rc\n";
  75. f1($ns0);
  76. my $m1 = "C10";
  77. my $m2 = "B3";
  78. my $c1 = LPST->MG_SY;
  79. my $c2 = LPST->MG_A;
  80. $b = LPST->new();
  81. # $board{$m1} = $P1.$DIV.$c1;
  82. # $board{$m2} = $P2.$DIV.$c2;
  83. # $b->shade_all_p1_mvmt();
  84. # $b->disp_board();