Author Topic: Gin Rummy Variations with Computer (Read 3705 times)

bplus · « **on:** May 04, 2020, 08:58:19 am »

Here is a very fast playing variation of Gin Rummy, I call Grim Rummy because "It's all about the Deadwood."

A brief help file is included in zip, very simple game against computer with 0 images or sound effects.

Code: QB64: [Select]

OPTION _EXPLICIT
_TITLE "Grim Rummy" 'b+ started 2020-04-26 post 2020-05-04  wo dev notes
 
DEFINT A-Z
RANDOMIZE TIMER
CONST xmax = 800, ymax = 400 'screen to be expanded when start card images
 
'y Constants for locating and displaying
CONST deckY = 128 ' deck status line
CONST messageY = 160 '2 lines down from deckY
CONST cardOffsetX = 20
CONST cCardsOffsetY = 16
CONST pCardsOffsetY = 288 ' now in pixels
' for current and future card images
CONST cardW = 32 'pixels
CONST cardH = 16 'pixels
CONST black = &HFF000000, white = &HFFFFFFFF, bColor = &HFF220606
'some colors
 
DIM SHARED clr(3) AS _UNSIGNED LONG
clr(0) = &HFF00AA00 'mid green  clubs
clr(1) = &HFF0088CC 'cyan       diamonds
clr(2) = &HFFF80000 'red        hearts
clr(3) = &HFF0000AA 'mid blue   spades
' card "s_vv" format color coded Suits 0 to 3 = C, D, H, S and _ to separate Suit from number: A, 1, 2, 3,... 10, J, Q, K
 
DIM SHARED deck$(0 TO 51), deckPointer AS INTEGER ' contains shuffled cards, deckpointer points to last card out
DIM SHARED discard$, turn$ 'discard$ is card always face up that both players see
DIM SHARED p$(12, 3), c$(12, 3)
DIM SHARED pDeadPts, cDeadPts, pScore, cScore, laydown, showComputerHand ' p = human or c = computer
 
'local variables for main loop of game round and laydown section
DIM clicked 'human's button choice
DIM card$ ' used often for passing back and forth with routines
DIM message$ ' used for reporting results of laydown
DIM deadDiff ' used for reporting results of laydown
DIM pick$(2), pick2$(3)
pick$(0) = "Quit": pick$(1) = "Draw Discard": pick$(2) = "Draw from Deck"
pick2$(0) = "Quit": pick2$(1) = "Gin - all cards melded": pick2$(2) = "Knock - Deadwood <= 10": pick2$(3) = "Pass to Computer"
 
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 300, 150
setupGame 'create deck, human is first up
restart:
resetRound
DO
    IF turn$ = "p" THEN 'player's turn
        clicked = getButtonNumberChoice%(pick$())
        IF clicked = 0 THEN
            SYSTEM
        ELSEIF clicked = 1 THEN '      Human draws discard
            addCard p$(), discard$ '   put the discard into the humans hand
            discard$ = "" '            show the discard missing because in human hand
        ELSEIF clicked = 2 THEN '      Human draws from deck if there are enough cards
            IF 52 - deckPointer < 2 THEN laydown = 5: GOTO skip ELSE addCard p$(), dealCard$
        END IF
        updateStatus '                 display all this
        card$ = getDiscardClick$ '     get human's discard
        removeCard p$(), card$ '       take this card out of human hand
        discard$ = card$ '             put into discard catagory
        updateStatus '                 show the changes
        clicked = getButtonNumberChoice%(pick2$())
        SELECT CASE clicked
            CASE 0: SYSTEM ' quit
            CASE 1: laydown = 1 ' Gin
            CASE 2: laydown = 2 ' Knock
            CASE 3: turn$ = "c" ' pass
        END SELECT
    ELSEIF turn$ = "c" THEN '     computer's turn
        card$ = discard$
        cardDiscard card$ '       decision made here usu if deadwood is reduced by 10 points then yes
        IF card$ = discard$ THEN 'computer passed on the discard by passing it back
            'draw from the deck if there are enough cards remaining
            IF 52 - deckPointer < 2 THEN laydown = 5: GOTO skip ELSE card$ = dealCard$
            cardDiscard card$
            discard$ = card$
            updateStatus
            yCP messageY, "Computer drew from Deck and discarded."
            _DELAY 2
            IF cDeadPts = 0 THEN
                laydown = 3
            ELSEIF cDeadPts <= 10 THEN
                laydown = 4
            ELSE
                turn$ = "p"
            END IF
        ELSE 'computer kept discard
            discard$ = card$
            updateStatus
            yCP messageY, "Computer kept Discard and discarded another."
            _DELAY 2
            IF cDeadPts = 0 THEN
                laydown = 3
            ELSEIF cDeadPts <= 10 THEN
                laydown = 4
            ELSE
                turn$ = "p"
            END IF
        END IF
    END IF
    skip:
LOOP UNTIL laydown
 
' if players points exceed 100 after laydown results they win
showComputerHand = 1 'to show computer hand
SELECT CASE laydown
    CASE 1 ' human gin
        IF pDeadPts <> 0 THEN
            message$ = "Human lost 10 points calling Gin and not having it."
            pScore = pScore - 10
        ELSE
            message$ = "Human: 25 points Gin + " + ts$(cDeadPts) + " Computer's Deadwood."
            pScore = pScore + 25 + cDeadPts
        END IF
        turn$ = "c"
    CASE 2, 4 ' human knock or computer
        IF cDeadPts > pDeadPts THEN
            deadDiff = cDeadPts - pDeadPts
            message$ = "Human: 30 - " + ts$(52 - deckPointer) + " deck + " + ts$(deadDiff) + " deadwood = " + ts$(30 - (52 - deckPointer) + deadDiff)
            pScore = pScore + 30 - (52 - deckPointer) + deadDiff: turn$ = "c"
        ELSEIF pDeadPts > cDeadPts THEN
            deadDiff = pDeadPts - cDeadPts
            message$ = "Computer: 30 - " + ts$(52 - deckPointer) + " deck + " + ts$(deadDiff) + " deadwood = " + ts$(30 - (52 - deckPointer) + deadDiff)
            cScore = cScore + 30 - (52 - deckPointer) + deadDiff: turn$ = "p"
        ELSEIF cDeadPts = pDeadPts THEN
            message$ = "A Knockout tie! no score was advanced this round." 'turn is whatever it was
        END IF
    CASE 3 ' computer gin
        message$ = "Computer: 25 points Gin + " + ts$(pDeadPts) + " Human's deadwood."
        cScore = cScore + 25 + pDeadPts: turn$ = "p"
    CASE 5
        message$ = "The deck has < 2 cards, this round is Null!" ' turn is same as was
END SELECT
updateStatus
IF cScore >= 100 OR pScore >= 100 THEN message$ = message$ + "  Winner!"
yCP messageY, message$ + "  press any..."
SLEEP
IF INSTR(message$, "Winner!") THEN pScore = 0: cScore = 0
GOTO restart
 
SUB setupGame 'Intro to this version, create deck of cards, set turn to human
    DIM suit, value, i, bn
    DIM m$(2): m$(0) = "Quit": m$(1) = "Load Grim Rummy.txt": m$(2) = "Lets play Grim Rummy!"
    COLOR white, bColor 'once and for all on bColor
    CLS
    yCP 160, "'Load Grim Rummy.txt' Button will call up"
    yCP 180, "'Grim Rummy Variation.txt' into your favorite editor"
    yCP 200, "for you to refer to now or during play of Grim Rummy."
    yCP 300, "Cool now the coder of this game can edit es notes"
    yCP 320, "as e develops the game!"
    bn = getButtonNumberChoice(m$())
    IF bn = 0 THEN SYSTEM
    IF bn = 1 THEN SHELL _DONTWAIT "Grim Rummy Variation.txt" 'oh nice! don't have to load and show!
    IF deck$(0) = "" THEN 'create deck
        FOR suit = 1 TO 4
            FOR value = 1 TO 13
                deck$(i) = MID$("CDHS", suit, 1) + "_" + MID$("A 2 3 4 5 6 7 8 9 10J Q K ", 2 * (value - 1) + 1, 2) 'Suit_Value
                i = i + 1
            NEXT
        NEXT
    END IF
    turn$ = "p" 'player always starts game
END SUB
 
SUB resetRound
    ERASE p$, c$ 'clear hands  and rest the other globals
    pDeadPts = 0: cDeadPts = 0: laydown = 0: showComputerHand = 0 '< 1 for debug or cheating
    DIM i, r 'locals
    FOR i = 51 TO 1 STEP -1 'shuffle deck
        r = INT(RND * i)
        SWAP deck$(i), deck$(r)
    NEXT
    deckPointer = 0 'deal some cards out
    FOR i = 1 TO 10
        addCard p$(), dealCard$
        addCard c$(), dealCard$
    NEXT
    discard$ = deck$(deckPointer): deckPointer = deckPointer + 1 'set first discard$
    updateStatus
END SUB
 
SUB updateStatus
    COLOR white, bColor
    CLS
    show "p" '                    show updates pDeadPts  cardDiscard updates cDeadPts
    IF showComputerHand THEN show "c"
    COLOR clr(INSTR("CDHS", LEFT$(discard$, 1)) - 1) 'display discard$ in it's suit color
    _PRINTSTRING (411, deckY), discard$
    COLOR white
    yCP deckY, "Cards remaining: " + ts$(52 - deckPointer) + "  Discard: "
    yCP deckY + 128, "Human: " + ts$(pScore) + "   Computer: " + ts$(cScore)
END SUB
 
SUB show (player$) 'players hand is displayed 5 lines above bottom of screen in 4 lines
    DIM r, c, d$
    FOR r = 0 TO 3
        COLOR clr(r)
        FOR c = 0 TO 12
            IF player$ = "p" THEN
                IF p$(c, r) = "" THEN
                    _PRINTSTRING (c * 40 + cardOffsetX, r * 16 + pCardsOffsetY), "   "
                ELSE
                    _PRINTSTRING (c * 40 + cardOffsetX, r * 16 + pCardsOffsetY), p$(c, r)
                END IF
 
            ELSE
                IF c$(c, r) = "" THEN
                    _PRINTSTRING (c * 40 + cardOffsetX, r * 16 + cCardsOffsetY), "   "
                ELSE
                    _PRINTSTRING (c * 40 + cardOffsetX, r * 16 + cCardsOffsetY), c$(c, r)
                END IF
            END IF
        NEXT
    NEXT
    COLOR &HFFCCDD00 'dark brown sort a like deadwood?
    IF player$ = "p" THEN
        pDeadPts = deadwood(p$(), d$)
        yCP 80 + pCardsOffsetY, ts$(LEN(d$) \ 5) + " Deadwood Cards = " + ts$(pDeadPts) + " points"
    ELSE
        cDeadPts = deadwood(c$(), d$)
        yCP 80 + cCardsOffsetY, ts$(LEN(d$) \ 5) + " Deadwood Cards = " + ts$(cDeadPts) + " points"
    END IF
    COLOR white
END SUB
 
'player reviews card rec'd and discards through mouse click
FUNCTION getDiscardClick$ 'this has to be reworked
    DIM oldMouse, mCol, mRow, mb
    yCP messageY, "Click Discard"
    oldMouse = -1
    DO
        WHILE _MOUSEINPUT: WEND 'convert mouse positions to array row and col
        mCol = INT((_MOUSEX - cardOffsetX) / (cardW + 8) + .25)
        mRow = INT((_MOUSEY - pCardsOffsetY) / (cardH))
        mb = _MOUSEBUTTON(1)
        'LOCATE 13, 2: PRINT mCol, mRow
        IF mb AND oldMouse = 0 THEN
            IF mRow >= 0 AND mRow <= 3 THEN
                IF mCol >= 0 AND mCol <= 12 THEN
                    IF p$(mCol, mRow) <> "" THEN getDiscardClick$ = p$(mCol, mRow): EXIT FUNCTION
                END IF
            END IF
        END IF
        oldMouse = mb
        _LIMIT 200
    LOOP
END FUNCTION
 
'computer gets card and discards through this AI
SUB cardDiscard (card$) 'for AI
    DIM ci, r, c, low, d$, saveI, i
    DIM cds$(1 TO 11), dw(1 TO 11)
    ci = 1
    FOR r = 0 TO 3
        FOR c = 0 TO 12
            IF c$(c, r) <> "" THEN cds$(ci) = c$(c, r): ci = ci + 1
        NEXT
    NEXT
    cds$(11) = card$
    low = 200
    dw(11) = deadwood(c$(), d$)
    IF dw(11) < low THEN saveI = 11: low = dw(11)
    addCard c$(), card$
    FOR i = 1 TO 10
        removeCard c$(), cds$(i)
        dw(i) = deadwood(c$(), d$)
        IF dw(i) < low THEN saveI = i: low = dw(i)
        addCard c$(), cds$(i)
    NEXT
    ' 11 cards are in c$()
    IF card$ = discard$ THEN 'we dont want to take discard unless it makes significant difference
        IF dw(11) - low > 10 THEN 'take discard$ 'it's already in hand
            removeCard c$(), cds$(saveI)
            card$ = cds$(saveI) 'discard
        ELSE 'don't take discard$
            removeCard c$(), card$ 'reject the discard
        END IF
    ELSE 'have to remove something?
        removeCard c$(), cds$(saveI) ' remove from c$() to get it to 10
        card$ = cds$(saveI) ' pass it back in card variable
    END IF
    cDeadPts = deadwood(c$(), d$)
END SUB
 
' This is key to Gin Rummy Game. This is a C for crosswords version of Deadwood.
' Crosswords means a card can be used both in a group set and straight set in making meld.
' Since Grim Rummy is based on Deadwood points there is no extra credit for using a card twice,
' it just makes it easier to clear deadwood for players and calculate deadwood points for coder.
FUNCTION deadwood (a$(), dead$)
    REDIM sSets$(0), gSets$(0) 'although 0 based these sets have first element at 1 as they are added in by sAppend SUB
    DIM r, c, quit, cStart, cEnd, set$, ci, count 'finding meld sets
 
    ' checking for card intersets between gSet and sSet
    DIM si, gi '           index for each of these arrays of sets
    DIM nsCards, ngCards ' number of cards in the single set
    DIM place '            where in set a card is
 
    'sets with card intersects removed now time to count deadwood
    DIM nCards, cardI, n 'card Count, card index and another index
 
    FOR r = 0 TO 3 'look for straights
        c = 0: quit = 0
        DO WHILE quit = 0 AND c < 13
            WHILE a$(c, r) = ""
                c = c + 1
                IF c > 11 THEN quit = 1: EXIT WHILE
            WEND
            IF c < 11 THEN
                cStart = c
                WHILE a$(c, r) <> ""
                    c = c + 1
                    IF c = 13 THEN quit = 1: EXIT WHILE
                WEND
                IF c = 13 THEN cEnd = 12 ELSE cEnd = c - 1
                IF cEnd - cStart + 1 > 2 THEN
                    set$ = ""
                    FOR ci = cStart TO cEnd
                        set$ = set$ + a$(ci, r)
                    NEXT
                    sAppend sSets$(), set$
                END IF
                IF c > 11 THEN quit = 1
            ELSE
                EXIT DO
            END IF
        LOOP
    NEXT
    FOR c = 0 TO 12 ' now for the groups
        count = 0
        FOR ci = 0 TO 3
            IF a$(c, ci) <> "" THEN count = count + 1
        NEXT
        IF count > 2 THEN
            set$ = ""
            FOR ci = 0 TO 3
                IF a$(c, ci) <> "" THEN set$ = set$ + a$(c, ci)
            NEXT
            sAppend gSets$(), set$
        END IF
    NEXT
    ' now it's time to calculate the deadwood number ======================================
    REDIM cards$(0) '<<< why is this at 11? hack fix for cardDiscard call
    FOR r = 0 TO 3
        FOR c = 0 TO 12
            IF a$(c, r) <> "" THEN sAppend cards$(), a$(c, r)
        NEXT
    NEXT
    nCards = UBOUND(cards$)
    FOR si = 1 TO UBOUND(sSets$)
        IF sSets$(si) <> "" THEN
            nsCards = LEN(sSets$(si)) / 4
            FOR cardI = 1 TO nsCards
                FOR n = 1 TO nCards
                    IF cards$(n) = MID$(sSets$(si), cardI * 4 - 3, 4) THEN cards$(n) = ""
                NEXT
            NEXT
        END IF
    NEXT
    FOR gi = 1 TO UBOUND(gSets$)
        IF gSets$(gi) <> "" THEN
            ngCards = LEN(gSets$(gi)) / 4
            FOR cardI = 1 TO ngCards
                FOR n = 1 TO nCards
                    IF cards$(n) = MID$(gSets$(gi), cardI * 4 - 3, 4) THEN cards$(n) = ""
                NEXT
            NEXT
        END IF
    NEXT
    'ok melded cards cleaned out
    dead$ = "": count = 0
    FOR n = 1 TO nCards
        IF cards$(n) <> "" THEN
            dead$ = dead$ + " " + cards$(n)
            place = INSTR("A 2 3 4 5 6 7 8 9 10J Q K ", MID$(cards$(n), 3, 2))
            IF (place + 1) / 2 < 10 THEN count = count + (place + 1) / 2 ELSE count = count + 10
        END IF
    NEXT
    deadwood = count
END FUNCTION
 
FUNCTION dealCard$
    dealCard$ = deck$(deckPointer): deckPointer = deckPointer + 1
END SUB
 
SUB addCard (a$(), card$)
    DIM r, c
    r = INSTR("CDHS", LEFT$(card$, 1)) - 1: c = (INSTR("A 2 3 4 5 6 7 8 9 10J Q K ", MID$(card$, 3, 2)) - 1) / 2
    a$(c, r) = card$
END SUB
 
SUB removeCard (a$(), card$)
    DIM r, c
    r = INSTR("CDHS", LEFT$(card$, 1)) - 1: c = (INSTR("A 2 3 4 5 6 7 8 9 10J Q K ", MID$(card$, 3, 2)) - 1) / 2
    a$(c, r) = ""
END SUB
 
'modified for this app
SUB yCP (y, s$) 'for xmax pixel wide graphics screen Center Print at pixel y row
    _PRINTSTRING ((_WIDTH - 220 - LEN(s$) * 8) / 2, y), s$
END SUB
 
'this sub uses drwBtn
FUNCTION getButtonNumberChoice% (choice$()) 'developed for this app but likely can use as is elsewhere
    DIM ub, b, oldmouse, mx, my, mb
 
    ub = UBOUND(choice$)
    FOR b = 0 TO ub
        drwBtn xmax - 210, b * 60 + 90, choice$(b)
    NEXT
    oldmouse = -1
    DO
        WHILE _MOUSEINPUT: WEND
        mx = _MOUSEX: my = _MOUSEY: mb = _MOUSEBUTTON(1)
        IF mb AND oldmouse = 0 THEN
            IF mx > xmax - 210 AND mx <= xmax - 10 THEN
                FOR b = 0 TO ub
                    IF my >= b * 60 + 90 AND my <= b * 60 + 140 THEN
                        LINE (xmax - 210, 0)-(xmax, ymax), bColor, BF
                        getButtonNumberChoice% = b: EXIT FUNCTION
                    END IF
                NEXT
                BEEP
            ELSE
                BEEP
            END IF
        END IF
        oldmouse = _MOUSEBUTTON(1)
        _LIMIT 200
    LOOP
END FUNCTION
 
SUB drwBtn (x, y, s$) '200 x 50
    DIM th, tw, gray~&
    th = 16: tw = 8 * LEN(s$): gray~& = _RGB32(190, 190, 190)
    LINE (x, y)-STEP(204, 54), _RGB32(0, 0, 0), BF
    LINE (x - 2, y - 2)-STEP(201, 51), _RGB32(255, 255, 255), BF
    LINE (x, y)-STEP(200, 50), gray~&, BF
    COLOR _RGB32(0, 0, 0), gray~&
    _PRINTSTRING (x + 100 - 4 * LEN(s$), y + 17), s$
    COLOR white, bColor
END SUB
 
SUB sAppend (arr() AS STRING, addItem$)
    REDIM _PRESERVE arr(LBOUND(arr) TO UBOUND(arr) + 1) AS STRING
    arr(UBOUND(arr)) = addItem$
END SUB
 
FUNCTION ts$ (number)
    ts$ = _TRIM$(STR$(number))
END FUNCTION
 

Until I can figure out how to code it otherwise, a card may be used both in a Straight set (3 or more sequence of same suit) and a Group set (3 or 4 of a kind).

It's quite a challenge to figure optimum Deadwood of 10 or 11 cards when, like in a regular game of Gin Rummy, a card may be used either in a Straight set or a Group set but not both. I've been at it for a few days now and haven't figured it out yet. Maybe one of you guys can get it?

The zip is just the source (above) and a helper txt file.

bplus · « **Reply #1 on:** October 12, 2020, 12:12:49 am »

I have finally found the way to optimize a Gin Rummy hand and have revised Grim Rummy with the new code. It plays very well. Now you can use a card for a Straight set or a Group set but not both.

Grin Rummy variation coming next but might need even more AI.

johnno56 · « **Reply #2 on:** October 12, 2020, 02:34:21 am »

Another card game?... A glutton for punishment... lol

As I have never played this game before, I seriously doubt, that I can help you with the coding... If you ever get to the point of adding sound and graphics, as long as it's not too difficult, let me know...

bplus · « **Reply #3 on:** October 12, 2020, 10:26:45 am »

Quote from: johnno56 on October 12, 2020, 02:34:21 am

Another card game?... A glutton for punishment... lol

As I have never played this game before, I seriously doubt, that I can help you with the coding... If you ever get to the point of adding sound and graphics, as long as it's not too difficult, let me know...

The idea behind all Gin Games is to match cards into sets, either a Group Set = all of a kind like 3 Jacks or 4 Nines or a Straight Set eg, Ace, 2, 3 of Spades or 5, 6, 7, 8, 9 of Harts... a sequence of of same suit. Minimum 3 cards to a set. So for group sets, the maximum can be 4 of a kind but theoretically a Gin hand can be one big Straight set! (Should maybe be extra points for that, hmm... )

Meld are all the cards matched to a set or the Points of those cards, Ace counts only as 1 and Face cards are 10 points the rest are their number value.

Now in my own invention, Grim Rummy Variation, the only thing that matters is Deadwood. Deadwood are the cards or their point value of cards not matched into sets. When you have 10 or less points in Deadwood you "Knock" and player with least Deadwood Points wins the difference in Deadwood points PLUS 30 - number of cards remaining in deck (this almost guarantees at least 10 points won in a round).

The focus on Deadwood only seems kind of Grim hence the name of this variation.

Now the next Variation of my invention is Grin Rummy. The complete opposite of Grim it focuses entirely on Meld, Deadwood only matters for "Knocking" or calling Gin = 0 Deadwood cards or Points. I haven't worked out details for game scoring yet because I hadn't had a decent Gin hand Optimizer until Saturday.

Funny Saturday morning I woke up early and sketched out a new and different plan of attack for building the Optimizer code. It wasn't quite as easy as originally imagined but it turned out far more elegant than a rules or conditions based system that was so complex you get lost in handling all the possible cases that could happen but most aren't likely, like having to split a big Straight set without loosing more than 1 card for meld.

You know you can put together only 3 sets maximum for Gin Rummy yet the code it takes to establish the best 3 sets is quite involved! And cards that intersect both a Group set and a Straight set, they have to go in one or the other; trouble is all the combinations of which set the intersecting card should go. So finally Saturday I put together code that tests each combination and saves the first one that uses the most cards or has the highest points.

Cobalt · « **Reply #4 on:** October 12, 2020, 06:36:26 pm »

I've always wanted to recreate Intellivision's "Royal Dealer" version of Gin Rummy. Also has Hearts, Crazy 8s and one more thats not poppin in at the moment.

bplus · « **Reply #5 on:** October 12, 2020, 07:06:19 pm »

Quote from: Cobalt on October 12, 2020, 06:36:26 pm

I've always wanted to recreate Intellivision's "Royal Dealer" version of Gin Rummy. Also has Hearts, Crazy 8s and one more thats not poppin in at the moment.

Rummy is #4, these days when it's not poppin try popping Google :) I had never even heard of Royal Dealer:
http://www.thevgatv.com/resources/Intellivision/Royal-Dealer-Intv.pdf

@johnno56 wanna try aliens for this?

Cobalt · « **Reply #6 on:** October 12, 2020, 07:30:17 pm »

I even have the graphics already sprite sheet-ed, from a bit of work I did some time ago on it. Yeah I forgot it had Rummy and Gin Rummy.

bplus · « **Reply #7 on:** October 12, 2020, 07:43:37 pm »

@Cobalt

I just watched this:

This guys says straights are limited to 3-4 cards in Gin Rummy, say it aint so, say this guy has his rules screwed up.

I am allowing Straights of any length including 10 cards!

Cobalt · « **Reply #8 on:** October 12, 2020, 07:53:16 pm »

I don't know... I think I have had full straight wins before. Its been a while since I've played so I might need to give it a go again, granted getting a full straight win is not easy to pull off any how.

Cobalt · « **Reply #9 on:** October 12, 2020, 09:59:13 pm »

Yeah you can get more than straights of 3 or 4, haven't gotten to 7 or more yet but here is a double 5 straight hand that won a round.

So yeah that dude is wack.

and I had the 9 of spades that discarded when I called gin, so I could have had 6 if I would have discarded a diamond instead.

bplus · « **Reply #10 on:** October 13, 2020, 12:02:07 am »

Ah good! Glad to see Cobalt :) I've seen a few 7 Straights myself.

Here is Grin Rummy I had going months ago. Tonight I changed look and play of game a bit. It is allowing double use of a card both in a Straight set and a Group set. For Grin Rummy, this works out great for getting some really massive Melds built up if you can only beat the computer to GRIN :) In this game you have to meld all cards before computer melds it's hand to get your meld points scored, play is to 500 points.

Code: QB64: [Select]

OPTION _EXPLICIT
_TITLE "Grin Rummy" 'b+ started 2020-04-28  revised 2020-10-12
' complete opposite of Grim Rummy
 
DEFINT A-Z
RANDOMIZE TIMER
CONST xmax = 800, ymax = 400 'screen to be expanded when start card images
 
'y Constants for locating and displaying
CONST deckY = 128 ' deck status line
CONST messageY = 160 '2 lines down from deckY
CONST cardOffsetX = 20
CONST cCardsOffsetY = 16
CONST pCardsOffsetY = 288 ' now in pixels
' for current and future card images
CONST cardW = 32 'pixels
CONST cardH = 16 'pixels
CONST black = &HFF000000, white = &HFFFFFFFF, bColor = &HFF5566FF
'some colors
 
DIM SHARED clr(3) AS _UNSIGNED LONG
clr(0) = &HFF006644 'mid green  clubs
clr(1) = &HFF00FF44 'cyan       diamonds
clr(2) = &HFFCC3300 'red        hearts
clr(3) = &HFF880099 'mid blue   spades
' card "##s" space or # for 10, # or Letter for digit/Face  card symbol
 
DIM SHARED deck$(0 TO 51), deckPointer AS INTEGER ' contains shuffled cards, deckpointer points to last card out
DIM SHARED discard$, turn$ 'discard$ is card always face up that both players see
DIM SHARED p$(12, 3), c$(12, 3)
DIM SHARED pMeldPts, cMeldPts, pND, cND, pScore, cScore, laydown, showComputerHand ' p = human or c = computer
DIM SHARED pick1$(2), pick2$(2) 'human player's choices at each play
pick1$(0) = "Quit": pick1$(1) = "Draw Discard": pick1$(2) = "Draw from Deck"
pick2$(0) = "Quit": pick2$(1) = "Grin - all cards melded": pick2$(2) = "Pass to Computer"
 
'local variables for main loop of game round and laydown section
DIM clicked 'human's button choice
DIM card$ ' used often for passing back and forth with routines
DIM message$ ' used for reporting results of laydown
DIM meld ' used for reporting results of laydown
DIM oldMouse
 
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 300, 150
setupGame 'create deck, human is first up
restart:
resetRound
DO
    IF turn$ = "p" THEN 'player's turn
        clicked = getButtonNumberChoice%(pick1$())
        IF clicked = 0 THEN ' human wants to quit
            SYSTEM
        ELSEIF clicked = 1 THEN '            Human draws discard
            addCard p$(), discard$ '   put the discard into the humans hand
            discard$ = "" '            show the discard missing because in human hand
        ELSEIF clicked = 2 THEN ' Human  Draws from deck if enough cards left
            IF 52 - deckPointer < 2 THEN laydown = 5: GOTO skip ELSE addCard p$(), dealCard$ ' place next deck card into humans hand
        END IF
        updateStatus '             display all this
        card$ = getDiscardClick$ ' get human's discard
        removeCard p$(), card$ '   take this card out of human hand
        discard$ = card$ '         put into discard catagory
        updateStatus '             show the changes
        IF pND = 0 THEN laydown = 1 ELSE turn$ = "c"
 
    ELSEIF turn$ = "c" THEN 'computer's turn
        card$ = discard$
        cardDiscard card$ '
        IF card$ = discard$ THEN 'computer passed on the discard by passing it back
            ' so draw from deck if not out of cards?
            IF 52 - deckPointer < 2 THEN laydown = 5: GOTO skip ELSE card$ = dealCard$
            cardDiscard card$
            discard$ = card$
            updateStatus
            yCP messageY, "Computer drew from Deck and discarded."
        ELSE 'computer kept discard
            discard$ = card$
            updateStatus
            yCP messageY, "Computer kept Discard and discarded another."
        END IF
        _DELAY 2
        IF cND = 0 THEN updateStatus: yCP messageY, "Grin": laydown = 3 ELSE turn$ = "p"
    END IF
    skip:
LOOP UNTIL laydown
 
'show computer's hand when not in debug mode
'remember the turn will go to loser of laydown
' if players points exceed 100 after laydown results they win
showComputerHand = 1 'to show computer hand
SELECT CASE laydown
    IF pMeldPts > cMeldPts THEN meld = pMeldPts ELSE meld = cMeldPts
    CASE 1 ' human gin
        message$ = "Human: " + ts$(meld) + " has been added to your score."
        pScore = pScore + meld
        turn$ = "c"
    CASE 3 ' computer gin
        drwBtn xmax - 210, 200, "GRIN :)"
        message$ = "Computer: " + ts$(meld) + " has been added to your score."
        cScore = cScore + meld
        turn$ = "p"
    CASE 5
        message$ = "The deck has < 2 cards, this round is Null!" ' turn is same as was
END SELECT
updateStatus
IF pND = 0 THEN
    drwBtn xmax - 210, ymax - 100, "GRIN :)"
ELSEIF cND = 0 THEN
    drwBtn xmax - 210, 50, "GRIN :)"
END IF
IF cScore >= 500 OR pScore >= 500 THEN message$ = message$ + "  Winner!"
yCP messageY, message$ + "  click..."
oldMouse = -1
DO
    WHILE _MOUSEINPUT: WEND
    ' mb = _MOUSEBUTTON(1)
    IF _MOUSEBUTTON(1) AND oldMouse = 0 THEN
        LINE (xmax - 210, 0)-(xmax, ymax), bColor, BF
        IF INSTR(message$, "Winner!") THEN pScore = 0: cScore = 0
        EXIT DO
    END IF
    oldMouse = _MOUSEBUTTON(1)
LOOP
GOTO restart
 
SUB setupGame 'Intro to this version, create deck of cards, set turn to human
    DIM suit, value, i, bn
    DIM m$(2): m$(0) = "Quit": m$(1) = "Load .txt on Grin Rummy": m$(2) = "Let's play Grin Rummy"
    COLOR white, bColor 'once and for all on bColor
    CLS
    yCP 160, "'Load .txt of Grin Rummy' Button will call up"
    yCP 180, "'Grin Rummy Variation.txt' into your favorite editor"
    yCP 200, "for you to refer to now or during play of Grin Rummy."
 
    yCP 300, "Cool now the coder of this game can edit es notes"
    yCP 320, "as e develops the game!"
 
    bn = getButtonNumberChoice(m$())
    IF bn = 0 THEN SYSTEM
    IF bn = 1 THEN SHELL _DONTWAIT "Grin Rummy Variation.txt" 'oh nice! don't have to load and show!
    IF deck$(0) = "" THEN 'create deck
        FOR suit = 1 TO 4
            FOR value = 1 TO 13
                deck$(i) = MID$(" A 2 3 4 5 6 7 8 910 J Q K", 2 * (value - 1) + 1, 2) + MID$(CHR$(3) + CHR$(4) + CHR$(5) + CHR$(6), suit, 1) 'Suit_Value
                i = i + 1
            NEXT
        NEXT
    END IF
    turn$ = "p" 'player always starts game
END SUB
 
SUB resetRound
    DIM i, r 'locals, wow not many for all the code here
    ERASE p$, c$ 'clear hands  13 cols and 4 rows arrays  copy of ordered deck
    pMeldPts = 0: cMeldPts = 0: laydown = 0: showComputerHand = 0 '< 1 for debug or cheating
 
    'shuffle deck
    FOR i = 51 TO 1 STEP -1
        r = INT(RND * i)
        SWAP deck$(i), deck$(r)
    NEXT
    deckPointer = 0 'deal some cards out
    FOR i = 1 TO 10
        addCard p$(), dealCard$
        addCard c$(), dealCard$
    NEXT
    discard$ = deck$(deckPointer): deckPointer = deckPointer + 1 'set first discard$
    updateStatus
END SUB
 
SUB updateStatus
    COLOR white, bColor
    CLS
    show "p" '                    show updates pMeldPts  cardDiscard updates cMeldPts
    IF showComputerHand THEN show "c"
    COLOR clr(INSTR(CHR$(3) + CHR$(4) + CHR$(5) + CHR$(6), RIGHT$(discard$, 1)) - 1) 'display discard$ in it's suit color
    _PRINTSTRING (411, deckY), discard$
    COLOR white
    yCP deckY, "Cards remaining: " + ts$(52 - deckPointer) + "  Discard: "
    yCP deckY + 128, "Human: " + ts$(pScore) + "   Computer: " + ts$(cScore)
END SUB
 
SUB show (player$) 'players hand is displayed 5 lines above bottom of screen in 4 lines
    DIM r, c, nD
    FOR r = 0 TO 3
        COLOR clr(r)
        FOR c = 0 TO 12
            IF player$ = "p" THEN
                IF p$(c, r) = "" THEN
                    _PRINTSTRING (c * 40 + cardOffsetX, r * 16 + pCardsOffsetY), "   "
                ELSE
                    _PRINTSTRING (c * 40 + cardOffsetX, r * 16 + pCardsOffsetY), p$(c, r)
                END IF
 
            ELSE
                IF c$(c, r) = "" THEN
                    _PRINTSTRING (c * 40 + cardOffsetX, r * 16 + cCardsOffsetY), "   "
                ELSE
                    _PRINTSTRING (c * 40 + cardOffsetX, r * 16 + cCardsOffsetY), c$(c, r)
                END IF
            END IF
        NEXT
    NEXT
    COLOR &HFFFFFF00 'dark brown sort a like cMeldTotal?
    IF player$ = "p" THEN
        pMeldPts = cMeldTotal(p$(), nD): pND = nD
        yCP 80 + pCardsOffsetY, "  Player:  Meld = " + ts$(pMeldPts) + "    Deadwood Cards = " + ts$(pND)
    ELSE
        cMeldPts = cMeldTotal(c$(), nD): cND = nD
        yCP 80 + cCardsOffsetY, "Computer:  Meld = " + ts$(cMeldPts) + "    Deadwood Cards = " + ts$(cND)
    END IF
    COLOR white
END SUB
 
'player reviews card rec'd and discards through mouse click
FUNCTION getDiscardClick$ 'this has to be reworked
    DIM oldMouse, mCol, mRow, mb
    yCP messageY, "Click Discard"
    oldMouse = -1
    DO
        WHILE _MOUSEINPUT: WEND 'convert mouse positions to array row and col
        mCol = INT((_MOUSEX - cardOffsetX) / (cardW + 8) + .25)
        mRow = INT((_MOUSEY - pCardsOffsetY) / (cardH))
        mb = _MOUSEBUTTON(1)
        'LOCATE 13, 2: PRINT mCol, mRow
        IF mb AND oldMouse = 0 THEN
            IF mRow >= 0 AND mRow <= 3 THEN
                IF mCol >= 0 AND mCol <= 12 THEN
                    IF p$(mCol, mRow) <> "" THEN getDiscardClick$ = p$(mCol, mRow): EXIT FUNCTION
                END IF
            END IF
        END IF
        oldMouse = mb
        _LIMIT 200
    LOOP
END FUNCTION
 
'computer gets card and discards through this AI
SUB cardDiscard (card$) 'for AI
    DIM ci, r, c, dwStart, dwlow, nD, saveI, i
    DIM cds$(1 TO 11), meld(1 TO 11)
    ci = 1
    FOR r = 0 TO 3
        FOR c = 0 TO 12
            IF c$(c, r) <> "" THEN cds$(ci) = c$(c, r): ci = ci + 1
        NEXT
    NEXT
    cds$(11) = card$
    meld(11) = cMeldTotal(c$(), nD): dwlow = nD: saveI = 11: dwStart = nD 'the hand before considering the new card
    addCard c$(), card$
    FOR i = 1 TO 10 'remove each card in hand and check dwLow and meld
        removeCard c$(), cds$(i)
        meld(i) = cMeldTotal(c$(), nD)
        IF nD < dwlow THEN 'ah less dead wood it's a keeper
            saveI = i: dwlow = nD
        ELSEIF nD = dwlow THEN ' ah same amount of deadwood but more meld so keep this
            IF meld(i) > meld(saveI) THEN saveI = i
        END IF
        addCard c$(), cds$(i) 'restore card back to 11
    NEXT
 
    ' 11 cards are in c$()
    IF card$ = discard$ THEN 'we dont want to take discard unless it makes significant difference
        IF dwlow < dwStart THEN 'take discard$ 'it's already in hand
            removeCard c$(), cds$(saveI)
            card$ = cds$(saveI) 'discard
        ELSE 'don't take discard$
            removeCard c$(), card$ 'reject the discard
        END IF
    ELSE 'have to remove something?
        removeCard c$(), cds$(saveI) ' remove from c$() to get it to 10
        card$ = cds$(saveI) ' pass it back in card variable
    END IF
    cMeldPts = cMeldTotal(c$(), nD) 'update current cMeldPts
    cND = nD
END SUB
 
' This is key to Grin Rummy Game. This is a C for crosswords version of cMeldTotal.
' Crosswords means a card can be used both in a group set and straight set in making meld.
' Since Grin Rummy is based on cMeldTotal points there is extra credit for using a card twice!
FUNCTION cMeldTotal% (a$(), nDeadCards) 'return Meld Point Total and nDeadCards
    REDIM sSets$(0), gSets$(0) 'although 0 based these sets have first element at 1 as they are added in by sAppend SUB
    DIM r, c, quit, cStart, cEnd, set$, ci, count 'finding meld sets
    REDIM cards$(0) 'make a list of cards while at it (in counting Group sets block)
    ' checking for card intersets between gSet and sSet
    DIM si, gi '           index for each of these arrays of sets
    DIM nsCards, ngCards ' number of cards in the single set
 
    'sets with card intersects removed now time to count cMeldTotal
    DIM nCards, cardI, n 'card Count, card index and another index
 
    FOR r = 0 TO 3 'look for straights
        c = 0: quit = 0
        DO WHILE quit = 0 AND c < 13
            WHILE a$(c, r) = ""
                c = c + 1
                IF c > 11 THEN quit = 1: EXIT WHILE
            WEND
            IF c < 11 THEN
                cStart = c
                WHILE a$(c, r) <> ""
                    c = c + 1
                    IF c = 13 THEN quit = 1: EXIT WHILE
                WEND
                IF c = 13 THEN cEnd = 12 ELSE cEnd = c - 1
                IF cEnd - cStart + 1 > 2 THEN
                    set$ = ""
                    FOR ci = cStart TO cEnd
                        set$ = set$ + a$(ci, r)
                        cMeldTotal% = cMeldTotal% + points(a$(ci, r))
                    NEXT
                    sAppend sSets$(), set$
                END IF
                IF c > 11 THEN quit = 1
            ELSE
                EXIT DO
            END IF
        LOOP
    NEXT
    FOR c = 0 TO 12 ' now for the groups and make a list of cards
        count = 0
        FOR ci = 0 TO 3
            IF a$(c, ci) <> "" THEN count = count + 1: sAppend cards$(), a$(c, ci) 'add to card list
        NEXT
        IF count > 2 THEN
            set$ = ""
            FOR ci = 0 TO 3
                IF a$(c, ci) <> "" THEN set$ = set$ + a$(c, ci): cMeldTotal% = cMeldTotal% + points(a$(c, ci))
            NEXT
            sAppend gSets$(), set$
        END IF
    NEXT
    ' meld is counted but how many dead cards left?
    nCards = UBOUND(cards$)
    FOR si = 1 TO UBOUND(sSets$)
        IF sSets$(si) <> "" THEN
            nsCards = LEN(sSets$(si)) / 3
            FOR cardI = 1 TO nsCards
                FOR n = 1 TO nCards
                    IF cards$(n) = MID$(sSets$(si), cardI * 3 - 2, 3) THEN cards$(n) = ""
                NEXT
            NEXT
        END IF
    NEXT
    FOR gi = 1 TO UBOUND(gSets$)
        IF gSets$(gi) <> "" THEN
            ngCards = LEN(gSets$(gi)) / 3
            FOR cardI = 1 TO ngCards
                FOR n = 1 TO nCards
                    IF cards$(n) = MID$(gSets$(gi), cardI * 3 - 2, 3) THEN cards$(n) = ""
                NEXT
            NEXT
        END IF
    NEXT
    'ok melded cards cleaned out
    nDeadCards = 0
    FOR n = 1 TO nCards
        IF cards$(n) <> "" THEN
            nDeadCards = nDeadCards + 1
        END IF
    NEXT
END FUNCTION
 
FUNCTION dealCard$
    dealCard$ = deck$(deckPointer): deckPointer = deckPointer + 1
END SUB
 
FUNCTION points% (card$)
    DIM place
    place = INSTR(" A 2 3 4 5 6 7 8 910 J Q K", MID$(card$, 1, 2))
    IF (place + 1) / 2 < 10 THEN points% = (place + 1) / 2 ELSE points% = 10
END FUNCTION
 
SUB addCard (a$(), card$)
    PRINT card$
    DIM r, c
    r = INSTR(CHR$(3) + CHR$(4) + CHR$(5) + CHR$(6), RIGHT$(card$, 1)) - 1: c = (INSTR(" A 2 3 4 5 6 7 8 910 J Q K", MID$(card$, 1, 2)) - 1) / 2
    a$(c, r) = card$
END SUB
 
SUB removeCard (a$(), card$)
    DIM r, c
    r = INSTR(CHR$(3) + CHR$(4) + CHR$(5) + CHR$(6), RIGHT$(card$, 1)) - 1: c = (INSTR(" A 2 3 4 5 6 7 8 910 J Q K", MID$(card$, 1, 2)) - 1) / 2
    a$(c, r) = ""
END SUB
 
'modified for this app
SUB yCP (y, s$) 'for xmax pixel wide graphics screen Center Print at pixel y row
    _PRINTSTRING ((_WIDTH - 220 - LEN(s$) * 8) / 2, y), s$
END SUB
 
'this sub uses drwBtn
FUNCTION getButtonNumberChoice% (choice$()) 'developed for this app but likely can use as is elsewhere
    DIM ub, b, oldmouse, mx, my, mb
 
    ub = UBOUND(choice$)
    FOR b = 0 TO ub
        drwBtn xmax - 210, b * 60 + 90, choice$(b)
    NEXT
    oldmouse = -1
    DO
        WHILE _MOUSEINPUT: WEND
        mx = _MOUSEX: my = _MOUSEY: mb = _MOUSEBUTTON(1)
        IF mb AND oldmouse = 0 THEN
            IF mx > xmax - 210 AND mx <= xmax - 10 THEN
                FOR b = 0 TO ub
                    IF my >= b * 60 + 90 AND my <= b * 60 + 140 THEN
                        LINE (xmax - 210, 0)-(xmax, ymax), bColor, BF
                        getButtonNumberChoice% = b: EXIT FUNCTION
                    END IF
                NEXT
                BEEP
            ELSE
                BEEP
            END IF
        END IF
        oldmouse = _MOUSEBUTTON(1)
        _LIMIT 200
    LOOP
END FUNCTION
 
SUB drwBtn (x, y, s$) '200 x 50
    DIM th, tw, gray~&
    th = 16: tw = 8 * LEN(s$): gray~& = _RGB32(190, 190, 190)
    LINE (x, y)-STEP(204, 54), _RGB32(0, 0, 0), BF
    LINE (x - 2, y - 2)-STEP(201, 51), _RGB32(255, 255, 255), BF
    LINE (x, y)-STEP(200, 50), gray~&, BF
    COLOR _RGB32(0, 0, 0), gray~&
    _PRINTSTRING (x + 100 - 4 * LEN(s$), y + 17), s$
    COLOR white, bColor
END SUB
 
SUB sAppend (arr() AS STRING, addItem$)
    REDIM _PRESERVE arr(LBOUND(arr) TO UBOUND(arr) + 1) AS STRING
    arr(UBOUND(arr)) = addItem$
END SUB
 
FUNCTION ts$ (number)
    ts$ = _TRIM$(STR$(number))
END FUNCTION
 

In the zip there is a txt file included you can read out of the opening screen if shell to your txt editor works for your QB64. You don't really need it but it's there for an introduction.

Oh by the way, this is all mouse so after you see a GRIN :) button just click the screen for next round or game.

Time just flies by when I am playing this one.

Cobalt · « **Reply #11 on:** October 14, 2020, 06:47:58 pm »

not sure just how your game handles it exactly but reading the comments seems that you can use the same card twice?. In the INTV version you can't use the same card twice, so if you had 3D,3H,3C and you had 2H4H5H that 3H cant be used both as a 3-of-a-kind as well as the 4 card straight of hearts too. its one or the other. you would need the 3S as well to win that hand.

bplus · « **Reply #12 on:** October 14, 2020, 07:16:08 pm »

Quote from: Cobalt on October 14, 2020, 06:47:58 pm

not sure just how your game handles it exactly but reading the comments seems that you can use the same card twice?. In the INTV version you can't use the same card twice, so if you had 3D,3H,3C and you had 2H4H5H that 3H cant be used both as a 3-of-a-kind as well as the 4 card straight of hearts too. its one or the other. you would need the 3S as well to win that hand.

Yes I know in regular Gin Rummy you aren't allowed to use the same card in a straight and a group set. And that is what I did with the latest code for Grim Rummy variation and that is what hung me up for months trying to get that to work out.

BUT
For the "Grin" Rummy variation there was no way I could make the game play as well as it does enforcing 1 card 1 set rule. So I stuck to my old version for that written back in May. It just plays better IMHO, what can I say?
I explained some of this in the little txt file that I included in the zip and probably in notes at top of code.

Anyway, doing these Gin Rummy variations I have more fun inventing games than sticking strictly to old ways.

I am not done, a regular version of the game probably with regular card images are still in my plans for future. I sure as heck am not going to waste that hard won optimizer code by saying I am done with Gin Rummy with that older Grin Rummy variation.

Thanks for checking it out Cobalt.

Cobalt · « **Reply #13 on:** October 17, 2020, 11:46:36 pm »

I DID IT!
I DID IT!

Finally a 10 straight! Quite possibly thee hardest way to win a hand!

bplus · « **Reply #14 on:** October 18, 2020, 10:12:32 am »

Wow! That has to be more rare than Royal Flush, well I guess you can draw more cards but a sequence of 10 is something!

Cobalt is this from a game you are working on or from Intellivision's Royal Dealer?

News:

Author Topic: Gin Rummy Variations with Computer (Read 3705 times)

bplus

Gin Rummy Variations with Computer

bplus

Re: Gin Rummy Variations with Computer

johnno56

Re: Gin Rummy Variations with Computer

bplus

Re: Gin Rummy Variations with Computer

Cobalt

Re: Gin Rummy Variations with Computer

bplus

Re: Gin Rummy Variations with Computer

Cobalt

Re: Gin Rummy Variations with Computer

bplus

Re: Gin Rummy Variations with Computer

Cobalt

Re: Gin Rummy Variations with Computer

Cobalt

Re: Gin Rummy Variations with Computer

bplus

Re: Gin Rummy Variations with Computer

Cobalt

Re: Gin Rummy Variations with Computer

bplus

Re: Gin Rummy Variations with Computer

Cobalt

Re: Gin Rummy Variations with Computer

bplus

Re: Gin Rummy Variations with Computer