home *** CD-ROM | disk | FTP | other *** search
/ Home Edutainment Collection 5: Windows Games / Aztech-HomeEdutainmentCollection-Vol5-WindowsGames.iso / cardws12 / calcul.cdl next >
Text File  |  1993-11-04  |  5KB  |  247 lines
  1. //⌐ David Jean, 1993
  2. game calculation is 21 by 18;
  3.  
  4. //   A1 A2 A3 A4
  5. //   B1 B2 B3 B4
  6. // D1
  7.  
  8. {--------------------------------------------------------------------------}
  9.  
  10. {****c2 est un de plus que c1}  
  11. predicate FollowWrap1?(c1, c2 : Card) is
  12.   return ((c1 + 1) mod 13) = (c2 mod 13);
  13.  
  14. {****c2 est deux de plus que c1}  
  15. predicate FollowWrap2?(c1, c2 : Card) is
  16.   return ((c1 + 2) mod 13) = (c2 mod 13);
  17.  
  18. {****c2 est trois de plus que c1}  
  19. predicate FollowWrap3?(c1, c2 : Card) is
  20.   return ((c1 + 3) mod 13) = (c2 mod 13);
  21.  
  22. {****c2 est quatre de plus que c1}  
  23. predicate FollowWrap4?(c1, c2 : Card) is
  24.   return ((c1 + 4) mod 13) = (c2 mod 13);
  25.  
  26. procedure MoveFirstFrom(c1 : card; src : stack) is
  27. var i : integer;
  28. begin
  29.   i:=1;
  30.   while i<src! do
  31.     if (src[i] mod 13)=c1 then 
  32.       begin
  33.       Move src[i] to [1];
  34.       break;
  35.       end
  36.     else i:=i+1;
  37. end;
  38.  
  39. {--------------------------------------------------------------------------}
  40.  
  41. procedure About is
  42. begin
  43.   Clear 'About Calcul';
  44.   write('Rules from : RΘglements officiels des jeux de cartes, Intl. playing card company limited, 1977.\n');
  45.   write('Program : ⌐ David Jean, 1993.\n');
  46. end;
  47.  
  48. procedure ShowSuite is
  49. begin
  50.   Write('Ace    2    3    4\n');
  51.   Write('2    4    6    8\n');
  52.   Write('3    6    9    Queen\n');
  53.   Write('4    8    Queen    3\n');
  54.   Write('5    10    2    7\n');
  55.   Write('6    Queen    5    Jack\n');
  56.   Write('7    Ace    8    2\n');
  57.   Write('8    3    Jack    6\n');
  58.   Write('9    5    Ace    10\n');
  59.   Write('10    7    4    Ace\n');
  60.   Write('Jack    9    7    5\n');
  61.   Write('Queen    Jack    10    9\n');
  62.   Write('King    King    King    King\n');
  63.   Wait 'About...' About;
  64. end;
  65.  
  66. stack A1;
  67. stack A2;
  68. stack A3;
  69. stack A4;
  70. stack B1;
  71. stack B2;
  72. stack B3;
  73. stack B4;
  74.  
  75. var src : stack;
  76.  
  77. stack D1 is
  78.   X := 2;
  79.   Y := 9;
  80.   Direction := over;
  81.   w := 3;
  82.   h := 4;
  83.   //****************************
  84.   Start is
  85.     begin
  86.     Add Ace+Spade .. king+Diamond;
  87.     Shuffle;
  88.     [0]:=CrossCard;
  89.     end;
  90.   //****************************
  91.   SelectFrom(Spos : Index) is
  92.     begin
  93.     if !>0 then 
  94.       begin
  95.       Pull 1 to Cursor;
  96.       src:=D1;
  97.       end;
  98.     end;
  99.   //****************************
  100.   Help is
  101.     begin
  102.     Clear 'The Stock';
  103.     Write('You build The Tableau or the Foundation by dragging cards from here, one by one.\n');
  104.     Wait 'About...' About;
  105.     end;
  106. end D1;
  107.  
  108. {--------------------------------------------------------------------------}
  109.  
  110. stack A1 is
  111.   X := 6;
  112.   Y := 2;
  113.   Direction := over;
  114.   w := 3;
  115.   h := 4;
  116.   //****************************
  117.   Start is
  118.     MoveFirstFrom(Ace,D1);
  119.   //****************************
  120.   SelectTo(Spos : Index) is
  121.     begin
  122.     if FollowWrap1?([!],Cursor[1]) then
  123.       Pull 1 From Cursor;
  124.     end;
  125.   //****************************
  126.   Help is
  127.     begin
  128.     Clear 'Foundations';
  129.     Write('Arithmetic sequences are build here.\n');
  130.     Write('The Suite is not important.\n\n');
  131.     Write('The goal is to bring every sequence to the king.\n\n');
  132.     Wait 'Sequences...' ShowSuite;
  133.     Wait 'About...' About;
  134.     end;
  135. end A1;
  136.  
  137. stack A2 is
  138.   X := 10;
  139.   Y := 2;
  140.   Direction := over;
  141.   w := 3;
  142.   h := 4;
  143.   //****************************
  144.   Start is
  145.     MoveFirstFrom(Deuce,D1);
  146.   //****************************
  147.   SelectTo(Spos : Index) is
  148.     begin
  149.     if FollowWrap2?([!],Cursor[1]) then
  150.       Pull 1 From Cursor;
  151.     end;
  152.   //****************************
  153.   Help from A1;
  154. end A2;
  155.  
  156. stack A3 is
  157.   X := 14;
  158.   Y := 2;
  159.   Direction := over;
  160.   w := 3;
  161.   h := 4;
  162.   //****************************
  163.   Start is
  164.     MoveFirstFrom(Three,D1);
  165.   //****************************
  166.   SelectTo(Spos : Index) is
  167.     begin
  168.     if FollowWrap3?([!],Cursor[1]) then
  169.       Pull 1 From Cursor;
  170.     end;
  171.   //****************************
  172.   Help from A1;
  173. end A3;
  174.  
  175. stack A4 is
  176.   X := 18;
  177.   Y := 2;
  178.   Direction := over;
  179.   w := 3;
  180.   h := 4;
  181.   //****************************
  182.   Start is
  183.     MoveFirstFrom(Four,D1);
  184.   //****************************
  185.   SelectTo(Spos : Index) is
  186.     begin
  187.     if FollowWrap4?([!],Cursor[1]) then
  188.       Pull 1 From Cursor;
  189.     end;
  190.   //****************************
  191.   Help from A1;
  192. end A4;
  193.  
  194. {--------------------------------------------------------------------------}
  195.  
  196. stack B1 is
  197.   X := 6;
  198.   Y := 7;
  199.   Direction := down;
  200.   w := 3;
  201.   h := 11;
  202.   //****************************
  203.   SelectFrom(Spos : Index) is
  204.   begin
  205.     if !>0 then 
  206.       begin
  207.       Pull 1 to Cursor;
  208.       src:=self;
  209.       end;
  210.   end;
  211.   //****************************
  212.   SelectTo(Spos : Index) is
  213.   begin
  214.     if src=D1 then Pull 1 from Cursor;
  215.   end;
  216.   //****************************
  217.   Help is
  218.     begin
  219.     Clear 'The Tableau';
  220.     Write('You can bring cards from The Stock here.\n\n');
  221.     Write('Only the topmost card can be moved, and only to the Foundation.');
  222.     Wait 'About...' About;
  223.     end;
  224. end B1;
  225.  
  226.  
  227. stack B2 from B1 is
  228.   X := 10;
  229.   Y := 7;
  230. end B2;
  231.  
  232. stack B3 from B1 is
  233.   X := 14;
  234.   Y := 7;
  235. end B3;
  236.  
  237. stack B4 from B1 is
  238.   X := 18;
  239.   Y := 7;
  240. end B4;
  241.  
  242. {--------------------------------------------------------------------------}
  243.  
  244. predicate Win? is return (A1!=13) and (A2!=13) and (A3!=13) and (A4!=13);
  245.  
  246. order D1, A1, A2, A3, A4, B1, B2, B3, B4.
  247.