home *** CD-ROM | disk | FTP | other *** search
/ 1,000 Games / Disc2.iso / CARD / CARDWS17 / ROYAL.CDL < prev    next >
Encoding:
Text File  |  1994-01-30  |  7.4 KB  |  314 lines
  1. //⌐ David Jean, 1993
  2. game royal is 29 by 24;
  3.  
  4. // A1 C1 K1 B1 B2 B3
  5. // A2 C2 K2
  6. // A3 C3 K3 
  7. // A4 C4 K4  D1 D2
  8.  
  9. {--------------------------------------------------------------------------}
  10.  
  11. #include 'predicat.cdh'
  12.  
  13. {--------------------------------------------------------------------------}
  14.  
  15. procedure About is
  16. begin
  17.   Clear 'About Royal Families';
  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. stack D2, A1, A2, A3, A4, C1, C2, C3, C4, K1, K2, K3, K4, B1, B2, B3;
  25.  
  26. stack D1 is
  27.   X := 11;
  28.   Y := 19;
  29.   Direction := over;
  30.   w := 3;
  31.   h := 4;
  32.   Handler := VCARDS;
  33.   //****************************
  34.   Start is
  35.     begin
  36.     Add Three+Spade .. King+Spade;
  37.     Add Three+Heart .. King+Heart;
  38.     Add Three+Club .. King+Club;
  39.     Add Three+Diamond .. King+Diamond;
  40.     Turn [1..!] side down;
  41.     Shuffle;
  42.     Add Deuce+Diamond;
  43.     Add Deuce+Club;
  44.     Add Deuce+Heart;
  45.     Add Deuce+Spade;
  46.     Add Ace+Diamond;
  47.     Add Ace+Club;
  48.     Add Ace+Heart;
  49.     Add Ace+Spade;
  50.     [0]:=CrossCard;
  51.     end;
  52.   //****************************
  53.   SelectLeftFrom(Spos : Index) is
  54.     if !>0 then 
  55.       begin
  56.       Pull 1 to D2;
  57.       Turn D2[D2!] side up;
  58.       end;
  59.   //****************************
  60.   Help is
  61.     begin
  62.     Clear 'The Stock';
  63.     Write('You can click here to move a card to The Waste Pile.\n');
  64.     Wait 'About...' About;
  65.     end;
  66. end D1;
  67.  
  68. stack D2 is
  69.   X := 17;
  70.   Y := 19;
  71.   Direction := over;
  72.   w := 3;
  73.   h := 4;
  74.   Handler := VCARDS;
  75.   //****************************
  76.   Start is
  77.     begin
  78.     Pull 1 from D1;
  79.     Turn [1] side up;
  80.     end;
  81.   //****************************
  82.   SelectLeftFrom(Spos : Index) is
  83.     if !>0 then
  84.       Pull 1 To Cursor;
  85.   //****************************
  86.   SelectRightFrom(Spos : Index) is
  87.     if !>0 then
  88.       begin
  89.       Pull 1 to Cursor;
  90.       PollLeftTo(|K1,K2,K3,K4,A1,A2,A3,A4,C1,C2,C3,C4|);
  91.       PollLeftToNE(|B1,B2,B3|);
  92.       PollLeftTo(|B1,B2,B3|);
  93.       end;
  94.   //****************************
  95.   Help is
  96.     begin
  97.     Clear 'The Waste Pile';
  98.     Write('The topmost card of this pile is available to play on The Tableau or The Foundation.\n\n');
  99.     Write('You can Drag cards from here by using the left mouse button.\n');
  100.     Wait 'Right Button...' RButton;
  101.     Wait 'About...' About;
  102.     end;
  103. end D2;
  104.  
  105. {--------------------------------------------------------------------------}
  106.  
  107. stack A1 is
  108.   X := 2;
  109.   Y := 2;
  110.   Direction := over;
  111.   w := 3;
  112.   h := 4;
  113.   Handler := VCARDS;
  114.   //****************************
  115.   Start is
  116.     begin
  117.     Pull 1 From D1;
  118.     Draw D1;
  119.     end;
  120.   //****************************
  121.   SelectLeftTo(Spos : Index) is
  122.     if SameSuit?(Cursor[1],[!]) and
  123.        FollowRankN?(2,[!],Cursor[1]) then
  124.       Pull 1 From Cursor;
  125.   //****************************
  126.   Help is
  127.     begin
  128.     Clear 'Odd Foundations';
  129.     Write('Plays are made to the Foundations in the same suit and in ascending order ');
  130.     Write('of odd cards, Ace, Three, Five, Seven, Nine, Jack.\n\n');
  131.     Write('The goal is to move all 52 cards to the Foundations.\n');
  132.     Wait 'About...' About;
  133.     end;
  134. end A1;
  135.  
  136. stack A2 from A1 is
  137.   X := 26;
  138.   Y := 2;
  139. end A2;
  140.  
  141. stack A3 from A1 is
  142.   X := 2;
  143.   Y := 20;
  144. end A3;
  145.  
  146. stack A4 from A1 is
  147.   X := 26;
  148.   Y := 20;
  149. end A4;
  150.  
  151. {--------------------------------------------------------------------------}
  152.  
  153. stack C1 from A1 is
  154.   X := 6;
  155.   Y := 2;
  156.   //****************************
  157.   Help is
  158.     begin
  159.     Clear 'Even Foundations';
  160.     Write('Plays are made to the Foundations in the same suit and in ascending order ');
  161.     Write('of Even cards, Deuce, Four, Six, Eight, Ten, Queen.\n\n');
  162.     Write('The goal is to move all 52 cards to the Foundations.\n');
  163.     Wait 'About...' About;
  164.     end;
  165. end C1;
  166.  
  167. stack C2 from C1 is
  168.   X := 22;
  169.   Y := 2;
  170. end C2;
  171.  
  172. stack C3 from C1 is
  173.   X := 6;
  174.   Y := 20;
  175. end C3;
  176.  
  177. stack C4 from C1 is
  178.   X := 22;
  179.   Y := 20;
  180. end C4;
  181.  
  182. {--------------------------------------------------------------------------}
  183.  
  184. stack K1 from A1 is
  185.   X := 2;
  186.   Y := 7;
  187.   //****************************
  188.   Start is
  189.     [0]:=King+Spade+Shaded*DeckSize;
  190.   //****************************
  191.   SelectLeftTo(Spos : Index) is
  192.     if SameCard?(Cursor[1],[0]) then
  193.      Pull 1 From Cursor;
  194.   //****************************
  195.   Help is
  196.     begin
  197.     Clear 'Kings Foundations';
  198.     Write('Kings are played here.\n');
  199.     Write('They are grey at first to indicate wich King to move here.\n\n');
  200.     Write('The goal is to move all 52 cards to the Foundations.\n');
  201.     Wait 'About...' About;
  202.     end;
  203. end K1;
  204.  
  205. stack K2 from K1 is
  206.   X := 26;
  207.   Y := 7;
  208.   //****************************
  209.   Start is
  210.     [0]:=King+Heart+Shaded*DeckSize;
  211. end K2;
  212.  
  213. stack K3 from K1 is
  214.   X := 2;
  215.   Y := 15;
  216.   //****************************
  217.   Start is
  218.     [0]:=King+Club+Shaded*DeckSize;
  219. end K3;
  220.  
  221. stack K4 from K1 is
  222.   X := 26;
  223.   Y := 15;
  224.   //****************************
  225.   Start is
  226.     [0]:=King+Diamond+Shaded*DeckSize;
  227. end K4;
  228.  
  229. {--------------------------------------------------------------------------}
  230.  
  231. stack B1 is
  232.   X := 10;
  233.   Y := 3;
  234.   Direction := down;
  235.   w := 3;
  236.   h := 15;
  237.   Handler := VCARDS;
  238.   //****************************
  239.   Start is
  240.   begin
  241.     Pull 1 From D1;
  242.     Turn [1] Side Up;
  243.   end;
  244.   //****************************
  245.   SelectLeftFrom(Spos : Index) is
  246.     if !>0 then 
  247.       Pull 1 to Cursor;
  248.   //****************************
  249.   SelectLeftTo(Spos : Index) is
  250.     if (!=0) or 
  251.        (SameSuit?([!],Cursor[1]) and
  252.         FollowRankN?(2,Cursor[1],[!])) then
  253.       Pull 1 From Cursor;
  254.   //****************************
  255.   SelectRightFrom from D2;
  256.   //****************************
  257.   Help is
  258.     begin
  259.     Clear 'The Tableau';
  260.     Write('Each card played here must be in descending sequence and of the same suit ');
  261.     Write('to the card on which it is played.  They also must be both odd or even.\n\n');
  262.     Write('The bottommost card can be played to The Foundation.\n\n');  
  263.     Write('Any card can be moved in an empty spot on The Tableau.\n');
  264.     Wait 'Right Button...' RButton;
  265.     Wait 'About...' About;
  266.     end;
  267. end B1;
  268.  
  269.  
  270. stack B2 from B1 is
  271.   X := 14;
  272.   Y := 3;
  273. end B2;
  274.  
  275. stack B3 from B1 is
  276.   X := 18;
  277.   Y := 3;
  278. end B3;
  279.  
  280. {--------------------------------------------------------------------------}
  281.  
  282. predicate Win? is 
  283.   return (A1!=6) and (A2!=6) and (A3!=6) and (A4!=6) and
  284.          (C1!=6) and (C2!=6) and (C3!=6) and (C4!=6) and
  285.          (K1!=1) and (K2!=1) and (K3!=1) and (K4!=1);
  286.  
  287. predicate Loose? is
  288. begin
  289.   if D1!>0 then return FALSE;
  290.   with it do
  291.     if it!>0 then
  292.       if IsKing?(it[it!]) then return FALSE
  293.       else
  294.         with it2 do
  295.           if (SameSuit?(it[it!],it2[it2!]) and
  296.               FollowRankN?(2,it2[it2!],it[it!])) then
  297.             return FALSE
  298.         for A1, A2, A3, A4, C1, C2, C3, C4
  299.   for B1, B2, B3, D2;
  300.   with it do
  301.     if it!>0 then
  302.       with it2 do
  303.         if it2<>it then
  304.           if it2!=0 then return FALSE
  305.           else if (SameSuit?(it[it!],it2[it2!]) and
  306.                    FollowRankN?(2,it[it!],it2[it2!])) then return FALSE
  307.       for B1, B2, B3
  308.   for D2, B1, B2, B3;
  309.   return TRUE;
  310. end;         
  311.          
  312. order D1, A1, A2, A3, A4, C1, C2, C3, C4, K1, K2, K3, K4, D2, B1, B2, B3;
  313.   title:='Royal Families'.
  314.