home *** CD-ROM | disk | FTP | other *** search
/ Game Zone - 1,000+ Games / GAMEZONE.BIN / Programs / Win / CARDSWORKSHOP / MAIRE.CDL < prev    next >
Text File  |  1993-09-26  |  3KB  |  162 lines
  1. //⌐ David Jean, 1993
  2. game maire is 32 by 13;
  3.  
  4. // D1    Discard 
  5. // A1
  6. // A2
  7.  
  8. {--------------------------------------------------------------------------}
  9.  
  10. {****c1 et c2 sont du meme Rang}
  11. predicate SameRank?(c1, c2 : Card) is
  12.   return (c1 mod 13) = (c2 mod 13);
  13.  
  14. {--------------------------------------------------------------------------}
  15.  
  16. stack D1;
  17. stack A1;
  18. stack A2;
  19.  
  20. var s : stack;
  21.     tur : integer;
  22.     info : boolean;
  23.  
  24. procedure WaitInfo;
  25.  
  26. procedure UpDate is
  27.   if info then 
  28.     begin
  29.     Clear 'Informations' At 7,2 Is 20 by 3;
  30.     Write('Turn : ',tur,' / 3\n');
  31.     Write('Remaining Cards : ',D1!+A1!+A2!);
  32.     WaitInfo;
  33.     end
  34.   else Clear;
  35.  
  36. procedure About is
  37. begin
  38.   Clear 'About Maire';
  39.   write('Rules from : ?\n');
  40.   write('Program : ⌐ David Jean, 1993.\n');
  41.   if Info then Wait 'Info...' UpDate;
  42. end;
  43.  
  44. procedure Doinfo is
  45. begin 
  46.   info := not info;
  47.   UpDate;
  48. end;
  49.  
  50. procedure WaitInfo is
  51.   if info then
  52.     Wait 'Info Off' DoInfo
  53.   else
  54.     Wait 'Info On' DoInfo;
  55.  
  56. stack Discard is
  57.   x := 28;
  58.   y := 2;
  59.   Direction := over;
  60.   w := 4;
  61.   h := 3;
  62.   //****************************
  63.   Start is
  64.     UpDate;
  65. end Discard;
  66.  
  67. stack A1 is
  68.   X := 2;
  69.   Y := 6;
  70.   Direction := right;
  71.   w := 30;
  72.   h := 3;
  73.   //****************************
  74.   Start is
  75.     begin
  76.     Pull 1 From D1;
  77.     Turn [1] side up;
  78.     end;
  79.   //****************************
  80.   SelectFrom(Spos : Index) is
  81.     if !>0 then Pull 1 to Cursor;
  82.   //****************************
  83.   SelectTo(Spos : Index) is
  84.     if !>0 then
  85.       if SameRank?([!],Cursor[1]) then
  86.         begin
  87.         Pull 1 to Discard;
  88.     Pull 1 from Cursor to Discard;
  89.     UpDate;
  90.         end;
  91.   //****************************
  92.   Help is
  93.     begin
  94.     Clear 'The Tableau';
  95.     Write('Any new card dealt from The Stock can be used to form a pair ');
  96.     Write('with its neighbor to the left or the rightmost card ');
  97.     Write('from the other pile.\n');
  98.     Write('Pairs are removed.\n\n');
  99.     Write('The goal is to empty The Tableau and The Stock.\n');
  100.     Wait 'About...' About;
  101.     if Info then Wait 'Info...' UpDate;
  102.     WaitInfo;
  103.     end;
  104. end A1;
  105.  
  106. stack A2 from A1 is
  107.   X := 2;
  108.   Y := 10;
  109. end A2;
  110.  
  111. stack D1 is
  112.   X := 2;
  113.   Y := 2;
  114.   Direction := over;
  115.   w := 4;
  116.   h := 3;
  117.   //****************************
  118.   Start is
  119.     begin
  120.     Add Ace+Spade .. King+Diamond;
  121.     Turn [1..52] side down;
  122.     Shuffle;
  123.     s := A1;
  124.     tur := 1;
  125.     info:=TRUE;
  126.     end;
  127.   //****************************
  128.   Select(Spos : Index) is
  129.     if !>0 then
  130.       begin
  131.       Pull 1 to s;
  132.       Turn s[s!] side up;
  133.       if s=A1 then s:=A2 else s:=A1;    
  134.       end
  135.     else if tur<3 then
  136.       begin
  137.       tur := tur + 1;
  138.       Pull A1! from A1;
  139.       Pull 1 to A1;
  140.       Pull A2! from A2;
  141.       Pull 1 to A2;
  142.       Shuffle;
  143.       Turn [1..!] side down;
  144.       UpDate;
  145.       end;
  146.   //****************************
  147.   Help is
  148.     begin
  149.     Clear 'The Stock';
  150.     Write('Click here to deal a card to one of the pile in the Tableau Alternatly.\n\n');
  151.     Write('You have three pass to complete the game.\n');
  152.     Wait 'About...' About;
  153.     if Info then Wait 'Info...' UpDate;
  154.     WaitInfo;
  155.     end;
  156. end D1;
  157.  
  158. predicate Win? is 
  159.   return (A1!=0) and (A2!=0) and (D1!=0);
  160.  
  161. order D1, A1, A2, Discard.
  162.