Shareware Overload/ShartewareOverload.cdr/games/tbridge.zip/INIT.BR

Text File | 1986-06-01 | 10KB | 375 lines

{  ╔══════════════════════════════════════════════════════╗
   ║         INIT.BR  Module of BRIDGE.PAS                ║                                                      ║
   ║                                                      ║
   ║                Last modified 10/29/85                ║
   ║                                                      ║
   ║   Initializes bridge data structures, deals the      ║
   ║   cards, and calls bid and play display routines.    ║
   ╚══════════════════════════════════════════════════════╝
}

function Min(a, b: integer): integer;
begin
  if a < b then
    Min := a
  else
    Min := b;
end; { Min }

function Max(a, b: integer): integer;
begin
  if a > b then
    Max := a
  else
    Max := b;
end; { Min }

procedure Exchange(a, b: IndexType);
{ Exchange cards with index A and B in Sdist and updates Sdata }
var
  ah, bh : HandType;
  an, bn : CardNoType;
  Card   : CardType;

procedure Update(Hand: HandType;   Sign: integer);
{ Update Sdata[Hand] }
begin
  with Sdata[Hand], Card do
  begin
    l[Suit] := l[Suit] +  Sign;
    if Value > 10 then
      p := p + (Value - 10) * Sign; { High Card points }
    if l[Suit] * 2 - Sign <= 5 then
      p := p - Sign; { Distribution points }
  end;
end; { Update }

begin { Exchange }
  ah := a and 3;
  an := a shr 2;
  bh := b and 3;
  bn := b shr 2;
  Card := Sdist[ah, an];
  Update(ah, -1);
  Update(bh, 1);
  Sdist[ah, an] := Sdist[bh, bn];
  Sdist[bh, bn] := Card;
  Card := Sdist[ah, an];
  Update(bh, -1);
  Update(ah, 1);
end; { Exchange }

procedure ChangeCards;
{ Mixes some of the unknown cards in Sdist in such a way that
  Sdata still corresponds with Info afterwards }
var
  Cnt    : integer;
  a, b   : IndexType;
  ah, bh : HandType;
  ac, bc : CardType;

begin { ChangeCards }
  for Cnt := 1 to 26 do
  begin
    repeat
      a  := Random(52);  { 1st Card }
      ah := a and 3;
      ac := Sdist[ah, a shr 2];
    until not ac.Known;
    repeat
      b  := Random(52);     { 2nd Card }
      bh := b and 3;
      bc := Sdist[bh, b shr 2];
    until not bc.Known;
    if ah <> bh then
    begin
      Exchange(a, b);      { Exchange cards }
         { if the the difference between Sdata and Info was made
           larger, then Exchange the cards Back again }
      if (Info[ah].Minl[ac.Suit] > Sdata[ah].l[ac.Suit])
         or (Info[bh].Minl[ac.Suit] < 0)
         or (Info[bh].Minl[bc.Suit] > Sdata[bh].l[bc.Suit])
         or (Info[ah].Minl[bc.Suit] < 0)
         or (ac.Value > 10)
           and ((Sdata[ah].p < Info[ah].MinP)
             or (Sdata[ah].p > Info[ah].MaxP))
         or (bc.Value > 10)
           and ((Sdata[bh].p < Info[bh].MinP)
             or (Sdata[bh].p > Info[bh].MaxP)) then
               Exchange(a, b);
    end; { if }
  end;
end; { ChangeCards }

procedure DealCards;
{ Deals the unknown cards in Sdist at Random.
  if BidNo=0, All cards will be changed }
var
  i, j : IndexType;
  Hand : HandType;
  No   : CardNoType;
begin
  { Calculate which cards are known }
  if BidNo <> 0 then
    for Hand := North to West do
      for No := 0 to 12 do
        with Sim, Sdist[Hand, No] do
          { Played and own cards and Dummy are known,
            and Dummy knows partners Hand }
          Known := Played or (Hand=PlayingHand)
                   or (Round>0)
                     and ((Hand=Dummy) or (PlayingHand=Dummy)
                       and not odd(Hand + Dummy));

  for i := 0 to 50 do    { Mix unKNOWN cards }
    if not Sdist[i and 3, i shr 2].Known then  { Get All unknown positions }
    begin
      repeat  { Pick an unknown Card }
        j := i + Random(52 - i);
      until not Sdist[j and 3, j shr 2].Known;
      Exchange(i, j);
    end;
end; { DealCards }

procedure DealNewCards;
{ Deals the cards in Sdist at Random. }
var
  i, j : IndexType;
begin
  for i := 0 to 50 do    { Mix cards }
  begin
    repeat  { Pick an unknown Card }
        j := i + Random(52 - i);
    until not Sdist[j and 3, j shr 2].Known;
    Exchange(i, j);
  end;
end; { DealNewCards }

procedure SortCards;
{ Sorts each Suit in each Hand in Sdist with largest cards first }
var
  h    : HandType;
  i, j : CardNoType;
  Card : CardType;
begin
  for h := North to West do
    for i := 0 to 11 do with Sdist[h, i] do
      if not Known then
        for j := i + 1 to 12 do
          if not    Sdist[h, j].Known and
             (Suit =Sdist[h, j].Suit) and
             (Value<Sdist[h, j].Value) then
          begin
            Card     := Sdist[h, i];
            Sdist[h, i] := Sdist[h, j];
            Sdist[h, j] := Card;
          end;
end; { SortCards }

procedure InitGames;
{ Initializes the global variables in beginning of program }
var
  h    : HandType;
  No   : CardNoType;
  s, s0 : SuitType;
begin
  Randomize;
  InitTrumpStr;
  Writeln('Creating BRIDGE script file...');
  Assign(OutputFile, 'BRIDGE');
  {$I-}
  Rewrite(OutputFile);
  if IOresult <> 0 then
  begin
    Writeln('Cannot open script file.  Program aborting.');
    Halt;
  end;
  {$I+}
  Writeln(OutputFile, '                          TURBO BRIDGE');
  Writeln(OutputFile, '                        ================');
  Writeln(OutputFile);
  { Initialize Sdist and Sdata }
  for s := Club to Spade do
  begin
    h := Ord(s);
    for No := 0 to 12 do
      with Rdist[h, No] do
      begin
        Suit := s;
        Value := No + 2;
        Played := true;
      end;
    with Rdata[h] do
    begin
      for s0 := Club to Spade do
        l[s0] := 0;   p := 10 + 3*3;
    end;
  end; { for }
  GameNo := 0;              { Initialize variables }
  Dealer := West;
  Dummy := West;
  GetDefaults;            { Read information from keyboard }
end; { InitGames }

procedure StopGames;
begin
  Close(OutputFile);
  LowVideo;
  GotoXY(1, 25);
  ClrEol;
  Halt;
end;

procedure PrintBidScreen;
{ Setup the screen used for Bidding }
var
  Hand: HandType;
begin
  ClearInfoArea;
  ClearIt;  { Clears table and bid window }
  PrintScreen(North);
  PrintNames(Dealer);
  for Hand := North to West do
    if HandKnown(Hand) then
    begin
      GotoHand(Hand, 7, 0);
      SetColor(HandNameColor);
      Write(Sdata[Hand].p - DistPoints(Hand):2, ' + ', DistPoints(Hand):1);
    end;
  OutputHands;
  OutputNames(Dealer);
end;  { PrintBidScreen }

var
  DummyPartner : integer;
      { holds the Value of Partner of the Dummy which needs to be
        restored at the end of the Game if the Computer decided to
        play the Hand for the Computer }

procedure HumanPlays(Dummy : HandType);
{ Now the user plays the dummys Hand }
begin
  Computer[DummyPartner] := false;
  Computer[Dummy] := true;
end; { HumanPlays }

procedure ResetPartner;
{ if human Played the Dummy then this procedure resets the
  Dummy and the declarer appropriately.  This procedure is
  called when the Hand is concluded }
begin
  if (DummyPartner <> - 1) then { then the human Played for the Computer }
  begin
    Computer[DummyPartner] := true;
    Computer[Partner(DummyPartner)] := false;
  end;
  DummyPartner := -1;
end;  { ResetPartner }

procedure PrintPlayScreen;
{ Setup the screen used for playing }
begin
  if DummyPartner <> -1 then
    HumanPlays(Dummy);
  PrintScreen(Dummy);
  PrintNames((Dummy - 1) and 3);
  PrintContract;
  OutputContract;
  Writeln(OutputFile);
  OutputNames((Dummy - 1) and 3);
end; { PrintPlayScreen }

procedure ResetGameVars;
{ Reset game variables for new game, new deal or new bids }
var
  h  : HandType;
  No : CardNoType;
  s  : SuitType;
begin
  BidNo := 0;
  Contract := Pass;
  Doubled := 0;
  with Rel do begin
    Round := 0;
    WonTricks := 0;
    TrickNo := 0;
  end;
  Sdist := Rdist;
  Sdata := Rdata;  { Make All cards unPLAYED }
  for h := North to West do
    with Info[h] do
    begin
      for No := 0 to 12 do with Sdist[h, No], Sdata[h] do
      begin
        if Played then
          l[Suit] := l[Suit] + 1;
        Known := false;
        Played := false;
      end;
      MinP := 0;
      MaxP := 40;
      for s := Club to Spade do
        Minl[s] := 0;
    end;
end; { ResetGameVars }

procedure ResetGame;
{ Reset variables to Start a new Game }
var
  i : integer;
begin
  GameNo := GameNo + 1;
  Dealer := (Dealer + 1) and 3;
  ResetGameVars;
  for i := 1 to (Random(3) + 1) do
    DealNewCards;            { Deal and sort cards, and print the screen }
  SortCards;
  Rdist := Sdist;
  Rdata := Sdata;
  PrintBidScreen;
end;  { ResetGame }

procedure NewDeal;
{ Reset variables to Start a new Game }
var
  i : integer;
begin
  ResetGameVars;
  for i := 1 to (Random(3) + 1) do
    DealNewCards;
  SortCards;
  Rdist := Sdist;
  Rdata := Sdata;
  Writeln(OutputFile);
  Writeln(OutputFile, '           Redeal Cards...');
  Writeln(OutputFile);
  Writeln(OutputFile);
  PrintBidScreen;
end; { NewDeal }

procedure ClearBids;
{ Clears the bids in the current game without redealing }
begin
  ResetGameVars;
  ClearTable;
  InfoNo := 0;
  ClearBidWindow;
  Writeln(OutputFile);
  Writeln(OutputFile, '           Bids Cleared...');
end; { ClearBids }

procedure StartPlay;
{ Start the play after the Bidding }
begin
  with Rel do
  begin
    LeadHand := (Dummy + 3) and 3;
    PlayingHand := LeadHand;
    Sdist := Rdist;
    Sdata := Rdata;
    PrintContract;
  end;
end; { StartPlay }

{ end INIT.BR }