_TITLE "Deal or No Deal Top 20" 'b+ mod 2020-01-15 add Top 20 Scores tracker
CONST xmax
= 800, ymax
= 600, nCases
= 26 'load data in init
'track during game
restart: ' the endings are inside this main do loop
FOR round
= 0 TO 10 'the game goes for 10 rounds unless player sells case to banker IF round
= 0 THEN 'get things started and get the Player's case CP "Host: Congratulations! You have been randomly selected to play the slot"
CP "machine for more than just one Million Dollar Case in the prize pool."
CP "Press any key when the moment seems lucky..."
PRINT: CP
"Aha! " + TS$
(n%
) + " Million Dollar cases!" n% = 1
init n%
showB
PRINT: CP
"Host: Please click your case from the 26 available..." mx = 0: my = 0
WHILE mx
> 33 * 8 OR mx
< 29 * 8 OR my
< 16 * 2 OR my
> 28 * 16 PlayerCase = my \ 16 - 1
caseSelected(PlayerCase) = 1
ELSEIF round
= 10 THEN 'offer to swap your case with the case remaining showB
FOR lastCase%
= 1 TO nCases
'find last case number PRINT: CP
"Host: Down to 2 cases, you have the option to switch cases at this time." CP "Press s for switch, n for no switch..."
switch$ = getChar$("sn")
SWAP PlayerCase
, lastCase%
SWAP caseSelected
(lastCase%
), caseSelected
(PlayerCase
) showB
CP "Host: The last case holds " + money$(caseHolds(lastCase%))
CP
"and your case has " + money$
(caseHolds
(PlayerCase
)):
_DELAY 5 goAgain$
= topTenGoAgain$
(INT(caseHolds
(PlayerCase
))) nSelect% = 7 - round
IF nSelect%
< 1 THEN nSelect%
= 1 FOR r
= 1 TO nSelect%
'select these many cases open and update money board showB
PRINT: CP
"Host: Now click a case, " + TS$
(r
) + " of " + TS$
(nSelect%
) + " cases for this round."
tryAgain:
mx = 0: my = 0
WHILE mx
> 33 * 8 OR mx
< 29 * 8 OR my
< 16 * 2 OR my
> 28 * 16 caseN = my \ 16 - 1
IF caseSelected
(caseN
) = 0 THEN caseSelected
(caseN
) = 1 ELSE GOTO tryAgain
PRINT: CP
"Case " + TS$
(caseN
) + " contained: " + money$
(caseHolds
(caseN
)) FOR c
= 1 TO nCases
'update MoneyBoard IF moneyBoard
(c
) = caseHolds
(caseN
) AND moneySlot
(c
) = 0 THEN moneySlot
(c
) = 1:
EXIT FOR showB 'now banker makes an offer
PRINT: CP
"'Ring' Host: Hello (silence) ..." bankerOffer#
= INT(100 * expectedValue
* offer
(round
)) / 100 PRINT: CP
"Host: The Banker has offered " + money$
(bankerOffer#
) + ", Deal or No Deal?" offers(round) = money$(bankerOffer#)
CP "Press d for deal, n for no deal "
deal$ = getChar$("dn")
CP "Your case had " + money$(caseHolds(PlayerCase))
goAgain$
= topTenGoAgain$
(INT(bankerOffer#
))
CP "Blue Number is the Expected Value = the Average of the Sum of Prizes in Play."
'IF PlayerCase THEN LOCATE 1, 60: PRINT "Debug: "; money$(caseHolds(PlayerCase)) ELSE PRINT
PRINT " Money Prizes Left: Cases Left:";
IF PlayerCase
THEN PRINT " Your Case is #"; TS$
(PlayerCase
);
''check expectedValue
SUB init
(nMillionDollarCases%
) offerDat$ = ".15,.24,.34,.43,.52,.62,.72,.82,.90,.95"
Split offerDat$, ",", offer()
'load moneyBoard
mbDat$ = ".01,1,5,10,25,50,75,100,200,300,400,500,750,1000,5000,10000,25000,50000,75000,100000,200000,300000,400000,500000,750000,1000000"
Split mbDat$, ",", moneyBoard()
'load moneyBoard with extra million dollar cases and load and shuffle cases
startM% = nCases - nMillionDollarCases%
'clear other arrays
IF i
<= 10 THEN offers
(i
) = "" caseSelected(i) = 0
moneySlot(i) = 0
caseHolds(i) = moneyBoard(i)
moneyBoard(i) = 1000000.00#: caseHolds(i) = 1000000.00#
'shuffle case contents
n = n + 1
tot## = tot## + moneyBoard(i)
expectedValue#
= _ROUND(100 * tot##
/ n
) / 100
' From my Tool Box https://www.qb64.org/forum/index.php?topic=1511.m
' This FUNCTION creates a file in the same folder as your .bas source or .exe
'EDIT: 2019-07-29 change to FUNCTION to combine Top Ten update functions with Go Again reply.
' modified for this for Deal or No Deal and uses CP sub
FUNCTION topTenGoAgain$
(compareScore
AS LONG) '<<<< modified compareScore from Integer to Long fName$ = "Top 20 Scores.txt" '<<< since this is toolbox code change this as needed for app
CLS:
PRINT: CP
"Your score was: " + TS$
(compareScore
):
PRINT: CP
"Top 20 Scorers and Scores:" n = n + 1
IF compareScore
>= score
AND settleScore
= 0 THEN CP "You have made the Top 20!"
CP "Type your name: "
names$(n) = n$ + dt$
scores(n) = compareScore
settleScore = -1
n = n + 1
IF n
<= 20 THEN names$
(n
) = NAME$: scores
(n
) = score
scores
(n
) = score: names$
(n
) = NAME$
CP "There is a slot open for your name and score."
CP "Type your name:"
IF n$
<> "" THEN n
= n
+ 1: names$
(n
) = n$
+ dt$: scores
(n
) = compareScore
CP "You are first into file of top scores!"
CP "Type your name"
PRINT: CP
"Press <Enter> to play again, <q (or any) + Enter> to quit... " INPUT " "; topTenGoAgain$
'modified type from String to Double for this app
curpos
= 1: arrpos
= LBOUND(loadMeArray
): LD
= LEN(delim
) dpos
= INSTR(curpos
, SplitMeString
, delim
) loadMeArray
(arrpos
) = VAL(MID$(SplitMeString
, curpos
, dpos
- curpos
)) arrpos = arrpos + 1
curpos = dpos + LD
dpos
= INSTR(curpos
, SplitMeString
, delim
) loadMeArray
(arrpos
) = VAL(MID$(SplitMeString
, curpos
))
FUNCTION TS$
(n
) 'single for small single or integer
SUB CP
(s$
) 'for xmax pixel wide graphics screen
'this might make a nice Money format yeah! added to toolbox
FUNCTION money$
(n#
) 'only works right for double# type place
= INSTR(money$
, ".") money$
= MID$(money$
, 1, place
- 4) + "," + MID$(money$
, place
- 3) place
= INSTR(money$
, ",")
'fix this for 2 places after decimal
place
= INSTR(money$
, ".") front$
= MID$(money$
, 1, place
) back$
= MID$(money$
, place
+ 1) money$ = money$ + ".00"
money$ = "$" + s$ + money$
getChar$ = k$