home *** CD-ROM | disk | FTP | other *** search
/ 1,000 Games / Disc2.iso / CARD / CARDWS17 / CALCUL.CDL next >
Encoding:
Text File  |  1994-02-06  |  4.5 KB  |  204 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. #include 'predicat.cdh'
  11. #include 'stack.cdh'
  12. #include 'deck.cdh'
  13.  
  14. {--------------------------------------------------------------------------}
  15.  
  16. procedure About is
  17. begin
  18.   Clear 'About Calcul';
  19.   write('Rules from : RΘglements officiels des jeux de cartes, Intl. playing card company limited, 1977.\n');
  20.   write('Program : ⌐ David Jean, 1993.\n');
  21. end;
  22.  
  23. procedure ShowSuite is
  24. begin
  25.   Write('Ace    2    3    4\n');
  26.   Write('2    4    6    8\n');
  27.   Write('3    6    9    Queen\n');
  28.   Write('4    8    Queen    3\n');
  29.   Write('5    10    2    7\n');
  30.   Write('6    Queen    5    Jack\n');
  31.   Write('7    Ace    8    2\n');
  32.   Write('8    3    Jack    6\n');
  33.   Write('9    5    Ace    10\n');
  34.   Write('10    7    4    Ace\n');
  35.   Write('Jack    9    7    5\n');
  36.   Write('Queen    Jack    10    9\n');
  37.   Write('King    King    King    King\n');
  38.   Wait 'About...' About;
  39. end;
  40.  
  41. stack A1, A2, A3, A4, B1, B2, B3, B4;
  42.  
  43. var src : stack;
  44.  
  45. stack D1 is
  46.   X := 2;
  47.   Y := 9;
  48.   Direction := over;
  49.   w := 3;
  50.   h := 4;
  51.   Handler := VCARDS;
  52.   //****************************
  53.   Start is
  54.     begin
  55.     OneDeckUp;
  56.     [0]:=CrossCard;
  57.     end;
  58.   //****************************
  59.   SelectFrom(Spos : Index) is
  60.     if !>0 then 
  61.       begin
  62.       Pull 1 to Cursor;
  63.       src:=self;
  64.       end;
  65.   //****************************
  66.   Help is
  67.     begin
  68.     Clear 'The Stock';
  69.     Write('You build The Tableau or the Foundation by dragging cards from here, one by one.\n');
  70.     Wait 'About...' About;
  71.     end;
  72. end D1;
  73.  
  74. {--------------------------------------------------------------------------}
  75.  
  76. stack A1 is
  77.   X := 6;
  78.   Y := 2;
  79.   Direction := over;
  80.   w := 3;
  81.   h := 4;
  82.   Handler := VCARDS;
  83.   //****************************
  84.   Start is MoveFirstFrom(Ace,D1);
  85.   //****************************
  86.   SelectTo(Spos : Index) is
  87.     if !<13 then
  88.       if FollowRankWrapN?(1,[!],Cursor[1]) then
  89.         Pull 1 From Cursor;
  90.   //****************************
  91.   Help is
  92.     begin
  93.     Clear 'Foundations';
  94.     Write('Arithmetic sequences are build here.\n');
  95.     Write('The Suite is not important.\n\n');
  96.     Write('The goal is to bring every sequence to the king.\n\n');
  97.     Wait 'Sequences...' ShowSuite;
  98.     Wait 'About...' About;
  99.     end;
  100. end A1;
  101.  
  102. stack A2 from A1 is
  103.   X := 10;
  104.   //****************************
  105.   Start is MoveFirstFrom(Deuce,D1);
  106.   //****************************
  107.   SelectTo(Spos : Index) is
  108.     if !<13 then
  109.       if FollowRankWrapN?(2,[!],Cursor[1]) then
  110.         Pull 1 From Cursor;
  111. end A2;
  112.  
  113. stack A3 from A1 is
  114.   X := 14;
  115.   //****************************
  116.   Start is MoveFirstFrom(Three,D1);
  117.   //****************************
  118.   SelectTo(Spos : Index) is
  119.     if !<13 then
  120.       if FollowRankWrapN?(3,[!],Cursor[1]) then
  121.         Pull 1 From Cursor;
  122. end A3;
  123.  
  124. stack A4 from A1 is
  125.   X := 18;
  126.   //****************************
  127.   Start is MoveFirstFrom(Four,D1);
  128.   //****************************
  129.   SelectTo(Spos : Index) is
  130.     if !<13 then
  131.       if FollowRankWrapN?(4,[!],Cursor[1]) then
  132.         Pull 1 From Cursor;
  133. end A4;
  134.  
  135. {--------------------------------------------------------------------------}
  136.  
  137. stack B1 is
  138.   X := 6;
  139.   Y := 7;
  140.   Direction := down;
  141.   w := 3;
  142.   h := 11;
  143.   Handler := VCARDS;
  144.   //****************************
  145.   SelectFrom from D1;
  146.   //****************************
  147.   SelectTo(Spos : Index) is
  148.     if src=D1 then Pull 1 from Cursor;
  149.   //****************************
  150.   Help is
  151.     begin
  152.     Clear 'The Tableau';
  153.     Write('You can bring cards from The Stock here.\n\n');
  154.     Write('Only the topmost card can be moved, and only to the Foundation.');
  155.     Wait 'About...' About;
  156.     end;
  157. end B1;
  158.  
  159.  
  160. stack B2 from B1 is
  161.   X := 10;
  162. end B2;
  163.  
  164. stack B3 from B1 is
  165.   X := 14;
  166. end B3;
  167.  
  168. stack B4 from B1 is
  169.   X := 18;
  170. end B4;
  171.  
  172. {--------------------------------------------------------------------------}
  173.  
  174. predicate Integrity? is
  175. begin
  176.   with it do
  177.     if it!=13 then 
  178.       if not IsShaded?(it[it!]) then Turn it[it!] side shaded
  179.   for A1, A2, A3, A4;
  180.   return TRUE;
  181. end;
  182.  
  183. predicate Win? is return (A1!=13) and (A2!=13) and (A3!=13) and (A4!=13);
  184.  
  185. predicate Loose? is
  186. var n : integer;
  187. begin
  188.   if D1!>0 then return FALSE;
  189.   n:=1;
  190.   with it do
  191.     begin
  192.     with it2 do
  193.       if it2!>0 then
  194.         if FollowRankWrapN?(n,it[it!],it2[it2!]) then return FALSE
  195.     for B1, B2, B3, B4;
  196.     n:=n+1;
  197.     end
  198.   for A1, A2, A3, A4;
  199.   return TRUE;
  200. end;
  201.  
  202. order B1, B2, B3, B4, D1, A1, A2, A3, A4;
  203.   title:='Calcul'.
  204.