_TITLE "Grim Rummy" 'b+ started 2020-04-26 post 2020-05-04 wo dev notes
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 pCardsOffsetY
= 288 ' now in pixels ' for current and future card images
CONST black
= &HFF000000, white
= &HFFFFFFFF, bColor
= &HFF220606 'some colors
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 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 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"
setupGame 'create deck, human is first up
restart:
resetRound
IF turn$
= "p" THEN 'player's turn clicked = getButtonNumberChoice%(pick$())
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$
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$())
CASE 1: laydown
= 1 ' Gin CASE 2: laydown
= 2 ' Knock CASE 3: turn$
= "c" ' pass 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."
laydown = 3
laydown = 4
turn$ = "p"
ELSE 'computer kept discard discard$ = card$
updateStatus
yCP messageY, "Computer kept Discard and discarded another."
laydown = 3
laydown = 4
turn$ = "p"
skip:
' if players points exceed 100 after laydown results they win
showComputerHand = 1 'to show computer hand
message$ = "Human lost 10 points calling Gin and not having it."
pScore = pScore - 10
message$ = "Human: 25 points Gin + " + ts$(cDeadPts) + " Computer's Deadwood."
pScore = pScore + 25 + cDeadPts
turn$ = "c"
CASE 2, 4 ' human knock or computer 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"
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"
message$ = "A Knockout tie! no score was advanced this round." 'turn is whatever it was
message$ = "Computer: 25 points Gin + " + ts$(pDeadPts) + " Human's deadwood."
cScore = cScore + 25 + pDeadPts: turn$ = "p"
message$ = "The deck has < 2 cards, this round is Null!" ' turn is same as was
updateStatus
IF cScore
>= 100 OR pScore
>= 100 THEN message$
= message$
+ " Winner!" yCP messageY, message$ + " press any..."
IF INSTR(message$
, "Winner!") THEN pScore
= 0: cScore
= 0
SUB setupGame
'Intro to this version, create deck of cards, set turn to human 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 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 deck$
(0) = "" THEN 'create deck 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
turn$ = "p" 'player always starts game
ERASE p$
, c$
'clear hands and rest the other globals pDeadPts = 0: cDeadPts = 0: laydown = 0: showComputerHand = 0 '< 1 for debug or cheating
deckPointer = 0 'deal some cards out
addCard p$(), dealCard$
addCard c$(), dealCard$
discard$ = deck$(deckPointer): deckPointer = deckPointer + 1 'set first discard$
updateStatus
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 yCP deckY, "Cards remaining: " + ts$(52 - deckPointer) + " Discard: "
yCP deckY + 128, "Human: " + ts$(pScore) + " Computer: " + ts$(cScore)
SUB show
(player$
) 'players hand is displayed 5 lines above bottom of screen in 4 lines _PRINTSTRING (c
* 40 + cardOffsetX
, r
* 16 + pCardsOffsetY
), " " _PRINTSTRING (c
* 40 + cardOffsetX
, r
* 16 + pCardsOffsetY
), p$
(c
, r
)
_PRINTSTRING (c
* 40 + cardOffsetX
, r
* 16 + cCardsOffsetY
), " " _PRINTSTRING (c
* 40 + cardOffsetX
, r
* 16 + cCardsOffsetY
), c$
(c
, r
) COLOR &HFFCCDD00 'dark brown sort a like deadwood? pDeadPts = deadwood(p$(), d$)
yCP
80 + pCardsOffsetY
, ts$
(LEN(d$
) \
5) + " Deadwood Cards = " + ts$
(pDeadPts
) + " points" cDeadPts = deadwood(c$(), d$)
yCP
80 + cCardsOffsetY
, ts$
(LEN(d$
) \
5) + " Deadwood Cards = " + ts$
(cDeadPts
) + " points"
'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
mCol
= INT((_MOUSEX - cardOffsetX
) / (cardW
+ 8) + .25) 'LOCATE 13, 2: PRINT mCol, mRow
oldMouse = mb
'computer gets card and discards through this AI
SUB cardDiscard
(card$
) 'for AI DIM ci
, r
, c
, low
, d$
, saveI
, i
ci = 1
IF c$
(c
, r
) <> "" THEN cds$
(ci
) = c$
(c
, r
): ci
= ci
+ 1 cds$(11) = card$
low = 200
dw(11) = deadwood(c$(), d$)
IF dw
(11) < low
THEN saveI
= 11: low
= dw
(11) addCard c$(), card$
removeCard c$(), cds$(i)
dw(i) = deadwood(c$(), d$)
IF dw
(i
) < low
THEN saveI
= i: low
= dw
(i
) addCard c$(), cds$(i)
' 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
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
cDeadPts = deadwood(c$(), d$)
' 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.
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
c = c + 1
cStart = c
c = c + 1
set$ = ""
set$ = set$ + a$(ci, r)
sAppend sSets$(), set$
FOR c
= 0 TO 12 ' now for the groups count = 0
IF a$
(c
, ci
) <> "" THEN count
= count
+ 1 set$ = ""
IF a$
(c
, ci
) <> "" THEN set$
= set$
+ a$
(c
, ci
) sAppend gSets$(), set$
' now it's time to calculate the deadwood number ======================================
REDIM cards$
(0) '<<< why is this at 11? hack fix for cardDiscard call IF a$
(c
, r
) <> "" THEN sAppend cards$
(), a$
(c
, r
) nsCards
= LEN(sSets$
(si
)) / 4 IF cards$
(n
) = MID$(sSets$
(si
), cardI
* 4 - 3, 4) THEN cards$
(n
) = "" ngCards
= LEN(gSets$
(gi
)) / 4 IF cards$
(n
) = MID$(gSets$
(gi
), cardI
* 4 - 3, 4) THEN cards$
(n
) = "" 'ok melded cards cleaned out
dead$ = "": count = 0
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 deadwood = count
dealCard$ = deck$(deckPointer): deckPointer = deckPointer + 1
SUB addCard
(a$
(), card$
) 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$
SUB removeCard
(a$
(), card$
) 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) = ""
'modified for this app
SUB yCP
(y
, s$
) 'for xmax pixel wide graphics screen Center Print at pixel y row
'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
drwBtn xmax - 210, b * 60 + 90, choice$(b)
oldmouse = -1
IF my
>= b
* 60 + 90 AND my
<= b
* 60 + 140 THEN LINE (xmax
- 210, 0)-(xmax
, ymax
), bColor
, BF
SUB drwBtn
(x
, y
, s$
) '200 x 50 th
= 16: tw
= 8 * LEN(s$
): gray~&
= _RGB32(190, 190, 190)