home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
games
/
tbridge.zip
/
BID.BR
next >
Wrap
Text File
|
1986-06-01
|
25KB
|
766 lines
{ ╔══════════════════════════════════════════════════════╗
║ INPUT.BR Module of BRIDGE.PAS ║ ║
║ ║
║ Last modified 10/29/85 ║
║ ║
║ Bids for the program and gets the users bids ║
║ from the keyboard and updates bidding information ║
╚══════════════════════════════════════════════════════╝
}
type BidClassType =
(OpenPass, { Open Pass }
open1S, { Open 1 Suit (1 He) }
open2S, { Open 2 Suit (2 He) }
OpenNT, { Open NT (1 NT) }
Resppass, { Response Pass (1 He, Pass) }
resp2S, { Response 2 S (1 He, 2 He) }
resp3S, { Response 3 S (1 He, 3 He) }
resp1o1, { Response 1-o-1 (1 He, 1 Sp) }
resp2o1, { Response 2-o-1 (1 He, 2 Cl) }
resp1NT, { Response 1 NT (1 He, 1 NT) }
resp2NT, { Response 2 NT (1 He, 2 NT) }
resp2S2NT, { Response 2 S - 2 NT (2 He, 2 NT) }
resp2Snorm, { Response 2 S - Norm (2 He, Others) }
Stayman, { Stayman (1 NT, 2 Cl) }
RespStayman, { Stayman response }
Blackwood, { Blackwood (4 NT or 5 NT) }
RespBlackwood, { Blackwood response }
resp1NT2S, { Response 1 NT - 2 S (1 NT, 2 He) }
SecondBidNT, { 2nd Bid NT (1 He, 2 Cl, 2 NT) }
Shutout, { Shutout Bids (Open 3 He) }
OverCall, { Opponent OverCall }
NormPass, { Normal Pass }
NormDBL, { Normal Dbl }
NormRDBL, { Normal RDbl }
NormBid, { Normal Bid }
Illegal); { Illegal Bid }
{ The TYPes of the Bids found in Bids }
var
BidTyp: array[-4..51] of BidClassType;
procedure InitBids;
{ Initialize Bids[-4..-1] and BidTyp[-4..-1] }
var
i: integer;
begin
for i := -4 to -1 do
begin
Bids[i] := Pass;
BidTyp[i] := OpenPass;
end;
end; { InitBids }
function Jumps(Bid: BidType): integer;
{ Count Number of Jumps from Contract to Bid }
begin
if Bid.Trump <= Contract.Trump then
Jumps := Bid.Level-Contract.Level-1
else
Jumps := Bid.Level-Contract.Level;
end; { Jumps }
type NumberType = 0..4;
function Number(Player: HandType; v: ValueType): NumberType;
{ Count how many cards Player has of the Value }
var
n : NumberType;
i : CardNoType;
begin
n := 0;
for i := 0 to 12 do
if Sdist[Player,i].Value = v then
n := n + 1;
Number := n;
end; { Number }
function BidClass(Bid: BidType): BidClassType;
{ Determines which BidClass the Bid belongs to,
using Contract, Bids and BidTyp }
var
PartnerBidtyp: BidClassType;
begin
with Bid do
begin
BidClass := NormBid; { Normal Bid }
if Jumps(Bid) >= 2 then { Double Jumps are Illegal }
BidClass := Illegal;
PartnerBidtyp := BidTyp[BidNo-2];
if (PartnerBidtyp = Stayman) and { Stayman response }
EqBid(Bids[BidNo - 1],Pass) then
BidClass := RespStayman
else
if (PartnerBidtyp = Blackwood) and { Blackwood response }
EqBid(Bids[BidNo - 1],Pass) then
BidClass := RespBlackwood
else
if PartnerBidtyp = open2S then { Response to opening 2 in Suit }
begin
BidClass := resp2Snorm;
if EqBid(Bids[BidNo-1],Pass) then
begin
if (Level = 2) and (Trump = NT) then { 2 NT is weak }
BidClass := resp2S2NT
else
if EqBid(Bid,Pass) then { Pass is Illegal, other Bids are strong }
BidClass := Illegal
end
else
if EqBid(Bid,Pass) then
BidClass := resp2S2NT;
end
else
if EqBid(Bid,Pass) then { Passes }
if PartnerBidtyp = OpenPass then
BidClass := OpenPass
else
if PartnerBidtyp = open1S then
BidClass := Resppass
else
BidClass := NormPass
else
if EqBid(Bid,Dbl) then { Doubles }
BidClass := NormDBL
else
if EqBid(Bid,RDbl) then { Redoubles }
BidClass := NormRDBL else
if (Trump = NT) and { Blackwood }
((Level = 4) or
(Level = 5) and (BidTyp[BidNo-4] = Blackwood)) then
BidClass := Blackwood else
if PartnerBidtyp = OpenNT then { Response to opening in NT }
begin
if Level = Bids[BidNo-2].Level + 1 then
if Trump = Club then { Club is Stayman }
BidClass := Stayman else
{ 2 in Suit is very weak }
if (Level = 2) and (Trump <> NT) then
BidClass := resp1NT2S
end
else
if (Trump = NT) and { Opening 1 in Suit, second Bid NT }
((PartnerBidtyp = resp1o1) and (Level <= 2) or
(PartnerBidtyp = resp2o1) and (Level <= 3)) then
BidClass := SecondBidNT
else
{ Response to opening 1 in Suit }
if PartnerBidtyp = open1S then
begin
if Trump = Bids[BidNo-2].Trump then
begin
if Level = 2 then
BidClass := resp2S
else
if Level = 3 then
BidClass := resp3S;
end
else
if Trump = NT then
begin
if Level = 1 then
BidClass := resp1NT
else
if Level = 2 then
BidClass := resp2NT;
end
else
if Level = 1 then
BidClass := resp1o1
else
if Level = 2 then
BidClass := resp2o1;
end
else
if BidNo < 4 then
if (Trump = NT) and (PartnerBidtyp = OpenPass) then
BidClass := OpenNT { Opening in NT }
else
if EqBid(Contract,Pass) then
if Level = 1 then { Opening in Suit }
BidClass := open1S
else
if Level = 2 then
BidClass := open2S
else
BidClass := Shutout
else
if Trump <> NT then { Opponents first Bid }
if Jumps(Bid) = 0 then
BidClass := OverCall
else
BidClass := Shutout;
end; { with }
end; { BidClass }
type TaskType = (CalcInfo,Evaluate);
function BidSystem(Bid: BidType; Task: TaskType): integer;
{ Depending on Task, BidSystem will
Task CalcInfo: Update Info according to the Bid.
Task Evaluate: Evaluate how the Bid fits with the present Hand }
var
Player, Partner : HandType; { Player to Bid and his Partner }
InfoPlayer : InfoType; { Updated Info for Player }
BidVal : integer; { The Evaluation of Bid }
Test : BOOLEAN; { Evaluate the Bid by testing
the Hand with InfoPlayer }
{ Necessary points to win a Contract }
const MinTab: array[BOOLEAN,LevelType] of integer =
((0,20,20,23,26,29,33,37), { Suit contracts }
(0,20,20,26,29,32,35,39)); { NT contracts }
procedure NormalPass;
{ Pass if the present Contract is correct }
var
p : integer;
begin
with InfoPlayer,Contract do
begin
p := Info[Partner].MinP;
if Level = 7 then
MaxP := 40
else
MaxP := MinTab[false,Level + 1]-p-2;
if not odd(Player + Dummy) then
begin
if (Level < 4) and not ((Level = 3) and (Trump = NT)) then
MaxP := Max(MaxP,24-p) { Check Game chance }
else
if (Level > 4) or (Trump >= Heart) then
begin
if Level < 6 then { Check slam chance }
MaxP := Max(MaxP,32-p);
BidVal := 9;
end;
{ Check the Suit }
if Trump <> NT then
Minl[Trump] := 7-Info[Partner].Minl[Trump];
end;
{ if the Opponent Bids then Pass means weak Hand }
if not EqBid(Bids[BidNo-1],Pass) then
MaxP := Max(MaxP,MinP + 2);
end; { with }
end; { NormalPass }
procedure NormalBid;
{ All normal Bids }
function MinPoints(Level: integer;
Trump: TrumpType; Jump: BOOLEAN): integer;
{ Minimum points for Bidding Level in TRUMPH }
var
Pts, MinPts : integer;
FoundTrump : TrumpType;
function FoundSuit: TrumpType;
{ Returns the eventual chosen trumpsuit }
var
s : SuitType;
begin
FoundSuit := NT;
for s := Club to Spade do
if Info[Player].Minl[s] + Info[Partner].Minl[s] >= 8 then
FoundSuit := s;
end; { FoundSuit }
begin { MinPoints }
with Info[Partner] do
begin
{ Make sure Partner can Bid the right Trump without getting too High }
FoundTrump := FoundSuit;
if (Trump > FoundTrump) and (Trump <> NT) then
Level := Level + 1;
Level := Min(Level,7);
MinPts := InfoPlayer.MinP;
{ Bidding when the Opponent has bidden means extra strength }
if not EqBid(Bids[BidNo-1],Pass) then
MinPts := MinPts + 3;
Pts := MinTab[Trump = NT,Level]-MinP-1;
if odd(Player + Dummy) and not Jump then
Pts := Pts-2;
MinPts := Max(MinPts,Pts);
if Jump or (Trump = Contract.Trump) or
(FoundTrump <> NT) and (FoundTrump = Contract.Trump) then
if Level > 5-Ord(Trump) div 2 then { Above Game means slam interest }
Pts := 33-MaxP
else { Jump means Game demand }
if (Level = 5-Ord(Trump) div 2) or Jump then
Pts := 25-MinP
else
Pts := 26-MaxP;
MinPoints := Max(MinPts,Pts);
end; { with }
end; { MinPoints }
var
s : SuitType;
i : integer;
n : LevelType;
begin { NormalBid }
with Sdata[Player],InfoPlayer,Bid do
begin
if Trump <> NT then { Trump Length }
Minl[Trump] := Min(Max(Minl[Trump] + 1,4),
8-Info[Partner].Minl[Trump])
else
if Level <> 3 then { NT means No singletons }
begin
for s := Club to Spade do
Minl[s] := 2;
BidVal := -9;
i := BidNo-2;
while i >= 0 do
begin
with Bids[i] do
if (Trump = NT) and (Level > 0) then
BidVal := 0;
i := i-4;
end;
end;
n := Level-Jumps(Bid); { Calculate MinP and MaxP }
MinP := MinPoints(n ,Trump,false);
MaxP := MinPoints(n + 1,Trump,true);
MaxP := Max(MaxP,MinP + 3);
if n = Level then
MaxP := MaxP-1
else
begin
MinP := MaxP;
MaxP := Info[Player].MaxP;
end;
{ Bid in major when possible }
if (l[Heart] + Info[Partner].Minl[Heart] >= 8) or
(l[Spade] + Info[Partner].Minl[Spade] >= 8) then
begin
if Trump = NT then
BidVal := -100
else
if l[Trump] + Info[Partner].Minl[Trump] < 8 then
BidVal := -100;
end
else
{ do not Bid if Partner Bids 3 NT }
if (Contract.Level = 3) and (Contract.Trump = NT) then
BidVal := -100;
if Level >= 5 then { do not Bid if Partner has used Blackwood }
begin
i := BidNo-2;
while i >= 0 do
begin
if BidTyp[i] = Blackwood then
BidVal := -300;
i := i-4;
end;
end;
end;
end; { NormalBid }
procedure NormalDBL;
{ Double if the Contract will go at least 2 down }
var
Tricks: integer;
begin
with Sdata[Player],Contract do
begin
Tricks := (p-DistPoints(Player) + Max(Info[Partner].MinP-2,0)) div 4-1;
if Trump <> NT then
if l[Trump] > 3 then
Tricks := Tricks + l[Trump]-3;
BidVal := 10;
if Tricks < 2 + 7-Level then
BidVal := -140;
end;
end; { NormalDBL }
var
s : SuitType;
Val : integer;
Len : integer;
begin { BidSystem }
Player := (Dealer + BidNo) and 3;
Partner := (Player + 2) and 3;
InfoPlayer := Info[Player];
Test := true;
BidVal := 0;
with Sdata[Player],InfoPlayer,Bid do
begin
case BidClass(Bid) of
{ Opening Bids }
OpenPass: begin { Opening Pass, 0-12 p }
MaxP := 12;
end;
open1S : begin { Opening 1 S, 13-23 p, 4 trumps }
MinP := 13;
MaxP := 23;
Minl[Trump] := 4;
end;
open2S : begin { Opening 2 S, 24- ? p, 4 trumps }
MinP := 24;
Minl[Trump] := 4;
end;
OpenNT : begin { Opening NT }
if Level = 1 then
MinP := 16 { 1 NT 16-18 p }
else
MinP := 16 + Level*3; { 2 NT 22-24 p }
MaxP := MinP + 2;
for s := Club to Spade do { No singletons }
Minl[s] := 2;
if DistPoints(Player) > 1 then
BidVal := -100;
end;
{ Response to 1 in Suit }
Resppass : begin { 1 He, Pass 0- 5 p }
if EqBid(Bids[BidNo-1],Pass) then
MaxP := 5
else
MaxP := 8;
end;
resp2S : begin { 1 He, 2 He 6- 9 p, 4 trumps }
MinP := 6;
MaxP := 9;
Minl[Trump] := 4;
end;
resp3S : begin { 1 He, 3 He 13-16 p, 4 trumps }
MinP := 13;
MaxP := 16;
Minl[Trump] := 4;
end;
resp1o1 : begin { 1 He, 1 Sp 6- ? p }
MinP := 6;
Minl[Trump] := 4;
end;
resp2o1 : begin { 1 He, 2 Cl 10- ? p }
MinP := 10;
Minl[Trump] := 4;
end;
resp1NT : begin { 1 He, 1 NT 6- 9 p, any distribution }
MinP := 6;
MaxP := 9;
BidVal := -20;
end;
resp2NT : begin { 1 He, 2 NT 13-16 p, NT distribution }
MinP := 13;
MaxP := 16;
for s := Club to Spade do
Minl[s] := 2;
if DistPoints(Player) > 1 then
BidVal := -100;
end;
{ Response to 2 in Suit }
resp2S2NT : begin { 2 He, 2 NT 0- 8 p }
MaxP := 8;
BidVal := -20;
end;
resp2Snorm: begin { 2 He, anything else, an Ace and a King }
MinP := 7;
if (Number(Player,Ace)*2 +
Number(Player,King) < 3) or (Jumps(Bid) >= 1) then
BidVal := -200;
if Trump <> NT then
Minl[Trump] := 4;
end;
{ Conventions }
Stayman : begin { Stayman 7- ? p }
if Level = 2 then
MinP := 7;
if (l[Heart] <> 4) and (l[Spade] <> 4) then
BidVal := -200
else
BidVal := 20;
end;
RespStayman : begin { Response, He or Sp 4 trumps, otherwise Di }
if ((Trump = NT) or
(Level <> Bids[BidNo-2].Level)) and
EqBid(Bids[BidNo-1],Pass) then
BidVal := -100
else
if (Trump <> NT) and (Trump >= Heart) then
begin
Minl[Trump] := 4;
BidVal := 10;
end;
end;
Blackwood : begin { Blackwood, not used }
MinP := MinTab[false,Level + 2]-Info[Partner].MinP-1;
BidVal := -200;
end;
RespBlackwood : begin { Response, show Number of aces or kings }
Test := false; BidVal := -200;
if (Level = Bids[BidNo-2].Level + 1) then
if Number(Player,Ace-(Level-5)) = Ord(Trump) then
BidVal := 10;
if Level = 0 then
BidVal := -40;
end;
{ Other special Bids }
resp1NT2S : begin { 1 NT, 2 He, 0- 6 p, odd distribution }
MaxP := 6;
Minl[Trump] := 6;
end;
SecondBidNT : begin { 1 He, 2 Cl, 2 NT 13-15 p, 3 NT 19-21 p }
if Level = Contract.Level then
MaxP := 15
else
begin
MinP := 19;
MaxP := 21;
end;
for s := Club to Spade do
Minl[s] := 2;
if DistPoints(Player) > 1 then
BidVal := -100;
end;
Shutout : begin { Shut out Bid, 7 trumps, weak Hand }
MaxP := 12;
Minl[Trump] := 7;
if l[Trump]-1 + Number(Player,Ace) >= 6 + Level-2 then
BidVal := Level
else
BidVal := -300;
end;
OverCall : begin { Opponent OverCall, 8- ? p, 5 trumps }
MinP := 8;
Minl[Trump] := 5;
if l[Trump] + p div 4 < Level + 6 then
BidVal := -120;
end;
NormPass : NormalPass;
NormBid : NormalBid;
NormDBL : NormalDBL;
NormRDBL,
Illegal : begin { Never redouble }
BidVal := -600;
Test := false;
end;
end { case };
{ Add the new information to the old }
MinP := Max(MinP,Info[Player].MinP);
MaxP := Min(MaxP,Info[Player].MaxP);
MaxP := Max(MaxP,MinP);
for s := Club to Spade do
Minl[s] := Max(Minl[s],Info[Player].Minl[s]);
case Task of
CalcInfo: Info[Player] := InfoPlayer; { Update Info[Player] }
Evaluate: if Test then
begin
{ Adjust BidVal according to the Test }
Val := 0;
{ Test the Hand against Info }
for s := Club to Spade do
if l[s] < Minl[s] then
Val := Val + (Minl[s]-l[s])*40;
if p > MaxP then
Val := Val + (p-MaxP)*12;
if p < MinP then
Val := Val + (MinP-p)*16;
if Val > 0 then
BidVal := BidVal-100-Val;
{ Try to give Partner as much information
as possible }
if Level > 0 then
begin
if Trump = NT
then BidVal := BidVal + 11
else
begin
BidVal := BidVal + (l[Trump]-
Info[Player].Minl[Trump])*2;
if (Trump >= Heart) and (l[Trump] >= 5) then
BidVal := BidVal + 1;
for s := Succ(Trump) to Spade do
if l[s] >= 5 then BidVal := BidVal-1;
Len := 8-Info[Partner].Minl[Trump];
if (Info[Player].Minl[Trump] < Len)
and (Minl[Trump] >= Len) then
BidVal := BidVal + 5;
end;
if (Level <= 3) and
not ((Level = 3) and (Trump = NT)) then
BidVal := BidVal + 8;
end; { if }
if Level > 5-Ord(Trump) div 2 then
BidVal := BidVal + 10;
end; { if }
end { case };
end; { with }
BidSystem := BidVal;
end; { BidSystem }
procedure FindBid(var BestBid: BidType; var Restart : boolean );
{ Find BEST Bid for Player, either by calculating it or
by reading it from keyboard }
var
Player : HandType;
BestVal,Val : integer;
Bid : BidType;
Bidding : boolean;
label 10;
function ErrorFound : boolean;
begin
ErrorFound := false;
if not Computer[Player] then
if EqBid(BestBid,Pass) and (Pos(Command,'PASS') <> 1) then
ErrorFound := true;
end; { ErrorFound }
begin
repeat
Player := (Dealer + BidNo) and 3; { Try and Evaluate each Bid }
BestBid := Pass; BestVal := 1; Val := 0;
if Computer[Player] then
BestVal := BidSystem(Pass,Evaluate)
else
begin
Bidding := true;
Answer(Player,Command, Bidding, Restart);
if Restart then
Exit;
end;
if not EqBid(Contract,Pass) then
if odd(Player + Dummy) then
begin
if Doubled = 0 then
begin
if Computer[Player] then
begin
Val := BidSystem(Dbl,Evaluate);
if Val > BestVal then
begin
BestBid := Dbl;
BestVal := Val;
end;
end
else
if Pos(Command,'DBL') = 1 then
BestBid := Dbl;
end;
end
else
if Doubled = 1 then
begin
if Computer[Player] then
begin
Val := BidSystem(RDbl,Evaluate);
if Val > BestVal then
begin
BestBid := RDbl;
BestVal := Val;
end;
end
else
if Pos(Command,'RDBL') = 1 then
BestBid := RDbl;
end;
with Bid do
begin
Level := 7;
Trump := NT;
while not EqBid(Bid,Contract) do
begin
if Computer[Player] then
begin
Val := BidSystem(Bid,Evaluate);
if Val >= BestVal then
begin
BestBid := Bid;
BestVal := Val;
end;
end
else
if (Command = chr(Ord('0') + Level) + TrumpName[Trump][1]) then
BestBid := Bid;
if Trump <> Club then
Trump := Pred(Trump)
else
begin
Level := Level-1;
Trump := NT;
end;
end; { while }
end; { with }
{ Read Bid again if last input is Illegal }
if ErrorFound then
Error(' INVALID Bid ');
until Computer[Player] or
not (EqBid(BestBid, Pass) and (Command <> 'PASS'));
end; { FindBid }
procedure MakeBid(Bid: BidType);
{ Make the Bid and Update variables }
var
i : integer;
Val : integer;
begin
Val := BidSystem(Bid,CalcInfo); { Update Info }
Bids[BidNo] := Bid;
BidTyp[BidNo] := BidClass(Bid);
if Bid.Level > 0 then
begin
Contract := Bid;
Doubled := 0;
i := BidNo;
repeat { Find declarer and Dummy }
with Bids[i] do
if (Level > 0) and (Trump = Contract.Trump) then
Dummy := (Dealer + i + 2) and 3;
i := i-2;
until i < 0;
end
else
if not EqBid(Bid,Pass) then
Doubled := Succ(Doubled);
PrintBid((Dealer + BidNo) and 3,Bid);
BidNo := BidNo + 1;
end; { MakeBid }
function Threepass: BOOLEAN;
{ Test if last three Bids were Pass }
var
i : integer;
begin
if BidNo < 4 then
Threepass := false
else
begin
Threepass := true;
for i := BidNo-3 to BidNo-1 do
if not EqBid(Bids[i],Pass) then
Threepass := false;
end;
end; { Threepass }
function DoneBidding(var BestBid : BidType): boolean;
var
Restart : boolean;
begin
Restart := false;
repeat
FindBid(BestBid,Restart);
DoneBidding := not Restart;
if Restart then
Exit;
MakeBid(BestBid);
until Threepass;
end; { DoneBidding }
{ end BID.BR }