1,000 Games/Disc2.iso/CARD/CARDWS17/NAPOLEON.CDL

Text File | 1994-01-27 | 5.5 KB | 254 lines

//⌐ David Jean, 1993
game napoleon is 41 by 24;

//    A1 A2 A3 A4 A5 A6 A7 A8
// B1 B2 B3 B4 B5 B6 B7 B8 B9 B0
//
// D1 D2

{--------------------------------------------------------------------------}

#include 'predicat.cdh'
#include 'deck.cdh'

{--------------------------------------------------------------------------}

procedure About is
begin
  Clear 'About NapolΘon α Sainte-HΘlΦne';
  write('Rules from : RΘglements officiels des jeux de cartes, Intl. playing card company limited, 1977.\n');
  write('Program : ⌐ David Jean, 1993.\n');
end;

#include 'rightbut.cdh'

stack D2, A1, A2, A3, A4, A5, A6, A7, A8, B1, B2, B3, B4, B5, B6, B7, B8, B9, B0;

stack D1 is
  X := 2;
  Y := 20;
  Direction := over;
  W := 3;
  H := 4;
  //****************************
  Start is
    begin
    OneDeckDown;
    OneDeckDown;
    [0]:=CrossCard;
    end;
  //****************************
  SelectLeftFrom(Spos : Index) is
    begin
    if !<>0 then
      begin
      Turn [!] Side Up;
      Pull 1 To D2;
      end;
    end;
  //****************************
  Help is
    begin
    Clear 'The Stock';
    Write('You can click here to move a card to The Waste Pile.\n');
    Wait 'About...' About;
    end;
end D1;

stack D2 is
  X := 7;
  Y := 20;
  Direction := right;
  W := 34;
  H := 4;
  //****************************
  SelectLeftFrom(Spos : Index) is
    if !<>0 then Pull 1 To Cursor;
  //****************************
  SelectRightFrom(Spos : Index) is
    if !>0 then
      begin
      Pull 1 to Cursor;
      PollLeftTo(|A1,A2,A3,A4,A5,A6,A7,A8|);
      PollLeftToNE(|B1,B2,B3,B4,B5,B6,B7,B8,B9,B0|);
      PollLeftTo(|B1,B2,B3,B4,B5,B6,B7,B8,B9,B0|);
      end;
  //****************************
  Help is
    begin
    Clear 'The Waste Pile';
    Write('The topmost card of this pile is available to play on The Tableau or The Foundation.\n\n');
    Write('You can Drag cards from here by using the left mouse button.\n\n');
    Wait 'Right Button...' RButton;
    Wait 'About...' About;
    end;
end D2;

{--------------------------------------------------------------------------}

stack A1 is
  X := 6;
  Y := 2;
  Direction := over;
  W := 3;
  H := 4;
  //****************************
  Start is
    begin
    [0]:=Ace+Spade;
    Turn [0] Side Shaded;
    end;
  //****************************
  SelectLeftTo(Spos : Index) is
    begin
    if Cursor!=1 then
      if (!=0) and SameCard?([0],Cursor[1]) then
        Pull 1 From Cursor
      else if SameSuit?(Cursor[1],[!]) and
              FollowRank?([!],Cursor[1]) then
        Pull 1 From Cursor;
    end;
  //****************************
  Help is
    begin
    Clear 'Foundations';
    Write('Plays are made to the Foundations in the same suit and in ascending order.\n\n');
    Write('The goal is to move all 104 cards here.\n\n');
    Write('At the start, this stack is grayed to indicate which card must be played here first.\n');
    Wait 'About...' About;
    end;
end A1;

stack A2 from A1 is
  X := 10;
  //****************************
  Start is
    begin
    [0]:=Ace+Heart;
    Turn [0] Side Shaded;
    end;
end A2;

stack A3 from A1 is
  X := 14;
  //****************************
  Start is
    begin
    [0]:=Ace+Club;
    Turn [0] Side Shaded;
    end;
end A3;

stack A4 from A1 is
  X := 18;
  //****************************
  Start is
    begin
    [0]:=Ace+Diamond;
    Turn [0] Side Shaded;
    end;
end A4;

stack A5 from A1 is
  X := 22;
end A5;

stack A6 from A2 is
  X := 26;
end A6;

stack A7 from A3 is
  X := 30;
end A7;

stack A8 from A4 is
  X := 34;
end A8;

{--------------------------------------------------------------------------}

stack B1 is
  X := 2;
  Y := 7;
  Direction := down;
  W := 3;
  H := 12;
  //****************************
  Start is
  begin
    Pull 4 From D1;
    Turn [1..4] Side Up;
    Draw D1;
  end;
  //****************************
  SelectLeftFrom from D2;
  SelectRightFrom from D2;
  //****************************
  SelectLeftTo(Spos : Index) is
  begin
    if (!=0) then
      Pull 1 From Cursor
    else if SameSuit?(Cursor[1],[!]) and
            FollowRank?(Cursor[1],[!]) then
      Pull 1 From Cursor;
  end;
  //****************************
  Help is
    begin
    Clear 'The Tableau';
    Write('Each card played here must be in descending sequence and of the same suit ');
    Write('to the card on which it is played.\n\n');
    Write('The bottommost card is available to play to The Foundation or to The Tableau.\n');
    Write('You can Drag cards from here by using the left mouse button.\n\n');
    Write('Any card can be moved in an empty spot.\n');
    Wait 'Right Button...' RButton;
    Wait 'About...' About;
    end;
end B1;

stack B2 from B1 is
  X := 6;
end B2;

stack B3 from B1 is
  X := 10;
end B3;

stack B4 from B1 is
  X := 14;
end B4;

stack B5 from B1 is
  X := 18;
end B5;

stack B6 from B1 is
  X := 22;
end B6;

stack B7 from B1 is
  X := 26;
end B7;

stack B8 from B1 is
  X := 30;
end B8;

stack B9 from B1 is
  X := 34;
end B9;

stack B0 from B1 is
  X := 38;
end B0;

{--------------------------------------------------------------------------}

predicate Win? is
  return (A1!=13) and (A2!=13) and (A3!=13) and (A4!=13) and
         (A5!=13) and (A6!=13) and (A7!=13) and (A8!=13);

order D1, D2, A1, A2, A3, A4, A5, A6, A7, A8,
      B1, B2 ,B3, B4, B5, B6, B7, B8, B9, B0;
  title:='NapolΘon'.