home *** CD-ROM | disk | FTP | other *** search
/ 1,000 Games / Disc2.iso / CARD / CARDWS17 / MAIRE.CDL < prev    next >
Encoding:
Text File  |  1994-01-30  |  3.2 KB  |  163 lines
  1. //⌐ David Jean, 1993
  2. game maire is 32 by 13;
  3.  
  4. // D1    Discard 
  5. // A1
  6. // A2
  7.  
  8. {--------------------------------------------------------------------------}
  9.  
  10. #include 'predicat.cdh'
  11. #include 'deck.cdh'
  12.  
  13. stack CURSOR is
  14.   Handler := HCARDS;
  15. end CURSOR;
  16.  
  17. {--------------------------------------------------------------------------}
  18.  
  19. stack D1, A1, A2;
  20.  
  21. var s : stack,
  22.     tur : integer,
  23.     info : boolean;
  24.  
  25. procedure WaitInfo;
  26.  
  27. procedure UpDate is
  28.   if info then 
  29.     begin
  30.     Clear 'Informations' At 7,2 Is 20 by 3;
  31.     Write('Turn : ',tur,' / 3\n');
  32.     Write('Remaining Cards : ',D1!+A1!+A2!);
  33.     WaitInfo;
  34.     end
  35.   else Clear;
  36.  
  37. procedure About is
  38. begin
  39.   Clear 'About Maire';
  40.   write('Rules from : ?\n');
  41.   write('Program : ⌐ David Jean, 1993.\n');
  42.   if Info then Wait 'Info...' UpDate;
  43. end;
  44.  
  45. procedure Doinfo is
  46. begin 
  47.   info := not info;
  48.   UpDate;
  49. end;
  50.  
  51. procedure WaitInfo is
  52.   if info then
  53.     Wait 'Info Off' DoInfo
  54.   else
  55.     Wait 'Info On' DoInfo;
  56.  
  57. stack Discard is
  58.   x := 28;
  59.   y := 2;
  60.   Direction := over;
  61.   w := 4;
  62.   h := 3;
  63.   //****************************
  64.   Start is
  65.     UpDate;
  66. end Discard;
  67.  
  68. stack A1 is
  69.   X := 2;
  70.   Y := 6;
  71.   Direction := right;
  72.   w := 30;
  73.   h := 3;
  74.   //****************************
  75.   Start is
  76.     begin
  77.     Pull 1 From D1;
  78.     Turn [1] side up;
  79.     end;
  80.   //****************************
  81.   SelectFrom(Spos : Index) is
  82.     if !>0 then Pull 1 to Cursor;
  83.   //****************************
  84.   SelectTo(Spos : Index) is
  85.     if !>0 then
  86.       if SameRank?([!],Cursor[1]) then
  87.         begin
  88.         Pull 1 to Discard;
  89.     Pull 1 from Cursor to Discard;
  90.     UpDate;
  91.         end;
  92.   //****************************
  93.   Help is
  94.     begin
  95.     Clear 'The Tableau';
  96.     Write('Any new card dealt from The Stock can be used to form a pair ');
  97.     Write('with its neighbor to the left or the rightmost card ');
  98.     Write('from the other pile.\n');
  99.     Write('Pairs are removed.\n\n');
  100.     Write('The goal is to empty The Tableau and The Stock.\n');
  101.     Wait 'About...' About;
  102.     if Info then Wait 'Info...' UpDate;
  103.     WaitInfo;
  104.     end;
  105. end A1;
  106.  
  107. stack A2 from A1 is
  108.   X := 2;
  109.   Y := 10;
  110. end A2;
  111.  
  112. stack D1 is
  113.   X := 2;
  114.   Y := 2;
  115.   Direction := over;
  116.   w := 4;
  117.   h := 3;
  118.   //****************************
  119.   Start is
  120.     begin
  121.     OneDeckDown;
  122.     s := A1;
  123.     tur := 1;
  124.     info:=TRUE;
  125.     end;
  126.   //****************************
  127.   Select(Spos : Index) is
  128.     if !>0 then
  129.       begin
  130.       Pull 1 to s;
  131.       Turn s[s!] side up;
  132.       if s=A1 then s:=A2 else s:=A1;    
  133.       end
  134.     else if tur<3 then
  135.       begin
  136.       tur := tur + 1;
  137.       if tur=3 then [0]:=CrossCard; 
  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.   title:='Maire'.
  163.