.DISABLE QUIET .GOSUB HELLO ;Just kidding. So, you're going to play some bridge. I'm Goren and ;I'll keep score for you. You can trust me, I only make mistakes in ;Tammo's favor. ;Now, tell me who's playing North, South, East & West. .ASKS PLAYERS Enter players in N S E W seq., one space between names .PARSE PLAYERS " " CONTN CONTS CONTE CONTW .RESET: .SETN HANDS 0. .SETN NSGT 0. .SETN EWGT 0. .SETN H 0. .SETN OVER 0. .SETN BONUS1 0. .SETN BONUS2 0. .SETS UNDRLN "----------------------" .ENABLE SUBSTITUTION .RCLEAR: .SETN GCNTR 1. .SETN NSGC 0. .SETN EWGC 0. .SETN NSVF 1. .SETN EWVF 1. .SETN NSTOT 0. .SETN EWTOT 0. .SETN NSOVR 0. .SETN EWOVR 0. .SETN NSU1 0. .SETN NSU2 0. .SETN NSU3 0. .SETN EWU1 0. .SETN EWU2 0. .SETN EWU3 0. .SETS GMFL1 "" .CLEAR: .SETS BID "" .SETN SLAMFL 0. .SETN GRSLFL 0. .SETN DWT 1. .SETS SFL "" .AB: .ASKS BID Enter Bidder, Bid and Doubble/Redouble as E 4 H R: .PARSE BID " " PLR TBID SUIT DBL .SETS PLAYER CONT'PLR' .IF PLR = "R" .GOTO RESET .IF PLR = "N" .OR .IF PLR = "S" .SETS BDR "NS" .IF PLR = "E" .OR .IF PLR = "W" .SETS BDR "EW" .IF BDR = "NS" .SETS DEF "EW" .IF BDR = "EW" .SETS DEF "NS" .ASK CONF 'PLAYER' has bid 'TBID''SUIT''DBL'. Do you want to change it? .IFT CONF .GOTO CLEAR .IF SUIT = "C" .OR .IF SUIT = "D" .SETN SWT 20. .IF SUIT = "H" .OR .IF SUIT = "S" .OR .IF SUIT = "N" .SETN SWT 30. .IF SUIT = "N" .SETS SFL "NT" .IF TBID = "6" .SETN SLAMFL 500. .IF TBID = "7" .SETN SLAMFL 1000. .IF DBL = "D" .SETN DWT 2. .IF DBL = "R" .SETN DWT 4. .AT: .ASKS RESULT Enter the number of tricks & honors made as 3 100 .IF RESULT = "" .GOTO AT .PARSE RESULT " " TMADE SH .IF TMADE = "R" .GOTO RESET ;'PLAYER' has made 'TMADE' tricks & 'SH' honors. .ASK CONF Do you want to change it? .IFT CONF .GOTO AT .INC HANDS .HONTST: .IF SH = "0" .OR .IF SH = "100" .OR .IF SH = "150" .GOTO SCORE .ASKS SH I beg your pardon? Please enter 100, 150 or 0 .GOTO HONTST .SCORE: .SETN H 'SH'. .IF TMADE < TBID .GOTO SET .UNDER: .SETN UNDER 'SWT'.*'DWT'.*'TBID'. .IF SFL = "NT" .SETN UNDER 'UNDER'.+('DWT'.*10.) .IF DBL = "D" .OR .IF DBL = "R" .GOTO DBLOVR .IF TMADE > TBID .SETN OVER ('TMADE'.-'TBID'.)*'SWT'. .GOTO BONUS .DBLOVR: .IF TMADE > TBID .SETN OVER ('TMADE'.-'TBID'.)*50.*'DWT'.*'BDR'VF. .BONUS: .IF DBL = "D" .OR .IF DBL = "R" .SETN BONUS1 50. .IF TBID = "6" .SETN BONUS2 500. .IF TBID = "7" .SETN BONUS2 1000. .IF 'BDR'VF = 2. .SETN BONUS2 'BONUS2'.*3./2. .TOTAL: .SETN 'BDR'U'GCNTR' 'UNDER'.+'BDR'U'GCNTR'. .SETN 'BDR'OVR 'H'.+'OVER'.+'BONUS1'.+'BONUS2'.+'BDR'OVR .SETN 'BDR'TOT 'BDR'TOT+'BDR'U'GCNTR'+'BDR'OVR .IF 'BDR'OVR > 200. .SETS GMFL1 "WOW" .SETN H 0. .SETN OVER 0. .SETN BONUS1 0. .SETN BONUS2 0. .VULTST: .IF 'BDR'U'GCNTR' LT 100. .GOTO CONT .SETN 'BDR'VF 2. .INC GCNTR .INC 'BDR'GC .IF 'BDR'GC = 2. .GOTO RUBBER .SETN NSU'GCNTR' 0. .SETN EWU'GCNTR' 0. .GOSUB GAMSG .GOTO CONT .SET: .SETN OVL 'DEF'OVR .IF 'BDR'VF = 2. .GOTO VULN .SETN 'DEF'OVR (('DWT'*50.)+(('TBID'-'TMADE'-1.)*'DWT'*100.))+'OVL'. .SETN 'DEF'TOT 'DEF'TOT+'DEF'OVR-'OVL'. .GOSUB TOBAD .GOTO CONT .VULN: .SETN 'DEF'OVR (('DWT'*100.)+(('TBID'-'TMADE'-1.)*'DWT'*150.))+'OVL'. .SETN 'DEF'TOT 'DEF'TOT+'DEF'OVR-'OVL'. .GOSUB TOOBAD .CONT: .GOSUB SCOPAD .GOTO CLEAR .RUBBER: .SETN RUBBON (4.-'GCNTR')*200.+300. .SETN 'BDR'OVR 'BDR'OVR+'RUBBON'. .SETN NSTOT NSOVR+NSU1+NSU2+NSU3 .SETN EWTOT EWOVR+EWU1+EWU2+EWU3 .SETN NSGT NSGT+NSTOT .SETN EWGT EWGT+EWTOT .GOSUB RUBMSG .GOSUB SCOPAD .ASK GAME Do you want to continue? .IFT GAME .GOTO RCLEAR .GOSUB GOODBY .ENABLE QUIET PIP TI:=SCORE.PAD .DISABLE QUIET .EXIT .SCOPAD: .ENABLE QUIET PIP SCORE.PAD;1/DE .DISABLE QUIET .OPENA #1 SCORE.PAD .SETS SNSOVR "'NSOVR'" .SETS SNSU1 "'NSU1'" .SETS SNSU2 "'NSU2'" .SETS SNSU3 "'NSU3'" .SETS SNSTOT "'NSTOT'" .SETS SNSGT "'NSGT'" .SETS SEWOVR "'EWOVR'" .SETS SEWU1 "'EWU1'" .SETS SEWU2 "'EWU2'" .SETS SEWU3 "'EWU3'" .SETS SEWTOT "'EWTOT'" .SETS SEWGT "'EWGT'" .IF SNSOVR = "0" .SETS SNSOVR " " .TEST SNSOVR .GOSUB BLANKS .SETS LNSOVR "'BLK''SNSOVR'" .IF SNSU1 = "0" .SETS SNSU1 " " .TEST SNSU1 .GOSUB BLANKS .SETS LNSU1 "'BLK''SNSU1'" .IF SNSU2 = "0" .SETS SNSU2 " " .TEST SNSU2 .GOSUB BLANKS .SETS LNSU2 "'BLK''SNSU2'" .IF SNSU3 = "0" .SETS SNSU3 " " .TEST SNSU3 .GOSUB BLANKS .SETS LNSU3 "'BLK''SNSU3'" .IF SNSTOT = "0" .SETS SNSTOT " " .TEST SNSTOT .GOSUB BLANKS .SETS LNSTOT "'BLK''SNSTOT'" .IF SNSGT = "0" .SETS SNSGT " " .TEST SNSGT .GOSUB BLANKS .SETS LNSGT "'BLK''SNSGT'" .IF SEWOVR = "0" .SETS SEWOVR " " .TEST SEWOVR .GOSUB BLANKS .SETS LEWOVR "'BLK''SEWOVR'" .IF SEWU1 = "0" .SETS SEWU1 " " .TEST SEWU1 .GOSUB BLANKS .SETS LEWU1 "'BLK''SEWU1'" .IF SEWU2 = "0" .SETS SEWU2 " " .TEST SEWU2 .GOSUB BLANKS .SETS LEWU2 "'BLK''SEWU2'" .IF SEWU3 = "0" .SETS SEWU3 " " .TEST SEWU3 .GOSUB BLANKS .SETS LEWU3 "'BLK''SEWU3'" .IF SEWTOT = "0" .SETS SEWTOT " " .TEST SEWTOT .GOSUB BLANKS .SETS LEWTOT "'BLK''SEWTOT'" .IF SEWGT = "0" .SETS SEWGT " " .TEST SEWGT .GOSUB BLANKS .SETS LEWGT "'BLK''SEWGT'" .DATA #1 #3 NS ! EW .DATA #1 #4 NV ! EW .DATA #1 #3 'LNSOVR'!'LEWOVR' .DATA #1 #4 'LNSOVR'!'LEWOVR' .DATA #1 ********************** .DATA #1 #3 'LNSU1'!'LEWU1' .DATA #1 #4 'LNSU1'!'LEWU1' .DATA #1 'UNDRLN' .DATA #1 #3 'LNSU2'!'LEWU2' .DATA #1 #4 'LNSU2'!'LEWU2' .DATA #1 'UNDRLN' .DATA #1 #3 'LNSU3'!'LEWU3' .DATA #1 #4 'LNSU3'!'LEWU3' .DATA #1 ********************** .DATA #1 #3 'LNSTOT'!'LEWTOT' .DATA #1 #4 'LNSTOT'!'LEWTOT' .DATA #1 #3 =====!===== .DATA #1 #4 =====!===== .DATA #1 #3 'LNSGT'!'LEWGT' .DATA #1 #4 'LNSGT'!'LEWGT' .CLOSE #1 .ENABLE QUIET PIP TI:=SCORE.PAD .DISABLE QUIET ;At this point 'HANDS' hands have been played. .RETURN .BLANKS: .SETS BLK "" .IF = 3 .SETS BLK " " .IF = 2 .SETS BLK " " .IF = 1 .SETS BLK " " .RETURN .HELLO: .PARSE