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

Text File | 1994-01-30 | 5.2 KB | 238 lines

//⌐ David Jean, 1993
game solII is 37 by 20;

//A1 A2 A3 A4 B1 B2 B3 B4 C1

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

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

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

procedure About is
begin
  Clear 'About Solitaire II';
  write('Rules from : ?.\n');
  write('Program : ⌐ David Jean, 1993.\n');
end;

stack A1, A2, A3, A4, B1, B2, B3, B4;

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

predicate EmptySpot? is
begin
  with it do
    if it!=0 then return TRUE
  for A1, A2, A3, A4, B1, B2, B3, B4;
  return FALSE;
end;

predicate IsIn?(fs : stack; c1 : card) is
var i : integer;
begin
  i:=1;
  while i<=fs! do
    if fs[i]=c1 then
      begin
      flash fs[i];
      return TRUE;
      end
    else i:=i+1;
  return FALSE;
end;

predicate KingIsIn?(fs : stack) is
var i : integer,
    r : boolean;
begin
  //on commence a 2 parce qu'on s'en fout si un roi est le premier d'une pile
  i:=2;
  r:=FALSE;
  while i<=fs! do
    begin
    if not IsSideDown?(fs[i]) then
      if IsKing?(fs[i]) then
        begin
        flash fs[i];
        r:=TRUE;
        end;
    i:=i+1;
    end;
  return r;
end;

predicate Visible?(fs : stack; c1 : card) is
begin
  with it do
    if it<>fs then
      if IsIn?(it,c1) then return TRUE
  for A1, A2, A3, A4, B1, B2, B3, B4;
  return FALSE;
end;

predicate KingVisible?(fs : stack) is
var r : boolean;
begin
  r:=FALSE;
  with it do
    if it<>fs then
      if KingIsIn?(it) then r:=TRUE
  for A1, A2, A3, A4, B1, B2, B3, B4;
  return r;
end;

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

stack C1 is
  X := 34;
  Y := 2;
  Direction := over;
  W := 3;
  H := 4;
  //****************************
  Start is OneDeckDown;
  //****************************
  Select(Spos : Index) is
  var movepossible : boolean;
    begin
    movepossible:=FALSE;
    with it do
      if (it!=0) and KingVisible?(it) then movepossible:=TRUE
      else if not IsAce?(it[it!]) and Visible?(it,it[it!]-1) then movepossible:=TRUE
    for A1, A2, A3, A4, B1, B2, B3, B4;
    if movepossible or (!=0) then break;
    with it do
      begin
      Pull 1 to it;
      Turn it[it!] side up;
      Draw it;
      end
    for A1, A2, A3, A4;
    end;
  //****************************
  Help is
    begin
    Clear 'The Stock';
    Write('You can click here to move the four remaining cards to ');
    Write('the first four pile on The Tableau.\n');
    Write('It will work only if no move can be made on The Tableau.\n');
    Write('If there are legal moves, they will flash.\n');
    Wait 'About...' About;
    end;
end C1;

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

stack A1 is
  X := 2;
  Y := 2;
  Direction := down;
  W := 3;
  H := 18;
  //****************************
  Start is
    begin
    Pull 6 from C1;
    Turn [1..6] side up;
    Draw C1;
    end;
  //****************************
  Select(Spos : Index) is
    begin
    if Spos>! then Spos:=!;
    if IsSideDown?([Spos]) then break;
    if IsKing?([Spos]) then
      with it do
        if (it!=0) then
          begin
          Pull !-Spos+1 to it;
          break procedure;
          end
      for A1, A2, A3, A4, B1, B2, B3, B4
    else
      with it do
        if it<>self then
          if FollowSuit?(it[it!],[Spos]) then
        begin
            Pull !-Spos+1 to it;
            break procedure;
            end
      for A1, A2, A3, A4, B1, B2, B3, B4;
    end;
  //****************************
  Help is
    begin
    Clear 'The Tableau';
    Write('Each card played here must be of the same suit and be in descending ');
    Write('sequence to the card on which it is played.\n');
    Write('You can pick a card anywhere on The Tableau (if it is side up).\n');
    Write('Every cards below the one you choose will move with it.\n\n');
    Write('Only kings can be moved in an empty spot.\n\n');
    Write('The goal is four piles of a unique suit beginning with The King and ending with The Ace.\n');
    Wait 'About...' About;
    end;
end A1;

stack A2 from A1 is
  X := 6;
end A2;

stack A3 from A1 is
  X := 10;
end A3;

stack A4 from A1 is
  X := 14;
end A4;

stack B1 from A1 is
  X := 18;
  //****************************
  Start is
    begin
    Pull 6 from C1;
    Turn [3..6] side up;
    Draw C1;
    end;
end B1;

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

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

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

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

predicate win? is
begin
  with it do
    if (it!=13) then
      if not (it.KingToAceSuit?) then return FALSE
      else
    else if (it!<>0) then return FALSE
  for A1, A2, A3, A4, B1, B2, B3, B4;
  return TRUE;
end;

predicate Integrity? is
begin
  with it do
    if it!>0 then
      if IsSideDown?(it[it!]) then
        Turn it[it!] side up
  for B1, B2, B3, B4;
  return TRUE;
end;

order C1, A1, A2, A3, A4, B1, B2, B3, B4;
  title:='Solitaire II'.