Author Topic: Deal or No Deal (Read 6593 times)

bplus · « **on:** January 14, 2020, 11:50:52 pm »

Here is good introduction from which I had the details needed to build the game:
(not secure) http://datagenetics.com/blog/january12015/index.html

And from watching the show, I added the random chance of having more than one Million Dollar case in the prize pool, if selected (80% chance) you can get up to 12!

This is bare bones text no fancy sounds or images of scantily clad female models ;(

Code: QB64: [Select]

_TITLE "Deal or No Deal" 'b+ started 2020-01-13
 
CONST xmax = 800, ymax = 600, nCases = 26
DIM SHARED offers(1 TO 10) AS STRING
DIM SHARED caseSelected(1 TO nCases) AS INTEGER
DIM SHARED moneySlot(1 TO 26) AS INTEGER
DIM SHARED caseHolds(1 TO nCases) AS DOUBLE
DIM SHARED moneyBoard(1 TO nCases) AS DOUBLE
DIM SHARED PlayerCase AS INTEGER, round AS INTEGER
RANDOMIZE TIMER
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 300, 40
 
'the game goes about 10 rounds
FOR round = 0 TO 10
    IF round = 0 THEN 'get things started and get the Player's case
        IF RND < .8 THEN
            LOCATE 15, 1
            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..."
            WHILE LEN(INKEY$) = 0
                n% = INT(RND * 11) + 2
                LOCATE 20, 1: CP RIGHT$("0" + TS$(n%), 2)
                _LIMIT 5
            WEND
            PRINT: CP "Aha! " + TS$(n%) + " Million Dollar cases!"
            _DELAY 4
        ELSE
            n% = 1
        END IF
        init n%
        showB
        COLOR &HFFFFFFFF
        PRINT: CP "Host: Please click your case from the 26 available..."
        WHILE mx > 33 * 8 OR mx < 29 * 8 OR my < 16 * 2 OR my > 28 * 16
            WHILE _MOUSEINPUT: WEND
            md = _MOUSEBUTTON(1)
            IF md THEN mx = _MOUSEX: my = _MOUSEY
            _LIMIT 60
        WEND
        PlayerCase = my \ 16 - 1
        caseSelected(PlayerCase) = 1
        _DELAY 2
    ELSEIF round = 10 THEN 'offer to swap your case with the case remaining
        showB
        COLOR &HFFFFFFFF
        FOR lastCase% = 1 TO nCases 'find last case number
            IF caseSelected(lastCase%) = 0 THEN EXIT FOR
        NEXT
        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")
        IF switch$ = "s" THEN
            SWAP PlayerCase, lastCase%
            SWAP caseSelected(lastCase%), caseSelected(PlayerCase)
        END IF
        showB
        COLOR &HFFFFFFFF: PRINT
        CP "Host: The last case holds " + money$(caseHolds(lastCase%))
        CP "and your case has " + money$(caseHolds(PlayerCase)): _DELAY 5: CP "Goodbye!": _DELAY 5: SYSTEM
    ELSE
        FOR r = 1 TO nSelect(round) 'select these many cases open and update money board
            showB
            COLOR &HFFFFFFFF
            PRINT: CP "Host: Now click a case, " + TS$(r) + " of " + TS$(nSelect(round)) + " 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
                WHILE _MOUSEINPUT: WEND
                md = _MOUSEBUTTON(1)
                IF md THEN mx = _MOUSEX: my = _MOUSEY
                _LIMIT 60
            WEND
            caseN = my \ 16 - 1
            IF caseN > 0 AND caseN <= nCases THEN
                IF caseSelected(caseN) = 0 THEN caseSelected(caseN) = 1 ELSE GOTO tryAgain
            END IF
            PRINT: CP "Case " + TS$(caseN) + " contained: " + money$(caseHolds(caseN))
 
            _DELAY 2
            FOR c = 1 TO nCases 'update MoneyBoard
                IF moneyBoard(c) = caseHolds(caseN) AND moneySlot(c) = 0 THEN moneySlot(c) = 1: EXIT FOR
            NEXT
        NEXT
        showB 'now banker makes an offer
        COLOR &HFFFFFFFF
        _AUTODISPLAY
        PRINT: CP "'Ring' Host: Hello (silence) ..."
        _DELAY 3
        PRINT: CP "Host: The Banker has offered " + money$(INT(100 * expectedValue * offer(round)) / 100) + ",  Deal or No Deal?"
        offers(round) = money$(INT(100 * expectedValue * offer(round)) / 100)
        CP "Press d for deal, n for no deal "
        deal$ = getChar$("dn")
        IF deal$ = "d" THEN CP "Your case had " + money$(caseHolds(PlayerCase)) + " Goodbye!": _DELAY 10: SYSTEM
    END IF
NEXT
 
SUB showB
    CLS
    COLOR &HFF224488
    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
    COLOR &HFFFFFFFF
    PRINT " Money Prizes Left:  Cases Left:";
    IF PlayerCase THEN PRINT " Your Case is #"; TS$(PlayerCase);
    IF round > 1 THEN PRINT "  Offers for your case:" ELSE PRINT
    FOR i = 1 TO nCases
        IF moneySlot(i) = 0 THEN COLOR &HFFFFFF00 ELSE COLOR &HFF333333
        PRINT RIGHT$(SPACE$(19) + money$(moneyBoard(i)), 19);
        IF caseSelected(i) = 0 THEN COLOR &HFFFF9900 ELSE COLOR &HFF333333
        PRINT USING "#############"; i
    NEXT
    IF round > 1 THEN
        COLOR &HFF00AA00
        FOR i = 1 TO round - 1
            LOCATE 2 + i, 73 - LEN(offers(i)): PRINT offers(i)
        NEXT
    END IF
    ''check expectedValue
    COLOR &HFF0000FF
    LOCATE 2 + nCases + 1, 1: PRINT RIGHT$(SPACE$(19) + money$(expectedValue#), 19)
END SUB
 
SUB init (nMillionDollarCases%)
    'load moneyBoard and cases
    startM% = nCases - nMillionDollarCases%
    FOR i = 1 TO nCases
        IF i <= startM% THEN
            moneyBoard(i) = mB(i): caseHolds(i) = mB(i)
        ELSE
            moneyBoard(i) = 1000000.00#: caseHolds(i) = 1000000.00#
        END IF
    NEXT
    'shuffle case contents
    FOR i = nCases TO 2 STEP -1
        SWAP caseHolds(INT(RND * i) + 1), caseHolds(i)
    NEXT
END SUB
 
FUNCTION mB# (n)
    SELECT CASE n
        CASE 1: mB# = .01
        CASE 2: mB# = 1
        CASE 3: mB# = 5
        CASE 4: mB# = 10
        CASE 5: mB# = 25
        CASE 6: mB# = 50
        CASE 7: mB# = 75
        CASE 8: mB# = 100
        CASE 9: mB# = 200
        CASE 10: mB# = 300
        CASE 11: mB# = 400
        CASE 12: mB# = 500
        CASE 13: mB# = 750
        CASE 14: mB# = 1000
        CASE 15: mB# = 5000
        CASE 16: mB# = 10000
        CASE 17: mB# = 25000
        CASE 18: mB# = 50000
        CASE 19: mB# = 75000
        CASE 20: mB# = 100000
        CASE 21: mB# = 200000
        CASE 22: mB# = 300000
        CASE 23: mB# = 400000
        CASE 24: mB# = 500000
        CASE 25: mB# = 750000
        CASE 26: mB# = 1000000
    END SELECT
END FUNCTION
 
FUNCTION offer (round)
    SELECT CASE round
        CASE 1: offer = .15
        CASE 2: offer = .24
        CASE 3: offer = .34
        CASE 4: offer = .43
        CASE 5: offer = .52
        CASE 6: offer = .62
        CASE 7: offer = .72
        CASE 8: offer = .81
        CASE 9: offer = .9
        CASE 10: offer = .95
    END SELECT
END FUNCTION
 
FUNCTION nSelect (round)
    SELECT CASE round
        CASE 1: nSelect = 6
        CASE 2: nSelect = 5
        CASE 3: nSelect = 4
        CASE 4: nSelect = 3
        CASE 5: nSelect = 2
        CASE 6: nSelect = 1
        CASE 7: nSelect = 1
        CASE 8: nSelect = 1
        CASE 9: nSelect = 1
        CASE 10: nSelect = 1
    END SELECT
END FUNCTION
 
FUNCTION expectedValue#
    FOR i = 1 TO 26
        IF moneySlot(i) = 0 THEN
            n = n + 1
            tot## = tot## + moneyBoard(i)
        END IF
    NEXT
    expectedValue# = _ROUND(100 * tot## / n) / 100
END FUNCTION
 
FUNCTION TS$ (n) 'single for small single or integer
    TS$ = _TRIM$(STR$(n))
END FUNCTION
 
SUB CP (s$) 'for xmax pixel wide graphics screen
    LOCATE CSRLIN, (xmax / 8 - LEN(s$)) / 2: PRINT s$
END SUB
 
'this might make a nice Money format yeah! added to toolbox
FUNCTION money$ (n#) 'only works right for double# type
    DIM place AS INTEGER, s$, front$, back$
    money$ = _TRIM$(STR$(n#))
    IF LEFT$(money$, 1) = "-" THEN s$ = "-": money$ = MID$(money$, 2) ELSE s$ = ""
    place = INSTR(money$, ".")
    IF place = 0 THEN place = LEN(money$) + 1
    WHILE place > 4
        money$ = MID$(money$, 1, place - 4) + "," + MID$(money$, place - 3)
        place = INSTR(money$, ",")
    WEND
 
    'fix this for 2 places after decimal
    place = INSTR(money$, ".")
    IF place THEN
        front$ = MID$(money$, 1, place)
        back$ = MID$(money$, place + 1)
        IF LEN(back$) > 2 THEN money$ = front$ + LEFT$(back$, 2)
        IF LEN(back$) < 2 THEN money$ = front$ + LEFT$(back$ + "00", 2)
    ELSE
        money$ = money$ + ".00"
    END IF
    money$ = "$" + s$ + money$
END FUNCTION
 
FUNCTION getChar$ (fromStr$)
    DIM OK AS INTEGER, k$
    WHILE OK = 0
        k$ = INKEY$
        IF LEN(k$) THEN
            IF INSTR(fromStr$, k$) <> 0 THEN OK = -1
        END IF
        _LIMIT 200
    WEND
    _KEYCLEAR
    getChar$ = k$
END SUB
 
 

EDIT: update wording of a line.

Pete · « **Reply #1 on:** January 15, 2020, 01:12:02 am »

Nice to know you finally figured out how to use: SELECT CASE

Pete :D

SMcNeill · « **Reply #2 on:** January 15, 2020, 01:43:18 am »

Quote

This is bare bones text no fancy sounds or images of scantily clad female models

After this disappointing caveat, I just couldn’t bring myself to try it. /cry!

No “scantily clad female models”? No deal!

Pete · « **Reply #3 on:** January 15, 2020, 02:24:26 am »

Yeah, common Mark...

DIM SHARED G AS STRING

OldMoses · « **Reply #4 on:** January 15, 2020, 06:59:46 am »

Sharing a g string is un-hygenic...

bplus · « **Reply #5 on:** January 15, 2020, 11:37:25 am »

OK dumped SELECT CASE now just select figures :D

Code: QB64: [Select]

_TITLE "Deal or No Deal v Split " 'b+ mod 2020-01-15
 
CONST xmax = 800, ymax = 600, nCases = 26
'load data in init
REDIM SHARED offer(1 TO 1) AS DOUBLE
REDIM SHARED moneyBoard(1 TO 1) AS DOUBLE
DIM SHARED caseHolds(1 TO nCases) AS DOUBLE
'track during game
DIM SHARED moneySlot(1 TO nCases) AS INTEGER
DIM SHARED caseSelected(1 TO nCases) AS INTEGER
DIM SHARED offers(1 TO 10) AS STRING
 
DIM SHARED PlayerCase AS INTEGER, round AS INTEGER
RANDOMIZE TIMER
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 300, 40
 
'the game goes about 10 rounds
FOR round = 0 TO 10
    IF round = 0 THEN 'get things started and get the Player's case
        IF RND < .8 THEN
            LOCATE 15, 1
            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..."
            WHILE LEN(INKEY$) = 0
                n% = INT(RND * 11) + 2
                LOCATE 20, 1: CP RIGHT$("0" + TS$(n%), 2)
                _LIMIT 5
            WEND
            PRINT: CP "Aha! " + TS$(n%) + " Million Dollar cases!"
            _DELAY 4
        ELSE
            n% = 1
        END IF
        init n%
        showB
        COLOR &HFFFFFFFF
        PRINT: CP "Host: Please click your case from the 26 available..."
        WHILE mx > 33 * 8 OR mx < 29 * 8 OR my < 16 * 2 OR my > 28 * 16
            WHILE _MOUSEINPUT: WEND
            md = _MOUSEBUTTON(1)
            IF md THEN mx = _MOUSEX: my = _MOUSEY
            _LIMIT 60
        WEND
        PlayerCase = my \ 16 - 1
        caseSelected(PlayerCase) = 1
        _DELAY 2
    ELSEIF round = 10 THEN 'offer to swap your case with the case remaining
        showB
        COLOR &HFFFFFFFF
        FOR lastCase% = 1 TO nCases 'find last case number
            IF caseSelected(lastCase%) = 0 THEN EXIT FOR
        NEXT
        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")
        IF switch$ = "s" THEN
            SWAP PlayerCase, lastCase%
            SWAP caseSelected(lastCase%), caseSelected(PlayerCase)
        END IF
        showB
        COLOR &HFFFFFFFF: PRINT
        CP "Host: The last case holds " + money$(caseHolds(lastCase%))
        CP "and your case has " + money$(caseHolds(PlayerCase)): _DELAY 5: CP "Goodbye!": _DELAY 5: SYSTEM
    ELSE
        nSelect% = 7 - round
        IF nSelect% < 1 THEN nSelect% = 1
        FOR r = 1 TO nSelect% 'select these many cases open and update money board
            showB
            COLOR &HFFFFFFFF
            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
                WHILE _MOUSEINPUT: WEND
                md = _MOUSEBUTTON(1)
                IF md THEN mx = _MOUSEX: my = _MOUSEY
                _LIMIT 60
            WEND
            caseN = my \ 16 - 1
            IF caseN > 0 AND caseN <= nCases THEN
                IF caseSelected(caseN) = 0 THEN caseSelected(caseN) = 1 ELSE GOTO tryAgain
            END IF
            PRINT: CP "Case " + TS$(caseN) + " contained: " + money$(caseHolds(caseN))
 
            _DELAY 2
            FOR c = 1 TO nCases 'update MoneyBoard
                IF moneyBoard(c) = caseHolds(caseN) AND moneySlot(c) = 0 THEN moneySlot(c) = 1: EXIT FOR
            NEXT
        NEXT
        showB 'now banker makes an offer
        COLOR &HFFFFFFFF
        _AUTODISPLAY
        PRINT: CP "'Ring' Host: Hello (silence) ..."
        _DELAY 3
        PRINT: CP "Host: The Banker has offered " + money$(INT(100 * expectedValue * offer(round)) / 100) + ",  Deal or No Deal?"
        offers(round) = money$(INT(100 * expectedValue * offer(round)) / 100)
        CP "Press d for deal, n for no deal "
        deal$ = getChar$("dn")
        IF deal$ = "d" THEN CP "Your case had " + money$(caseHolds(PlayerCase)) + " Goodbye!": _DELAY 10: SYSTEM
    END IF
NEXT
 
SUB showB
    CLS
    COLOR &HFF224488
    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
    COLOR &HFFFFFFFF
    PRINT " Money Prizes Left:  Cases Left:";
    IF PlayerCase THEN PRINT " Your Case is #"; TS$(PlayerCase);
    IF round > 1 THEN PRINT "  Offers for your case:" ELSE PRINT
    FOR i = 1 TO nCases
        IF moneySlot(i) = 0 THEN COLOR &HFFFFFF00 ELSE COLOR &HFF333333
        PRINT RIGHT$(SPACE$(19) + money$(moneyBoard(i)), 19);
        IF caseSelected(i) = 0 THEN COLOR &HFFFF9900 ELSE COLOR &HFF333333
        PRINT USING "#############"; i
    NEXT
    IF round > 1 THEN
        COLOR &HFF00AA00
        FOR i = 1 TO round - 1
            LOCATE 2 + i, 73 - LEN(offers(i)): PRINT offers(i)
        NEXT
    END IF
    ''check expectedValue
    COLOR &HFF0000FF
    LOCATE 2 + nCases + 1, 1: PRINT RIGHT$(SPACE$(19) + money$(expectedValue#), 19)
END SUB
 
SUB init (nMillionDollarCases%)
    offerDat$ = ".15,.24,.34,.43,.52,.62,.72,.82,.90,.95"
    Split offerDat$, ",", offer()
    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 and cases
    startM% = nCases - nMillionDollarCases%
    FOR i = 1 TO nCases
        IF i <= startM% THEN
            caseHolds(i) = moneyBoard(i)
        ELSE
            moneyBoard(i) = 1000000.00#: caseHolds(i) = 1000000.00#
        END IF
    NEXT
    'shuffle case contents
    FOR i = nCases TO 2 STEP -1
        SWAP caseHolds(INT(RND * i) + 1), caseHolds(i)
    NEXT
END SUB
 
FUNCTION expectedValue#
    FOR i = 1 TO 26
        IF moneySlot(i) = 0 THEN
            n = n + 1
            tot## = tot## + moneyBoard(i)
        END IF
    NEXT
    expectedValue# = _ROUND(100 * tot## / n) / 100
END FUNCTION
 
'modified type from String to Double  for this app
SUB Split (SplitMeString AS STRING, delim AS STRING, loadMeArray() AS DOUBLE)
    DIM curpos AS LONG, arrpos AS LONG, LD AS LONG, dpos AS LONG 'fix use the Lbound the array already has
    curpos = 1: arrpos = LBOUND(loadMeArray): LD = LEN(delim)
    dpos = INSTR(curpos, SplitMeString, delim)
    DO UNTIL dpos = 0
        loadMeArray(arrpos) = VAL(MID$(SplitMeString, curpos, dpos - curpos))
        arrpos = arrpos + 1
        IF arrpos > UBOUND(loadMeArray) THEN REDIM _PRESERVE loadMeArray(LBOUND(loadMeArray) TO UBOUND(loadMeArray) + 1000) AS DOUBLE
        curpos = dpos + LD
        dpos = INSTR(curpos, SplitMeString, delim)
    LOOP
    loadMeArray(arrpos) = VAL(MID$(SplitMeString, curpos))
    REDIM _PRESERVE loadMeArray(LBOUND(loadMeArray) TO arrpos) AS DOUBLE 'get the ubound correct
END SUB
 
FUNCTION TS$ (n) 'single for small single or integer
    TS$ = _TRIM$(STR$(n))
END FUNCTION
 
SUB CP (s$) 'for xmax pixel wide graphics screen
    LOCATE CSRLIN, (xmax / 8 - LEN(s$)) / 2: PRINT s$
END SUB
 
'this might make a nice Money format yeah! added to toolbox
FUNCTION money$ (n#) 'only works right for double# type
    DIM place AS INTEGER, s$, front$, back$
    money$ = _TRIM$(STR$(n#))
    IF LEFT$(money$, 1) = "-" THEN s$ = "-": money$ = MID$(money$, 2) ELSE s$ = ""
    place = INSTR(money$, ".")
    IF place = 0 THEN place = LEN(money$) + 1
    WHILE place > 4
        money$ = MID$(money$, 1, place - 4) + "," + MID$(money$, place - 3)
        place = INSTR(money$, ",")
    WEND
 
    'fix this for 2 places after decimal
    place = INSTR(money$, ".")
    IF place THEN
        front$ = MID$(money$, 1, place)
        back$ = MID$(money$, place + 1)
        IF LEN(back$) > 2 THEN money$ = front$ + LEFT$(back$, 2)
        IF LEN(back$) < 2 THEN money$ = front$ + LEFT$(back$ + "00", 2)
    ELSE
        money$ = money$ + ".00"
    END IF
    money$ = "$" + s$ + money$
END FUNCTION
 
FUNCTION getChar$ (fromStr$)
    DIM OK AS INTEGER, k$
    WHILE OK = 0
        k$ = INKEY$
        IF LEN(k$) THEN
            IF INSTR(fromStr$, k$) <> 0 THEN OK = -1
        END IF
        _LIMIT 200
    WEND
    _KEYCLEAR
    getChar$ = k$
END SUB
 
 

SierraKen · « **Reply #6 on:** January 18, 2020, 02:12:09 pm »

LOL that was fun to play! I suggest adding a better ending though than just a quick "Goodbye!" But it was cool!

bplus · « **Reply #7 on:** January 18, 2020, 02:56:24 pm »

Hi Ken,

Thanks, I am / was in process of adding Top Ten scores from Tool Box routine which also asks if you want to play again. In fact that is already done, but I want to update Top Ten to like Top 100 or something, make screen a little nicer, add date time stamps to name and score since being the only player, date and time more of interest than name.

I confess, Deal No Deal never really appealed to me, 26 beautiful models, so what? ;-))
Well OK there's that, but I can't really duplicate that in a game. But when I started watching it at lunch time because it way more pleasant than news, well I started asking questions about probability and wanted to test some ideas, if there were a better strategy like the Monty Hall 3 doors question that does have a real mathematical strategy. eg if you make all the way to 2 cases left yours and the one still unrevealed, should you swap? I suspect unlike Money Hall question it makes much less difference (but still not sure, it might be worked out with Bayes).

Anyway, Yes, thanks if you play one round and it leaves you wanting more, it is a good sign that you have the game right. Compare bare bones game to TV and fact you have only one shot to get it right in real game, you get an appreciation of art of entertainment eg after all the big cases are gone, is it game over or do you still play to get best deal?

johnno56 · « **Reply #8 on:** January 18, 2020, 03:37:16 pm »

Hang on! There could have been "26 beautiful models"? Wow! That could have made my resounding defeat a little easier to cope with.... lol

I can remember only watching that show maybe twice... Probably why I found it difficult to play your version. The game. in and of itself is not difficult, just my understanding of how it is supposed to be played... The models would have probably distracted me even more.... lol

Nicely done!

J

bplus · « **Reply #9 on:** January 18, 2020, 04:22:10 pm »

Hey Johnno,

How is your new year going? Are you anywhere near the fires?

Quote

Probably why I found it difficult to play your version.

Ha! that's always the thing for the author of a game, he knows how it's supposed to go but has no idea how others will get stuck by some neglected to mention detail... oh well this started out as a model of game and then I was going to let all the picking be done randomly so I could run hundreds of sims to get some stats... still might do that but at moment I've been distracted by non programming subjects.

I was thinking maybe you'd like to put some assets together to jazz up the game but don't want you to get in trouble with your wife, so I won't ask. :D

Pete · « **Reply #10 on:** January 18, 2020, 05:16:26 pm »

Assets? This looks like a job for a Screen Zero Hero...

A couple of ascii-sets for you: (_|_) (_|_) (_|_) (_|_)

johnno56 · « **Reply #11 on:** January 18, 2020, 09:47:26 pm »

Bplus,

Our year is going along just fine and no, we are not anywhere near the fires. About 250-300 kms to the east but we have been affected by the smoke to varying degrees. Thankfully we have had some good soaking rains and have eased the fires a little but our summer is far from over....

As for assets... I would have to watch the show again to get some ideas... But, from what I can remember from the old Australian version, a bunch of people holding briefcases does not fire up the imagination... Perhaps after watching?

bplus · « **Reply #12 on:** January 18, 2020, 09:51:04 pm »

Perhaps after watching... the Internet has a wide range of images, looks like different countries have different versions.

Don't think Pete's version of Moon River will do :D

Perhaps it is useful to know the Banker is stingy, always shown as shadow and is played up as the wise cracking, wait... Pete?

Here I am down to 2 cases both contain $1 Million, what does the Banker offer for my case?

Pete · « **Reply #13 on:** January 18, 2020, 10:19:53 pm »

Ida only offeared ya five hundy thousand fur it.

- Sam

bplus · « **Reply #14 on:** January 18, 2020, 10:20:10 pm »

Here is updated version with Top 20 scores with date automatically added onto the name:

Code: QB64: [Select]

_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
REDIM SHARED offer(1 TO 1) AS DOUBLE
REDIM SHARED moneyBoard(1 TO 1) AS DOUBLE
DIM SHARED caseHolds(1 TO nCases) AS DOUBLE
'track during game
DIM SHARED moneySlot(1 TO nCases) AS INTEGER
DIM SHARED caseSelected(1 TO nCases) AS INTEGER
DIM SHARED offers(1 TO 10) AS STRING
 
DIM SHARED PlayerCase AS INTEGER, round AS INTEGER
RANDOMIZE TIMER
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 300, 40
 
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
        IF RND < .8 THEN
            CLS
            LOCATE 15, 1
            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..."
            WHILE LEN(INKEY$) = 0
                n% = INT(RND * 11) + 2
                LOCATE 20, 1: CP RIGHT$("0" + TS$(n%), 2)
                _LIMIT 5
            WEND
            PRINT: CP "Aha! " + TS$(n%) + " Million Dollar cases!"
            _DELAY 4
        ELSE
            n% = 1
        END IF
        init n%
        showB
        COLOR &HFFFFFFFF
        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
            WHILE _MOUSEINPUT: WEND
            md = _MOUSEBUTTON(1)
            IF md THEN mx = _MOUSEX: my = _MOUSEY
            _LIMIT 60
        WEND
        PlayerCase = my \ 16 - 1
        caseSelected(PlayerCase) = 1
        _DELAY 2
    ELSEIF round = 10 THEN 'offer to swap your case with the case remaining
        showB
        COLOR &HFFFFFFFF
        FOR lastCase% = 1 TO nCases 'find last case number
            IF caseSelected(lastCase%) = 0 THEN EXIT FOR
        NEXT
        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")
        IF switch$ = "s" THEN
            SWAP PlayerCase, lastCase%
            SWAP caseSelected(lastCase%), caseSelected(PlayerCase)
        END IF
        showB
        COLOR &HFFFFFFFF: PRINT
        CP "Host: The last case holds " + money$(caseHolds(lastCase%))
        CP "and your case has " + money$(caseHolds(PlayerCase)): _DELAY 5
        goAgain$ = topTenGoAgain$(INT(caseHolds(PlayerCase)))
        IF LEN(goAgain$) THEN SYSTEM ELSE GOTO restart
    ELSE
        nSelect% = 7 - round
        IF nSelect% < 1 THEN nSelect% = 1
        FOR r = 1 TO nSelect% 'select these many cases open and update money board
            showB
            COLOR &HFFFFFFFF
            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
                WHILE _MOUSEINPUT: WEND
                md = _MOUSEBUTTON(1)
                IF md THEN mx = _MOUSEX: my = _MOUSEY
                _LIMIT 60
            WEND
            caseN = my \ 16 - 1
            IF caseN > 0 AND caseN <= nCases THEN
                IF caseSelected(caseN) = 0 THEN caseSelected(caseN) = 1 ELSE GOTO tryAgain
            END IF
            PRINT: CP "Case " + TS$(caseN) + " contained: " + money$(caseHolds(caseN))
            _DELAY 2
            FOR c = 1 TO nCases 'update MoneyBoard
                IF moneyBoard(c) = caseHolds(caseN) AND moneySlot(c) = 0 THEN moneySlot(c) = 1: EXIT FOR
            NEXT
        NEXT
        showB 'now banker makes an offer
        COLOR &HFFFFFFFF
        _AUTODISPLAY
        PRINT: CP "'Ring' Host: Hello (silence) ..."
        _DELAY 3
        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")
        IF deal$ = "d" THEN
            CP "Your case had " + money$(caseHolds(PlayerCase))
            _DELAY 5
            goAgain$ = topTenGoAgain$(INT(bankerOffer#))
            IF LEN(goAgain$) THEN SYSTEM ELSE GOTO restart
        END IF
    END IF
NEXT
 
SUB showB
    CLS
    COLOR &HFF224488
    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
    COLOR &HFFFFFFFF
    PRINT " Money Prizes Left:  Cases Left:";
    IF PlayerCase THEN PRINT " Your Case is #"; TS$(PlayerCase);
    IF round > 1 THEN PRINT "  Offers for your case:" ELSE PRINT
    FOR i = 1 TO nCases
        IF moneySlot(i) = 0 THEN COLOR &HFFFFFF00 ELSE COLOR &HFF333333
        PRINT RIGHT$(SPACE$(19) + money$(moneyBoard(i)), 19);
        IF caseSelected(i) = 0 THEN COLOR &HFFFF9900 ELSE COLOR &HFF333333
        PRINT USING "#############"; i
    NEXT
    IF round > 1 THEN
        COLOR &HFF00AA00
        FOR i = 1 TO round - 1
            LOCATE 2 + i, 73 - LEN(offers(i)): PRINT offers(i)
        NEXT
    END IF
    ''check expectedValue
    COLOR &HFF0000FF
    LOCATE 2 + nCases + 1, 1: PRINT RIGHT$(SPACE$(19) + money$(expectedValue#), 19)
END SUB
 
SUB init (nMillionDollarCases%)
    IF UBOUND(offer) < 2 THEN 'not been here before
        offerDat$ = ".15,.24,.34,.43,.52,.62,.72,.82,.90,.95"
        Split offerDat$, ",", offer()
    END IF
    '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%
    FOR i = 1 TO nCases
        'clear other arrays
        IF i <= 10 THEN offers(i) = ""
        caseSelected(i) = 0
        moneySlot(i) = 0
        IF i <= startM% THEN
            caseHolds(i) = moneyBoard(i)
        ELSE
            moneyBoard(i) = 1000000.00#: caseHolds(i) = 1000000.00#
        END IF
    NEXT
    'shuffle case contents
    FOR i = nCases TO 2 STEP -1
        SWAP caseHolds(INT(RND * i) + 1), caseHolds(i)
    NEXT
END SUB
 
FUNCTION expectedValue#
    FOR i = 1 TO 26
        IF moneySlot(i) = 0 THEN
            n = n + 1
            tot## = tot## + moneyBoard(i)
        END IF
    NEXT
    expectedValue# = _ROUND(100 * tot## / n) / 100
END FUNCTION
 
' 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
    DIM fName$, n AS INTEGER, names$(1 TO 20), NAME$, i AS INTEGER, dt$, n$
    DIM settleScore AS LONG, scores(1 TO 20) AS LONG, score AS LONG '<<<<  modified to LONG
    fName$ = "Top 20 Scores.txt" '<<<  since this is toolbox code change this as needed for app
    dt$ = " " + MID$(DATE$, 7) + "-" + LEFT$(DATE$, 5) + "_" + MID$(TIME$, 1, 5)
    CLS: PRINT: CP "Your score was: " + TS$(compareScore): PRINT: CP "Top 20 Scorers and Scores:"
    IF _FILEEXISTS(fName$) THEN
        OPEN fName$ FOR INPUT AS #1
        WHILE EOF(1) = 0 AND n < 20
            n = n + 1
            INPUT #1, NAME$
            INPUT #1, score
            IF compareScore >= score AND settleScore = 0 THEN
                CP "You have made the Top 20!"
                CP "Type your name: "
                LOCATE CSRLIN, (xmax / 8 - 8) / 2
                INPUT "", n$
                names$(n) = n$ + dt$
                scores(n) = compareScore
                settleScore = -1
                n = n + 1
                IF n <= 20 THEN names$(n) = NAME$: scores(n) = score
            ELSE
                scores(n) = score: names$(n) = NAME$
            END IF
        WEND
        CLOSE #1
        IF n < 20 AND settleScore = 0 THEN
            CP "There is a slot open for your name and score."
            CP "Type your name:"
            LOCATE CSRLIN, (_WIDTH / 8 - 8) / 2
            INPUT " "; n$
            IF n$ <> "" THEN n = n + 1: names$(n) = n$ + dt$: scores(n) = compareScore
        END IF
        OPEN fName$ FOR OUTPUT AS #1
        IF n > 20 THEN n = 20
        PRINT
        FOR i = 1 TO n
            PRINT #1, names$(i): PRINT #1, scores(i)
            LOCATE CSRLIN, 20: PRINT RIGHT$("  " + TS$(i), 2) + RIGHT$(SPACE$(8) + TS$(scores(i)), 8) + ", " + names$(i)
        NEXT
        CLOSE #1
    ELSE
        CP "You are first into file of top scores!"
        CP "Type your name"
        LOCATE CSRLIN, (_WIDTH / 8 - 8) / 2
        INPUT " "; n$
        OPEN fName$ FOR OUTPUT AS #1
        PRINT #1, n$ + dt$: PRINT #1, compareScore
        CLOSE #1
    END IF
    PRINT: CP "Press <Enter> to play again, <q (or any) + Enter> to quit... "
    LOCATE CSRLIN, (_WIDTH / 8 - 8) / 2
    INPUT " "; topTenGoAgain$
END FUNCTION
 
'modified type from String to Double  for this app
SUB Split (SplitMeString AS STRING, delim AS STRING, loadMeArray() AS DOUBLE)
    DIM curpos AS LONG, arrpos AS LONG, LD AS LONG, dpos AS LONG 'fix use the Lbound the array already has
    curpos = 1: arrpos = LBOUND(loadMeArray): LD = LEN(delim)
    dpos = INSTR(curpos, SplitMeString, delim)
    DO UNTIL dpos = 0
        loadMeArray(arrpos) = VAL(MID$(SplitMeString, curpos, dpos - curpos))
        arrpos = arrpos + 1
        IF arrpos > UBOUND(loadMeArray) THEN REDIM _PRESERVE loadMeArray(LBOUND(loadMeArray) TO UBOUND(loadMeArray) + 1000) AS DOUBLE
        curpos = dpos + LD
        dpos = INSTR(curpos, SplitMeString, delim)
    LOOP
    loadMeArray(arrpos) = VAL(MID$(SplitMeString, curpos))
    REDIM _PRESERVE loadMeArray(LBOUND(loadMeArray) TO arrpos) AS DOUBLE 'get the ubound correct
END SUB
 
FUNCTION TS$ (n) 'single for small single or integer
    TS$ = _TRIM$(STR$(n))
END FUNCTION
 
SUB CP (s$) 'for xmax pixel wide graphics screen
    LOCATE CSRLIN, (_WIDTH / 8 - LEN(s$)) / 2: PRINT s$
END SUB
 
'this might make a nice Money format yeah! added to toolbox
FUNCTION money$ (n#) 'only works right for double# type
    DIM place AS INTEGER, s$, front$, back$
    money$ = _TRIM$(STR$(n#))
    IF LEFT$(money$, 1) = "-" THEN s$ = "-": money$ = MID$(money$, 2) ELSE s$ = ""
    place = INSTR(money$, ".")
    IF place = 0 THEN place = LEN(money$) + 1
    WHILE place > 4
        money$ = MID$(money$, 1, place - 4) + "," + MID$(money$, place - 3)
        place = INSTR(money$, ",")
    WEND
 
    'fix this for 2 places after decimal
    place = INSTR(money$, ".")
    IF place THEN
        front$ = MID$(money$, 1, place)
        back$ = MID$(money$, place + 1)
        IF LEN(back$) > 2 THEN money$ = front$ + LEFT$(back$, 2)
        IF LEN(back$) < 2 THEN money$ = front$ + LEFT$(back$ + "00", 2)
    ELSE
        money$ = money$ + ".00"
    END IF
    money$ = "$" + s$ + money$
END FUNCTION
 
FUNCTION getChar$ (fromStr$)
    DIM OK AS INTEGER, k$
    WHILE OK = 0
        k$ = INKEY$
        IF LEN(k$) THEN
            IF INSTR(fromStr$, k$) <> 0 THEN OK = -1
        END IF
        _LIMIT 200
    WEND
    _KEYCLEAR
    getChar$ = k$
END SUB
 
 

Next up to strip down the version to get some stats.

News:

Author Topic: Deal or No Deal (Read 6593 times)

bplus

Deal or No Deal

Pete

Re: Deal or No Deal

SMcNeill

Re: Deal or No Deal

Pete

Re: Deal or No Deal

OldMoses

Re: Deal or No Deal

bplus

Re: Deal or No Deal

SierraKen

Re: Deal or No Deal

bplus

Re: Deal or No Deal

johnno56

Re: Deal or No Deal

bplus

Re: Deal or No Deal

Pete

Re: Deal or No Deal

johnno56

Re: Deal or No Deal

bplus

Re: Deal or No Deal

Pete

Re: Deal or No Deal

bplus

Re: Deal or No Deal