home *** CD-ROM | disk | FTP | other *** search
/ 300 Favorite Games / 300GAMES.iso / 61 / klondike.cdl < prev    next >
Encoding:
Text File  |  1994-01-30  |  6.8 KB  |  311 lines
  1. //⌐ David Jean, 1993
  2. game klondike is 29 by 20;
  3.  
  4. //   D1 D2    A1 A2 A3 A4
  5. //   B1 B2 B3 B4 B5 B6 B7
  6.  
  7. {--------------------------------------------------------------------------}
  8.  
  9. #include 'predicat.cdh'
  10. #include 'function.cdh'
  11. #include 'deck.cdh'
  12.  
  13. {--------------------------------------------------------------------------}
  14.  
  15. procedure About is
  16. begin
  17.   Clear 'About Klondike';
  18.   write('Rules from : RΘglements officiels des jeux de cartes, Intl. playing card company limited, 1977.\n');
  19.   write('Program : ⌐ David Jean, 1993.\n');
  20. end;
  21.  
  22. #include 'rightbut.cdh'
  23.  
  24. var f : integer;
  25.  
  26. stack D2, A1, A2, A3, A4, B1, B2, B3, B4, B5, B6, B7;
  27.  
  28. stack D1 is
  29.   X := 2;
  30.   Y := 2;
  31.   Direction := over;
  32.   W := 3;
  33.   H := 4;
  34.   Handler := VCARDS;
  35.   //****************************
  36.   Start is OneDeckDown;
  37.   //****************************
  38.   SelectLeftFrom(Spos : Index) is
  39.   var i : integer;
  40.     begin
  41.     i:=Min(!,3);
  42.     if i=0 then
  43.       begin
  44.       Pull D2! From D2;
  45.       Turn [1..!] Side Down;
  46.       Inverse [1..!];
  47.       [0]:=EmptyCard;
  48.       f:=!;
  49.       end
  50.     else
  51.       begin
  52.       Turn [!-i+1..!] Side Up;
  53.       Inverse [!-i+1..!];
  54.       Pull 3 To D2;
  55.       if (!=0) and (f=D2!) then [0]:=CrossCard;
  56.       end;
  57.     end;
  58.   //****************************
  59.   Help is
  60.     begin
  61.     Clear 'The Stock';
  62.     Write('You can click here to move three cards to The Waste Pile or ');
  63.     Write('to turn The Waste Pile over when The Stock is empty.\n');
  64.     Wait 'About...' About;
  65.     end;
  66. end D1;
  67.  
  68. stack D2 is
  69.   X := 6;
  70.   Y := 2;
  71.   Direction := over;
  72.   W := 3;
  73.   H := 4;
  74.   Handler := VCARDS;
  75.   //****************************
  76.   Start is f:=D1!;
  77.   //****************************
  78.   SelectLeftFrom(Spos : Index) is
  79.     if !<>0 then Pull 1 To Cursor;
  80.   //****************************
  81.   SelectRightFrom(Spos : Index) is
  82.     if !>0 then
  83.       begin
  84.       Pull 1 to Cursor;
  85.       PollLeftTo(|A1,A2,A3,A4,B1,B2,B3,B4,B5,B6,B7|);
  86.       end;
  87.   //****************************
  88.   Help is
  89.     begin
  90.     Clear 'The Waste Pile';
  91.     Write('The topmost card of this pile is available to play on The Tableau or The Foundation.\n\n');
  92.     Write('You can Drag cards from here by using the left mouse button.\n');
  93.     Wait 'Right Button...' RButton;
  94.     Wait 'About...' About;
  95.     end;
  96. end D2;
  97.  
  98. {--------------------------------------------------------------------------}
  99.  
  100. stack A1 is
  101.   X := 14;
  102.   Y := 2;
  103.   Direction := over;
  104.   W := 3;
  105.   H := 4;
  106.   Handler := VCARDS;
  107.   //****************************
  108.   Start is
  109.     begin
  110.     [0]:=Ace+Spade;
  111.     Turn [0] Side Shaded;
  112.     end;
  113.   //****************************
  114.   SelectLeftTo(Spos : Index) is
  115.     begin
  116.     if Cursor!=1 then
  117.       if (!=0) and SameCard?([0],Cursor[1]) then
  118.         Pull 1 From Cursor
  119.       else if SameSuit?(Cursor[1],[!]) and
  120.               FollowRankWrap?([!],Cursor[1]) then
  121.         Pull 1 From Cursor;
  122.     end;
  123.   //****************************
  124.   Help is
  125.     begin
  126.     Clear 'Foundations';
  127.     Write('Plays are made to the Foundations in the same suit and in ascending order.\n\n');
  128.     Write('The goal is to move all 52 cards here.\n\n');
  129.     Write('At the start, this stack is grayed to indicate which card must be played here first.\n');
  130.     Wait 'About...' About;
  131.     end;
  132. end A1;
  133.  
  134. stack A2 from A1 is
  135.   X := 18;
  136.   Y := 2;
  137.   //****************************
  138.   Start is
  139.     begin
  140.     [0]:=Ace+Heart;
  141.     Turn [0] Side Shaded;
  142.     end;
  143. end A2;
  144.  
  145. stack A3 from A1 is
  146.   X := 22;
  147.   Y := 2;
  148.   //****************************
  149.   Start is
  150.     begin
  151.     [0]:=Ace+Club;
  152.     Turn [0] Side Shaded;
  153.     end;
  154. end A3;
  155.  
  156. stack A4 from A1 is
  157.   X := 26;
  158.   Y := 2;
  159.   //****************************
  160.   Start is
  161.     begin
  162.     [0]:=Ace+Diamond;
  163.     Turn [0] Side Shaded;
  164.     end;
  165. end A4;
  166.  
  167. {--------------------------------------------------------------------------}
  168.  
  169. stack B1 is
  170.   X := 2;
  171.   Y := 7;
  172.   Direction := down;
  173.   W := 3;
  174.   H := 13;
  175.   Handler := VCARDS;
  176.   //****************************
  177.   Start is
  178.   begin
  179.     Pull 1 From D1;
  180.     Turn [1] Side Up;
  181.     Draw D1;
  182.   end;
  183.   //****************************
  184.   SelectLeftFrom(Spos : Index) is
  185.   begin
  186.     if SPos>! then SPos:=!;
  187.     if IsSideDown?([Spos]) then break procedure;
  188.     Pull !-Spos+1 To Cursor;
  189.   end;
  190.   //****************************
  191.   SelectLeftTo(Spos : Index) is
  192.   begin
  193.     if (!=0) and IsKing?(Cursor[1]) then
  194.       Pull Cursor! From Cursor
  195.     else if AlternateColor?(Cursor[1],[!]) and
  196.             FollowRankWrap?(Cursor[1],[!]) then
  197.       Pull Cursor! From Cursor;
  198.   end;
  199.   //****************************
  200.   SelectRightFrom(Spos : Index) is
  201.     if !>0 then
  202.       begin
  203.       if SPos>! then SPos:=!;
  204.       if IsSideDown?([Spos]) then break;
  205.       Pull !-Spos+1 to Cursor;
  206.       PollLeftTo(|A1,A2,A3,A4,B1,B2,B3,B4,B5,B6,B7|);
  207.       end;
  208.   //****************************
  209.   Help is
  210.     begin
  211.     Clear 'The Tableau';
  212.     Write('Each card played here must be in descending sequence and of alternating color ');
  213.     Write('to the card on which it is played.\n\n');
  214.     Write('The bottommost card can be played to The Foundation.\n\n');  
  215.     Write('You can pick any sequence of cards, ending with the bottommost card, ');
  216.     Write('to move to another pile in The Tableau.\n\n'); 
  217.     Write('Only Kings can be moved in an empty spot on The Tableau.\n');
  218.     Wait 'Right Button...' RButton;
  219.     Wait 'About...' About;
  220.     end;
  221. end B1;
  222.  
  223.  
  224. stack B2 from B1 is
  225.   X := 6;
  226.   Y := 7;
  227.   //****************************
  228.   Start is
  229.   begin
  230.     Pull 2 From D1;
  231.     Turn [2] Side Up;
  232.     Draw D1;
  233.   end;
  234. end B2;
  235.  
  236. stack B3 from B1 is
  237.   X := 10;
  238.   Y := 7;
  239.   //****************************
  240.   Start is
  241.   begin
  242.     Pull 3 From D1;
  243.     Turn [3] Side Up;
  244.     Draw D1;
  245.   end;
  246. end B3;
  247.  
  248. stack B4 from B1 is
  249.   X := 14;
  250.   Y := 7;
  251.   //****************************
  252.   Start is
  253.   begin
  254.     Pull 4 From D1;
  255.     Turn [4] Side Up;
  256.     Draw D1;
  257.   end;
  258. end B4;
  259.  
  260. stack B5 from B1 is
  261.   X := 18;
  262.   Y := 7;
  263.   //****************************
  264.   Start is
  265.   begin
  266.     Pull 5 From D1;
  267.     Turn [5] Side Up;
  268.     Draw D1;
  269.   end;
  270. end B5;
  271.  
  272. stack B6 from B1 is
  273.   X := 22;
  274.   Y := 7;
  275.   //****************************
  276.   Start is
  277.   begin
  278.     Pull 6 From D1;
  279.     Turn [6] Side Up;
  280.     Draw D1;
  281.   end;
  282. end B6;
  283.  
  284. stack B7 from B1 is
  285.   X := 26;
  286.   Y := 7;
  287.   //****************************
  288.   Start is
  289.   begin
  290.     Pull 7 From D1;
  291.     Turn [7] Side Up;
  292.     Draw D1;
  293.   end;
  294. end B7;
  295.  
  296. {--------------------------------------------------------------------------}
  297.  
  298. predicate Win? is return (A1!=13) and (A2!=13) and (A3!=13) and (A4!=13);
  299.  
  300. predicate Integrity? is
  301. begin
  302.   with it do
  303.     if (it!>0) and IsSideDown?(it[it!]) then Turn it[it!] Side Up
  304.   for B1, B2, B3, B4, B5, B6, B7;
  305.  
  306.   return TRUE;
  307. end;
  308.  
  309. order D1, A1, A2, A3, A4, B1, B2, B3, B4, B5, B6, B7, D2;
  310.   title:='Klondike'.
  311.