program Bridge; (* written in TURBO PASCAL Aug '84
                        for a 52 column Osborne 1 *)
type
  Suit= (sp,he,di,cl,no);
  Rank= 2..14;
  Players= (w,n,e,s);
  Deck= record
    CardRank: Rank;
    CardSuit: Suit;
    end;
  HandFull= record
    Cards: array[Suit] of set of Rank;
    NumCards: array[Suit] of 0..13;
    Points: 0..40;
    Bid: string[2];
    end;
  HandArray= array[Players] of HandFull;
  Card= array[1..52] of Deck;
var
  player: Players;
  cardPlayed: Deck;
  hand: HandArray;
  cd: Card;
  ans, reDispl, amt, sute: char;
  quit: boolean;
  j: integer;
const
  name: array[10..14] of char= 'TJQKA';
  suitName: array[Suit] of string[2]= ('SP','HE','DI','CL','NO');

procedure Deal;
  var
    vSuit: Suit;
    vRank: Rank;
    vCard: Deck;
    cardDeck: Card;
    cardNo: integer;
  begin
  vRank:= 2; vSuit:= sp;
  for j:= 1 to 52 do (*Put cards in arrays*)
    begin
    cardDeck[j].CardRank:= vRank;
    cardDeck[j].CardSuit:= vSuit;
    if vRank= 14 then
      begin
      if vSuit < cl then vSuit:= succ(vSuit);
      vRank:= 2;
      end
    else vRank:= vRank+1;
    end;
  for j:= 1 to 52 do  (*Shuffle*)
    begin
    Randomize;
    cardNo:= random(53-j)+j;
    vCard:= cardDeck[j];
    cardDeck[j]:= cardDeck[cardNo];
    cardDeck[cardNo]:= vCard;
    end;
  for j:= 1 to 52 do
    cd[j]:= cardDeck[j];
  for player:= w to s do (*Initialize*)
    for vSuit:= sp to cl do
      hand[player].Cards[vSuit]:= [];
  for j:= 1 to 52 do (*Deal*)
    begin
    if player= s then player:= w
      else player:= succ(player);
    vRank:= cardDeck[j].CardRank;
    vSuit:= cardDeck[j].CardSuit;
    hand[player].Cards[vSuit]:= hand[player].Cards[vSuit] + [vRank];
    end;
  end;

procedure Display;
  var
    vSuit: Suit;
    vRank: Rank;
  begin
  ClrScr;
  write ('ESC');
  GotoXY(36,1); write ('North');
  GotoXY(21,8); write ('West');
  GotoXY(50,8); write ('East');
  GotoXY(36,15); write ('South');
  for player:= w to s do
  for vSuit:= sp to cl do
    begin
    case player of
      w: GotoXY(16,ord(vSuit)+10);
      n: GotoXY(31,ord(vSuit)+3);
      e: GotoXY(45,ord(vSuit)+10);
      s: GotoXY(31,ord(vSuit)+17);
      end;
        write (suitName[vSuit]:2);
    for vRank:= 14 downto 2 do
      if vRank in hand[player].Cards[vSuit] then
        if vRank < 10 then write (vRank:3)
          else write (name[vRank]:3);
    end;
  end;

procedure ReDisplay;
  var
    vSuit: Suit;
    vRank: Rank;
  begin
  for player:= w to s do (*Initialize*)
    for vSuit:= sp to cl do
      hand[player].Cards[vSuit]:= [];
    for j:= 1 to 52 do
      begin
      if player= s then player:= w
        else player:= succ(player);
      vRank:= cd[j].CardRank;
      vSuit:= cd[j].CardSuit;
      hand[player].Cards[vSuit]:= hand[player].Cards[vSuit] + [vRank];
      end;
  end;

procedure Evaluate;
  var
    vSuit: Suit;
    vRank: Rank;
    value, noCards: integer;
  begin
  for player:= w to s do
    begin
    value:= 0;
    for vSuit:= sp to cl do
      begin
      noCards:= 0;
      for vRank:= 2 to 14 do
        if vRank in hand[player].Cards[vSuit] then
          noCards:= Succ(noCards); (*number of cards in suit*)
      for vRank:= 11 to 14 do  (*J,Q,K,A*)
        if (vRank in hand[player].Cards[vSuit]) then
          value:= value+(vRank-10);
      hand[player].NumCards[vSuit]:= noCards;
      end; (*for vSuit*)
    hand[player].Points:= value;
    end; (*for player*)
  GotoXY(26,8); write ('(', hand[w].Points:2,' points)');
  GotoXY(42,1); write ('(', hand[n].Points:2,' points)');
  GotoXY(55,8); write ('(', hand[e].Points:2,' points)');
  GotoXY(42,15); write ('(',hand[s].Points:2,' points)');
  end;

procedure Contract;
  label R;
  begin
R:repeat
    GotoXY(1,22); write ('Contract: ');
    read (Kbd, amt);
    if amt in ['1'..'7'] then
      begin
      write (amt,' ');
      GotoXY(1,24); ClrEol;
      end
    else if amt= #27 then
      begin
      quit:= True;
      Exit;
      end
    else if amt= ' ' then begin GotoXY(1,24); ClrEol; end
    else if not (amt in ['1'..'7']) then
      begin
      GotoXY(1,24);
      write ('Try again...  (3 N or 4 H, etc)');
      GotoXY(11,22);
      end;
  until (amt in ['1'..'7']);
  repeat
    GotoXY(13,22);
    read (Kbd, sute);
    sute:= UpCase(sute);
    if sute in ['N','S','H','D','C'] then
      begin
      write (sute);
      GotoXY(1,24); ClrEol;
      end
    else if sute= chr(08) then goto R
    else if sute= #27 then
      begin
      quit:= True;
      Exit;
      end
    else if sute= ' ' then begin GotoXY(1,24); ClrEol; end
    else if not (sute in ['N','S','H','D','C']) then
      begin
      GotoXY(1,24);
      write ('Try again...  (3 N or 4 H, etc)');
      end;
  until (sute in ['N','S','H','D','C']);
 end;

procedure Rotate;
  var
    tHand: HandFull;
  begin
  quit:= False;
  GotoXY(15,22);
  write ('By: ');
  repeat
    GotoXY(19,22);
    read (Kbd, ans);
    if UpCase(ans) in ['N','S','E','W'] then
      begin
      write (UpCase(ans));
      GotoXY(1,24); ClrEol;
      end
    else if ans= ' ' then begin GotoXY(1,24); ClrEol; end
    else if not (UpCase(ans) in ['N','S','E','W',#27]) then
      begin
      GotoXY(1,24); write ('Please enter only N, S, E, or W');
      end;
  until UpCase(ans) in ['N','S','E','W',#27];
  case UpCase(ans) of
    'W': begin tHand:=Hand[w]; Hand[w]:=Hand[n]; Hand[n]:=Hand[e];
         Hand[e]:= Hand[s]; Hand[s]:= tHand; Display;
         GotoXY(1,22); write ('Contract: ',amt,' ',sute); end;
    'N': begin tHand:=Hand[n]; Hand[n]:=Hand[s]; Hand[s]:=tHand;
         tHand:=Hand[w]; Hand[w]:=Hand[e]; Hand[e]:=tHand; Display;
         GotoXY(1,22); write ('Contract: ',amt,' ',sute); end;
    'E': begin tHand:=Hand[e]; Hand[e]:=Hand[n]; Hand[n]:=Hand[w];
         Hand[w]:=Hand[s]; Hand[s]:=tHand; Display;
         GotoXY(1,22); write ('Contract: ',amt,' ',sute); end;
    'S': begin GotoXY(26,8); ClrEol; GotoXY(42,1); ClrEol;
         GotoXY(50,8); write ('East'); GotoXY(42,15); ClrEol;
         GotoXY(29,22); ClrEol; end;
    #27: quit:= True;
    end;
  end;

procedure Play;
  label R, R2;
  var
    winner: Players;
    trump, leadSuit, highSuit: Suit;
    vRank: Rank;
    tSuit, tRank: char;
    highCard, tricksLost, plays: integer;
    error: boolean;
procedure Lead;
begin
  highCard:= cardPlayed.CardRank;
  highSuit:= cardPlayed.CardSuit;
  winner:= player;
end;

begin
  tricksLost:= 0; plays:= 0; player:= w;
  case UpCase(sute) of
    'S': trump:= sp;
    'H': trump:= he;
    'D': trump:= di;
    'C': trump:= cl;
    'N': trump:= no;
     end;
  GotoXY(47,22); write ('Plays/TricksLost:');
  while plays < 13 do
    begin
    for j:= 1 to 4 do
      begin
      repeat
        error:= False;
  R:    case player of
          w: GotoXY(27,8);
          n: GotoXY(43,1);
          e: GotoXY(56,8);
          s: GotoXY(43,15);
          end;
        if (j <> 1) and (hand[player].Cards[leadSuit] <> []) then
          begin
          case leadSuit of
            sp: write ('S');
            he: write ('H');
            di: write ('D');
            cl: write ('C');
            end;
          cardPlayed.CardSuit:= leadSuit;
          end
        else
          begin
          read (Kbd,tSuit);
          case UpCase(tSuit) of
            'S': cardPlayed.CardSuit:= sp;
            'H': cardPlayed.CardSuit:= he;
            'D': cardPlayed.CardSuit:= di;
            'C': cardPlayed.CardSuit:= cl;
            #27: Exit;
            ' ': begin GotoXY(1,24); ClrEol; Goto R; end;
             else
               begin
               error:= True;
               GotoXY(1,24); ClrEol;
               write ('The suit can only be S, H, D, or C.  Try again...');
               end;
             end;
          if (hand[player].Cards[cardPlayed.CardSuit]= [])
            and (UpCase(tSuit) in ['S','H','D','C'])
              and (tSuit <> ' ') then
              begin
              error:= True;
              GotoXY(1,24);
              write ('You don''t have any cards in that suit.  Try again...');
              end
          else if (UpCase(tSuit) in ['S','H','D','C'])
            then
            begin
            write (UpCase(tSuit));
            GotoXY(1,24); ClrEol;
            end;
          end; (*else*)
      until error= False;
      repeat
        error:= False;
R2:     case player of
          w: GotoXY(29,8);
          n: GotoXY(45,1);
          e: GotoXY(58,8);
          s: GotoXY(45,15);
          end;
        read (Kbd, tRank); tRank:= UpCase(tRank);
        if tRank= chr(08) then goto R
        else if tRank= #27 then Exit
        else if tRank= ' ' then begin GotoXY(1,24); ClrEol; Goto R2; end;
        cardPlayed.CardRank:= pos(UpCase(tRank),' 23456789TJQKA');
        if (cardPlayed.CardRank
          in hand[player].Cards[cardPlayed.CardSuit])
            then write (UpCase(tRank));
        GotoXY(1,24); ClrEol;
        if not (cardPlayed.CardRank in
          hand[player].Cards[cardPlayed.CardSuit]) then
            begin
            if (tRank= 'S') or (tRank= 'H')
              or (tRank= 'D') or (tRank= 'C') then
                write ('The suit has already been entered.  Try again...')
            else write ('You don''t have that card.  Try again...');
            error:= True;
            end;
      until error= False;
      hand[player].Cards[cardPlayed.CardSuit]:=
       hand[player].Cards[cardPlayed.CardSuit] -
        [cardPlayed.CardRank];
      case player of
        w: begin
           GotoXY(18,ord(cardPlayed.CardSuit)+10);
           ClrEol;
           GotoXY(45,ord(cardPlayed.CardSuit)+10);
           write (suitName[cardPlayed.CardSuit]:2);
           for vRank:= 14 downto 2 do
             if vRank in hand[e].Cards[cardPlayed.CardSuit] then
               if vRank < 10 then write (vRank:3)
               else write (name[vRank]:3);
           GotoXY(18,ord(cardPlayed.CardSuit)+10);
           end;
         n: begin
            GotoXY(33,ord(cardPlayed.CardSuit)+3);
            ClrEol;
            end;
         e: begin
            GotoXY(47,ord(cardPlayed.CardSuit)+10);
            ClrEol;
            end;
         s: begin
            GotoXY(33,ord(cardPlayed.CardSuit)+17);
            ClrEol;
            end;
         end;
      for vRank:= 14 downto 2 do
        if vRank in hand[player].Cards[cardPlayed.CardSuit] then
          if vRank < 10 then write (vrank:3)
          else write (name[vRank]:3);
      if j= 1 then
        begin
        leadSuit:= cardPlayed.CardSuit;
        Lead;
        end;
      if (highSuit= trump)
        and (cardPlayed.CardSuit= trump)
          and (cardPlayed.CardRank > highCard) then
            Lead;
      if (highSuit <> trump)
        and (cardPlayed.CardSuit= trump) then
          Lead;
      if (cardPlayed.CardSuit= highSuit)
        and (cardPlayed.CardRank > highCard) then
          Lead;
      if player= s then player:= w
        else player:= succ(player);
      end; (*of 'for'*)
    case winner of
      w: begin
         player:= w;
         tricksLost:= tricksLost+1;
         end;
      n: player:= n;
      e: begin
         player:= e;
         tricksLost:= tricksLost+1;
         end;
      s: player:= s;
      end;
    plays:= Succ(plays);
    GotoXY(64,22); write (plays:2,'/',tricksLost);
    GotoXY(27,8); ClrEol;
    GotoXY(43,1); ClrEol;
    GotoXY(56,8); ClrEol;
    GotoXY(43,15); ClrEol;
    GotoXY(50,8); write ('East');
    end; (*of 'while'*)
end;


Begin (*MAIN PART*)
reDispl:= 'N';
repeat
  quit:= False;
  ClrScr;
  if reDispl <> 'Y' then Deal
    else ReDisplay;
  Display;
  Evaluate;
  Contract;
  if quit= False then
    Rotate;
  if quit= False then
    Play;
  GotoXY(1,24); ClrEol;
  write ('Do you want to see the deal again (Y/N)?');
  read (Kbd, reDispl); reDispl:= UpCase(reDispl);
  if reDispl <> 'Y' then
    begin
    GotoXY(20,24); ClrEol;
    write ('ANOTHER DEAL (Y/N)?');
    read (Kbd, ans); ans:= UpCase(ans);
    end;
until (ans= 'N') and (reDispl= 'N');
ClrScr;
End.
NOTHER DEAL