REM Bridge.bas -- OpenOffice.org Basic module for scoring duplicate bridge. REM REM This module contains two functions: DuplicateScore() and IsVulnerable(). REM REM They may be used together in a spreadsheet formula like this: REM REM DUPLICATESCORE(<Contract>;<Made>;<Down>;ISVULNERABLE(<Board>;<Declarer>)) REM Option Explicit REM A test procedure may be placed here. REM DuplicateScore -- return the score for declarer's side, given a contract and result REM REM usage: REM DuplicateScore(<Contract>,<Made>,<Down>,<Vuln>) REM REM in Calc: REM DUPLICATESCORE(<Contract>;<Made>;<Down>;<Vuln>) REM REM arguments: REM <Contract> is a string giving the level, strain, and whether doubled or redoubled. REM Values range from "1C", "1D", "1H", "1S", "1NT" through "7C", "7D", "7H", "7S", "7NT" REM and may be suffixed "1Cx" .. "7NTx" for doubled, or "1Cxx" .. "7NTxx" for redoubled. REM REM <Made> is an integer in the range 0..7, representing the number of tricks over REM book (i.e., over 6) that the declarer's side took, if the contract was made. REM If the declarer's side did not make their contract, <Made> should be 0. REM REM <Down> is an integer in the range 0..13, representing the number of tricks by which REM the declarer's side fell short of making their contract. If the contract was made, REM <Down> should be 0. REM REM <Vuln> is a boolean value, representing whether the declarer's side was vulnerable REM on the hand. REM REM return: REM Returns a non-zero integer in the range -7600 .. 2980; returns 0 if any of the REM arguments are out of range, or the combination of arguments is invalid. REM Function DuplicateScore(Contract As String, Made As Integer, Down As Integer, Vuln As Boolean) As Integer Dim Level As Integer Dim Strain As String Dim Doubled As Boolean Dim Redoubled As Boolean Dim IsMinor As Boolean Dim IsMajor As Boolean Dim IsNotrump As Boolean Dim ContractPoints As Integer Dim OvertrickPoints As Integer Dim GamePoints As Integer Dim SlamPoints As Integer Dim PenaltyPoints As Integer Contract = Trim(Contract) ' remove leading and trailing spaces, if any Level = CInt(Left(Contract, 1)) If (Level < 1 OR Level > 7) Then ' Invalid contract string, return 0 Made = 0 Down = 0 End If Strain = Mid(Contract, 2, 1) ' "S", "H", "D", "C" or "N" If (InStr(Contract, "x") = Len(Contract) - 1) Then Redoubled = True ElseIf (InStr(Contract, "x") = Len(Contract)) Then Doubled = True End If If (Strain = "S" OR Strain = "H") Then IsMajor = True ElseIf (Strain = "D" OR Strain = "C") Then IsMinor = True ElseIf (Strain = "N") Then IsNotrump = True Else ' Invalid contract string, return 0 Made = 0 Down = 0 End If If (Made < 0 OR Made > 7) Then ' Invalid hand result, return 0 Made = 0 Down = 0 End If If (Down < 0 OR Down > Level + 6) Then ' Invalid hand result, return 0 Made = 0 Down = 0 End If If (Made > 0 AND Down > 0) Then ' Invalid hand result, return 0 Made = 0 Down = 0 End If If (Made > 0) Then REM CONTRACT POINTS If (IsNotrump) Then If (Redoubled) Then ContractPoints = 160 + 120 * (Level - 1) ElseIf (Doubled) Then ContractPoints = 80 + 60 * (Level - 1) Else ContractPoints = 40 + 30 * (Level - 1) End If ElseIf (IsMajor) Then If (Redoubled) Then ContractPoints = 120 * Level ElseIf (Doubled) Then ContractPoints = 60 * Level Else ContractPoints = 30 * Level End If ElseIf (IsMinor) Then If (Redoubled) Then ContractPoints = 80 * Level ElseIf (Doubled) Then ContractPoints = 40 * Level Else ContractPoints = 20 * Level End If End If If (Made > Level) Then REM OVERTRICK POINTS If (Redoubled) Then If (Vuln) Then OvertrickPoints = 400 * (Made - Level) Else OvertrickPoints = 200 * (Made - Level) End If ElseIf (Doubled) Then If (Vuln) Then OvertrickPoints = 200 * (Made - Level) Else OvertrickPoints = 100 * (Made - Level) End If ElseIf (IsMinor) Then OvertrickPoints = 20 * (Made - Level) Else OvertrickPoints = 30 * (Made - Level) End If End If If (Made >= Level) Then REM GAME BONUS If (ContractPoints >= 100) Then If (Vuln) Then GamePoints = 500 Else GamePoints = 300 End If Else GamePoints = 50 End If REM DOUBLED OR REDOUBLED BONUS If (Doubled) Then GamePoints = GamePoints + 50 ElseIf (Redoubled) Then GamePoints = GamePoints + 100 End If REM SLAM BONUS If (Level > 6) Then If (Vuln) Then SlamPoints = 1500 Else SlamPoints = 1000 End If ElseIf (Level > 5) Then If (Vuln) Then SlamPoints = 750 Else SlamPoints = 500 End If End If End If End If REM PENALTY POINTS If (Down > 0) Then If (Vuln) Then If (Redoubled) Then If (Down > 3) Then PenaltyPoints = -1600 - (Down - 3) * 600 ElseIf (Down > 1) Then PenaltyPoints = -400 - (Down - 1) * 600 Else PenaltyPoints = -400 End If ElseIf (Doubled) Then If (Down > 3) Then PenaltyPoints = -800 - (Down - 3) * 300 ElseIf (Down > 1) Then PenaltyPoints = -200 - (Down - 1) * 300 Else PenaltyPoints = -200 End If Else PenaltyPoints = Down * -100 End If Else If (Redoubled) Then If (Down > 3) Then PenaltyPoints = -1000 - (Down - 3) * 600 ElseIf (Down > 1) Then PenaltyPoints = -200 - (Down - 1) * 400 Else PenaltyPoints = -200 End If ElseIf (Doubled) Then If (Down > 3) Then PenaltyPoints = -500 - (Down - 3) * 300 ElseIf (Down > 1) Then PenaltyPoints = -100 - (Down - 1) * 200 Else PenaltyPoints = -100 End If Else PenaltyPoints = Down * -50 End If End If End If DuplicateScore = ContractPoints + OvertrickPoints + GamePoints + SlamPoints + PenaltyPoints End Function REM IsVulnerable -- return a value indicating whether declarer's side is vulnerable REM REM usage: REM IsVulnerable(<Board>,<Declarer>) REM REM arguments: REM <Board> is a positive integer in the range 1..32767. REM REM <Declarer> is a string starting with "N", "S", "E" or "W". REM REM return: REM Returns 1 if declarer's side is vulnerable on the given board, 0 otherwise. REM (The OO BASIC Boolean type is returned to Calc as a string; an Integer is REM easier to handle in spreadsheet formulas, and will be converted correctly to REM a Boolean when passed as the fourth argument to the DUPLICATESCORE() function). REM Function IsVulnerable(Board As Integer, Declarer As String) As Integer Dim Row As Integer Dim Col As Integer Dim Vuln(15, 3) As Integer Vuln( 0, 0) = 1 : Vuln( 0, 1) = 0 : Vuln( 0, 2) = 1 : Vuln( 0, 3) = 0 Vuln( 1, 0) = 0 : Vuln( 1, 1) = 0 : Vuln( 1, 2) = 0 : Vuln( 1, 3) = 0 Vuln( 2, 0) = 0 : Vuln( 2, 1) = 1 : Vuln( 2, 2) = 0 : Vuln( 2, 3) = 1 Vuln( 3, 0) = 1 : Vuln( 3, 1) = 0 : Vuln( 3, 2) = 1 : Vuln( 3, 3) = 0 Vuln( 4, 0) = 1 : Vuln( 4, 1) = 1 : Vuln( 4, 2) = 1 : Vuln( 4, 3) = 1 Vuln( 5, 0) = 0 : Vuln( 5, 1) = 1 : Vuln( 5, 2) = 0 : Vuln( 5, 3) = 1 Vuln( 6, 0) = 1 : Vuln( 6, 1) = 0 : Vuln( 6, 2) = 1 : Vuln( 6, 3) = 0 Vuln( 7, 0) = 1 : Vuln( 7, 1) = 1 : Vuln( 7, 2) = 1 : Vuln( 7, 3) = 1 Vuln( 8, 0) = 0 : Vuln( 8, 1) = 0 : Vuln( 8, 2) = 0 : Vuln( 8, 3) = 0 Vuln( 9, 0) = 1 : Vuln( 9, 1) = 0 : Vuln( 9, 2) = 1 : Vuln( 9, 3) = 0 Vuln(10, 0) = 1 : Vuln(10, 1) = 1 : Vuln(10, 2) = 1 : Vuln(10, 3) = 1 Vuln(11, 0) = 0 : Vuln(11, 1) = 0 : Vuln(11, 2) = 0 : Vuln(11, 3) = 0 Vuln(12, 0) = 0 : Vuln(12, 1) = 1 : Vuln(12, 2) = 0 : Vuln(12, 3) = 1 Vuln(13, 0) = 1 : Vuln(13, 1) = 1 : Vuln(13, 2) = 1 : Vuln(13, 3) = 1 Vuln(14, 0) = 0 : Vuln(14, 1) = 0 : Vuln(14, 2) = 0 : Vuln(14, 3) = 0 Vuln(15, 0) = 0 : Vuln(15, 1) = 1 : Vuln(15, 2) = 0 : Vuln(15, 3) = 1 Row = Board MOD 16 REM "W", "N", "E", "S" -> 0, 1, 2, 3 If (Left(Declarer, 1) = "W") Then Col = 0 ElseIf (Left(Declarer, 1) = "N") Then Col = 1 ElseIf (Left(Declarer, 1) = "E") Then Col = 2 ElseIf (Left(Declarer, 1) = "S") Then Col = 3 End If IsVulnerable = Vuln(Row, Col) End Function