home *** CD-ROM | disk | FTP | other *** search
/ 300 Favorite Games / 300GAMES.iso / 61 / discard.cdl < prev    next >
Text File  |  1994-01-30  |  3KB  |  144 lines
  1. //⌐ David Jean, 1993
  2. game discard is 17 by 11;
  3.  
  4. // A1 A2 A3 A4
  5. //  D1     D2
  6.  
  7. {--------------------------------------------------------------------------}
  8.  
  9. #include 'predicat.cdh'
  10. #include 'deck.cdh'
  11.  
  12. stack Cursor is
  13.   Handler := HCARDS;
  14. end Cursor;
  15.  
  16. {--------------------------------------------------------------------------}
  17.  
  18. procedure About is
  19. begin
  20.   Clear 'About Discard';
  21.   write('Rules from : 150 solitaire games by Douglas Brown, Harrow Books, 1972.\n');
  22.   write('Program : ⌐ David Jean, 1993.\n');
  23. end;
  24.  
  25. stack A1, A2, A3, A4;
  26.  
  27. stack D2 is
  28.   X := 12;
  29.   Y := 7;
  30.   Direction := over;
  31.   w := 3;
  32.   h := 4;
  33. end D2;
  34.  
  35. stack D1 is
  36.   X := 4;
  37.   Y := 7;
  38.   Direction := over;
  39.   w := 3;
  40.   h := 4;
  41.   //****************************
  42.   Start is
  43.     begin
  44.     OneDeckDown;
  45.     [0]:=CrossCard;
  46.     end;
  47.   //****************************
  48.   Select(Spos : Index) is
  49.     with it do
  50.       begin
  51.       Pull 1 to it;
  52.       Turn it[it!] side up;
  53.       Draw it;
  54.       end
  55.     for A1, A2, A3, A4;
  56.   //****************************
  57.   Help is
  58.     begin
  59.     Clear 'The Stock';
  60.     Write('Click a mouse button here to deal four more cards.\n');
  61.     Wait 'About...' About;
  62.     end;
  63. end D1;
  64.  
  65. {--------------------------------------------------------------------------}
  66.  
  67. stack A1 is
  68.   X := 2;
  69.   Y := 2;
  70.   Direction := over;
  71.   w := 3;
  72.   h := 4;
  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.     begin
  82.     with it do
  83.       if it<>self then
  84.         if SameSuit?([!],it[it!]) and Smaller?([!],it[it!]) then
  85.           begin
  86.           Pull 1 to D2;
  87.           Turn D2[D2!] side down;
  88.           break procedure;          
  89.           end
  90.     for A1, A2, A3, A4;
  91.     Pull 1 to Cursor;
  92.     end;
  93.   //****************************
  94.   SelectTo(Spos : Index) is
  95.     if !=0 then Pull 1 from Cursor;
  96.   //****************************
  97.   Help is
  98.     begin
  99.     Clear 'The Tableau';
  100.     Write('Any card lower in value than another of its suit can be discarded ');
  101.     Write('by clicking on it with a mouse button.\n');
  102.     Write('Kings are high and Aces are low.\n\n');
  103.     Write('An empty space can be filled by dragging any visible card on it.\n\n');
  104.     Write('The goal is to end with only the four Kings remaining on The Tableau.\n');
  105.     Wait 'About...' About;
  106.     end;
  107. end A1;
  108.  
  109. stack A2 from A1 is
  110.   X := 6;
  111.   Y := 2;
  112. end A2;
  113.  
  114. stack A3 from A1 is
  115.   X := 10;
  116.   Y := 2;
  117. end A3;
  118.  
  119. stack A4 from A1 is
  120.   X := 14;
  121.   Y := 2;
  122. end A4;
  123.  
  124. {--------------------------------------------------------------------------}
  125.  
  126. predicate Win? is 
  127.   return (D1!=0) and (A1!=1) and (A2!=1) and (A3!=1) and (A4!=1);
  128.   
  129. //ok, loose satisfies win, but win is verified first
  130. predicate Loose? is
  131. var t : integer;
  132. begin
  133.   if D1!>0 then return FALSE;
  134.   t:=0;
  135.   with it do
  136.     if it!>0 then
  137.       t:=t+1<<((it[it!] mod 52) / 13)
  138.   for A1, A2, A3, A4;
  139.   return (t=15);
  140. end;  
  141.  
  142. order D1, D2, A1, A2, A3, A4;
  143.   title:='Discard'.
  144.