//© David Jean, 1993
game discard is 17 by 11;

// A1 A2 A3 A4
//  D1     D2

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

{****c1 et c2 sont de meme sorte}
predicate SameSuite?(c1, c2 : Card) is
  return (c1 / 13) = (c2 / 13);

{****c2 est plus petit que c1}  
predicate Smaller?(c1, c2 : Card) is
  return (c1 mod 13) < (c2 mod 13);

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

procedure About is
begin
  Clear 'About Discard';
  write('Rules from : 150 solitaire games by Douglas Brown, Harrow Books, 1972.\n');
  write('Program : © David Jean, 1993.\n');
end;

stack A1;
stack A2;
stack A3;
stack A4;

stack D2 is
  X := 12;
  Y := 7;
  Direction := over;
  w := 3;
  h := 4;
end D2;

stack D1 is
  X := 4;
  Y := 7;
  Direction := over;
  w := 3;
  h := 4;
  //****************************
  Start is
    begin
    Add Ace+Spade .. king+Diamond;
    Turn [1..52] side down;
    Shuffle;
    [0]:=CrossCard;
    end;
  //****************************
  Select(Spos : Index) is
    begin
    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('Click a mouse button here to deal four more cards.\n');
    Wait 'About...' About;
    end;
end D1;

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

stack A1 is
  X := 2;
  Y := 2;
  Direction := over;
  w := 3;
  h := 4;
  //****************************
  Start is
    begin
    Pull 1 from D1;
    Turn [1] side up;
    end;
  //****************************
  SelectFrom(Spos : Index) is
    begin
    with it do
      if it<>self then
        if SameSuite?([!],it[it!]) and Smaller?([!],it[it!]) then
          begin
          Pull 1 to D2;
          Turn D2[D2!] side down;
          break procedure;          
          end
    for A1, A2, A3, A4;
    Pull 1 to Cursor;
    end;
  //****************************
  SelectTo(Spos : Index) is
    if !=0 then Pull 1 from Cursor;
  //****************************
  Help is
    begin
    Clear 'The Tableau';
    Write('Any card lower in value than another of its suit can be discarded ');
    Write('by clicking on it with a mouse button.\n');
    Write('Kings are high and Aces are low.\n\n');
    Write('An empty space can be filled by dragging any visible card on it.\n\n');
    Write('The goal is to end with only the four Kings remaining on The Tableau.\n');
    Wait 'About...' About;
    end;
end A1;

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

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

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

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

predicate Win? is 
  return (D1!=0) and (A1!=1) and (A2!=1) and (A3!=1) and (A4!=1);

//ok, loose satisfies win, but win is verified first
predicate Loose? is
var t : integer;
begin
  if D1!>0 then return FALSE;
  t:=0;
  with it do
    if it!>0 then
      t:=t+1<<((it[it!] mod 52) / 13)
  for A1, A2, A3, A4;
  return (t=15);
end;  

order D1, D2, A1, A2, A3, A4.