+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Games (https://qb64phoenix.com/forum/forumdisplay.php?fid=57)
+----- Forum: PhilofPerth (https://qb64phoenix.com/forum/forumdisplay.php?fid=66)
+----- Thread: Rummage (/showthread.php?tid=4228)
Rummage - PhilOfPerth - 12-19-2025
A game based on the card-game Rummy.
Try to form Melds (groups of tiles with the same or consecutive letters). Score points for these, with extra points for "pure" melds with all tiles of the same colour. But don't be caught with "dead" tiles at the end!
Code: (Select All)
SW = 1020: SH = 720 'screen width and screen height settings of terminal
Screen _NewImage(SW, SH, 32)
SetFont: F& = _LoadFont("C:\WINDOWS\fonts\courbd.ttf", 20, "monospace"): _Font F&
SMode = 32
Common Shared CPL, LN$, ok$, bad$, Tile$(), Name$(), NP, Plr, Hand$(), Meld$(), NumInMeld(), MeldVal(), MeldMult()
Common Shared Discard$, NextTile, NextTile$, Final, Score()
CPL = Int(SW / _PrintWidth("X")) ' characters per line (for centring and wiping text)
_ScreenMove (_DesktopWidth - SW) / 2, 90
ok$ = "o4l32cde": bad$ = "o3l32edc": Alert$ = "O4L32cegO5L8c"
Prep:
Randomize Timer
k$ = "": Final = 100
Centre "Read Intro (y/n)", 15
While k$ = ""
k$ = UCase$(InKey$)
Wend
Cls
If k$ = "N" Then GoTo setup
Instructions
setup:
_KeyClear
Centre "How many players (1 to 4, default 1) ?", 15
While np$ = "": np$ = InKey$: Wend
NP = Val(np$): If NP < 1 Or NP > 4 Then NP = 1
Wipe "15"
txt$ = Str$(NP) + " players"
Centre txt$, 15: _Delay .5: Cls
Dim Tile$(100), Name$(NP), Hand$(NP, 12), Meld$(NP, 4, 12), NumInMeld(NP, 4), MeldVal(NP, 4), MeldMult(NP, 4), Score(NP)
PrepTiles ' Tile$(100) shuffled, includes 4 Wilds
GetNames
Gotthem:
Deal
GameLoop:
Do
Play Alert$: Cls
Plr = Plr + 1: If Plr > NP Then Plr = 1 ' next player, cyclic
TotalPicked = 0 ' no picks for melds yet
SortHand: ' move empty cell to 12 for pickup
swop = 0
For a = 1 To 11 ' for each tile in this box (except last)
If Hand$(Plr, a) > Hand$(Plr, a + 1) Then
Swap Hand$(Plr, a), Hand$(Plr, a + 1) ' swap letters if later one is larger,
swop = 1 ' and flag as swapped
End If
Next
If swop = 1 Then SortHand ' if any swapped, repeat run for this box
ShowHand ' show this player's hand
ShowMelds ' show this player's melds (4 boxes)
ChoosePickUp ' pick up from Stock or from Discard cell
BuildMeld
DiscardTile
SortHand ' move tiles into cells 1 to 11, leaving 12 vacant (chr$(249))
Loop
Sub SortHand
Sort:
swop = 0
For a = 1 To 11 ' for each tile in this box (except last)
If Hand$(Plr, a) > Hand$(Plr, a + 1) Then
Swap Hand$(Plr, a), Hand$(Plr, a + 1) ' swap letters if later one is larger,
swop = 1 ' and flag as swapped
End If
Next
If swop = 1 Then GoTo Sort ' if any swapped, repeat run for this box
RefillHand: '
If NextTile >= Final Then EndGame ' if no stock left, finish game
For a = 1 To 11 ' for each of player's hand cells (except 12 which is empty
If NextTile < Final And Left$(Hand$(Plr, a), 1) > "W" Then ' if stock left and hand cell is vacant,
Hand$(Plr, a) = NextTile$ ' place next Stock tile in the cell,
NextTile = NextTile + 1: NextTile$ = Tile$(NextTile) ' increment Nexttile
If NextTile >= Final Then EndGame ' check if stock left after each fill. if not, finish game
End If
Next
End Sub
Sub PrepTiles
Letters:
For a = 0 To 11 '
For b = 1 To 8: Tile$(a * 8 + b) = Chr$(b + 64): Next ' 12 tiles with each letter "A" to "H", total 96 tiles
Next
Colours:
For a = 0 To 2 ' 3 colours
For b = 1 To 32 ' 32 groups, total 96 tiles
Tile$(a * 32 + b) = Tile$(a * 32 + b) + LTrim$(Str$(a + 1))
Next
Next
For a = 97 To 100: Tile$(a) = "W4": Next ' add 4 white "Wild" tiles
Shuffle:
For a = 1 To 100: swp = Int(Rnd * 100) + 1: Swap Tile$(a), Tile$(swp): Next
End Sub
Sub GetNames
GetaName:
Play ok$
For a = 1 To NP
Locate 14, 1: Print Space$(CPL)
Locate 14, 14: Yellow
txt$ = "Name for player " + Str$(a) + " (or Space for default name)"
Centre txt$, 15
White: Locate 16, 37: Input Name$(a)
If Name$(a) < "A" Then Name$(a) = "Anon" + Str$(a)
If Len(Name$(a)) > 7 Then Name$(a) = Left$((Name$(a)), 7)
Wipe "16"
Name$(a) = UCase$(Name$(a))
Yellow: Centre Name$(a), 16: _Delay .3: Wipe "1516"
Play ok$
Next
End Sub
Sub Deal
For a = 1 To NP: For b = 1 To 4: For C = 1 To 12
Meld$(a, b, C) = Chr$(249)
Next: Next: Next ' set all 12 cells to chr$(249)
NextTile = 0 ' start dealing from first tile
For a = 1 To NP
For b = 1 To 11
NextTile = NextTile + 1: Hand$(a, b) = Tile$(NextTile)
Next
Hand$(a, 12) = Chr$(249) + "4"
Next ' deal 11 tiles to each hand
NextTile = NextTile + 1
Discard = NextTile: Discard$ = Tile$(Discard) ' next tile goes to Discard,
NextTile = NextTile + 1: NextTile$ = Tile$(NextTile) ' and next tile becomes NextTile
Plr = Int(Rnd * NP) + 1 ' randomize first player
End Sub
Sub ShowHand
SortHand
For a = 1 To 12 ' for each tile in hand
Colr = Val(Right$(Hand$(Plr, a), 1)) ' get its colour
Select Case Colr
Case Is = 1
Red
Case Is = 2
Green
Case Is = 3
Purple
Case Is = 4
White ' white for empty and Wild tiles
End Select
Letr$ = Left$(Hand$(Plr, a), 1) ' get its letter
Locate 19, 16 + a * 4: Print Letr$ ' show the tile in correct colour and position
Next
End Sub
Sub ShowMelds
Yellow
For a = 138 To 725 Step 195: PSet (a, 477): Draw "r165d23l165u23": Next
White: For a = 1 To 4 '
Locate 23, a * 15 + 2: Print a ' show box numbers
For b = 1 To 12
ThisTile$ = Meld$(Plr, a, b) ' get each tile of this Meld box
Letr$ = Left$(ThisTile$, 1) ' get its letter
colr = Val(Right$(ThisTile$, 1)) ' get its colour number
Select Case colr ' set the colour for this tile
Case Is = 1
Red
Case Is = 2
Green
Case Is = 3
Purple
Case Is = 4
White
End Select
Locate 25, 11 + (a - 1) * 15 + b ' find its position in the box
Print Letr$
Next
Next
Yellow
End Sub
Sub SortMelds ' sort each box to place Wilds and empties at end
For a = 1 To NP
For b = 1 To 4
Sort: '
swop = 0
For c = 1 To NumInMeld(a, b) - 1 ' for each tile in this box (except last),
If Meld$(a, b, c) > Meld$(a, b, c + 1) Then
Swap Meld$(a, b, c), Meld$(a, b, c + 1) ' swap letters if later one is larger,
swop = 1 ' flag if swapped
End If
Next
If swop = 1 Then GoTo Sort ' if any swapped, repeat sort
Next
Next
End Sub
Sub ChoosePickUp
ShowChoiceBoxes: ' choose between picking up next Stock tile or Discard
Locate 12, 32: Print "Stock Discard"
Colr = Asc(Right$(Discard$, 1)) - 48 ' get colour number for Discard$ tile
Select Case Colr ' set colour for Discard tile display
Case Is = 1
Red
Case Is = 2
Green
Case Is = 3
Purple
Case Is = 4
White
End Select
Locate 14, 44: Print Left$(Discard$, 1) ' show Discard
Locate 14, 33: Print " "
White: Locate 14, 33: Print LTrim$(Str$(Final - NextTile)) ' show number of tiles left in Stock
txt$ = Name$(Plr) + " playing"
Yellow: Centre txt$, 2
PSet (408, 253): Draw "r42d30l42u30" ' draw Next box
PSet (544, 253): Draw "r42d30l42u30" ' draw Discard box
White: Locate 16, 39: Print "^" ' show cursor for choice
GetChoice:
Wipe "17": Yellow: Centre "Left or right cursor to take from Stock or from Discard", 30
k = 0
While k < 1 ' wait for key press
_Limit 30
k = _KeyHit
Wend
Select Case k
Case Is = 19200 ' left csr - pick from Stock
If NextTile >= Final Then Play bad$: GoTo GetChoice ' if no tiles left in Stock, pick again
Hand$(Plr, 12) = NextTile$ ' place Next tile in Hand$() array
NextTile = NextTile + 1 ' adjust Next tile number
NextTile$ = Tile$(NextTile)
Case Is = 19712 ' right csr - pick Discard
Hand$(Plr, 12) = Discard$ ' place Discard tile in Hand$() array (nextTile is not affected)
Case Else
GoTo GetChoice ' ignore any other key
End Select
White: Locate 14, 33: Print LTrim$(Str$(Final - NextTile)) ' update number left in stock
Locate 14, 44: Print " " ' empty Discard box
letr$ = Left$(Hand$(Plr, 12), 1) ' get letter of Discard tile
Colr = Asc(Right$(Hand$(Plr, 12), 1)) - 48 ' get colour number of Discard tile (1 to 4)
Select Case Colr ' set up colour for Discard tile display
Case Is = 1
Red
Case Is = 2
Green
Case Is = 3
Purple
Case Is = 4
White
End Select
Locate 19, 64: Print letr$ ' display pickup tile in player's hand
Play ok$
Wipe "1630"
End Sub
Sub BuildMeld
_KeyClear
Yellow: Centre "Choose from Box 1 to 4 ", 30
Centre " ?", 27
GetBox:
K$ = ""
While K$ = "": K$ = InKey$: Wend
If K$ < "1" Or K$ > "4" Then Play bad$: GoTo GetBox
BoxNum = Val(K$)
If NumInMeld(Plr, BoxNum) > 11 Then Play bad$: GoTo GetBox
Action:
Locate 25 + Int((BoxNum - 1) / 4) * 5, 12 + ((BoxNum - 1) Mod 4) * 15 + NumInMeld(Plr, BoxNum)
Print "*": Play ok$ ' mark pickup position in box
Wipe "303132": _KeyClear
Yellow: Centre "Left or Right cursor, then Space, to pick each tile", 30
Centre "or Press P to Purge (empty) the box first", 31
Centre "Enter when finished (more tiles may be added later)", 32
CsrPos = 38: Pick = 6 ' position cursor at tile 6 of hand
Meldv = 25: MeldH = 12 + ((BoxNum - 1) Mod 4) * 15
Wipe "20": Locate 20, CsrPos: Print " ^ " ' show cursor
Purged = 0 ' ready for box purge (can only be used AFTER Box selection)
Move:
Yellow
k = 0: Letr$ = ""
While k < 1: k = _KeyHit: Wend
Select Case k
Case 80, 112 ' pressed P to Purge (clear) box
If Purged = 0 Then
Locate 25, MeldH: Print " Box purged ": Sleep 1: Wipe "232425"
Purged = 1
For a = 1 To 12: Meld$(Plr, BoxNum, a) = Chr$(249) + "4": Next
NumInMeld(Plr, BoxNum) = 0
ShowMelds
GoTo Action ' only 1 purge allowed
Else
GoTo Move
End If
Case 19200 ' left csr
If CsrPos > 21 Then
CsrPos = CsrPos - 4: Pick = Pick - 1
Wipe "20": Locate 20, CsrPos: Print " ^ "
GoTo Move
Else
Play bad$: GoTo Move
End If
Case 19712 ' right csr
If CsrPos < 61 Then
CsrPos = CsrPos + 4: Pick = Pick + 1
Wipe "20": Locate 20, CsrPos: Print " ^ "
GoTo Move
Else
Play bad$: GoTo Move
End If
Case 32 ' Space - pick up tile at cursor position
Wipe "303132"
If NumInMeld(Plr, BoxNum) = 12 Then Play bad$: Exit Sub ' if the meld box is full, don't pick up
Letr$ = Left$(Hand$(Plr, Pick), 1)
If Letr$ = Chr$(249) Then ' if position is "empty", don't pick up, go back and move on
Red: Centre "Already picked!", 30
Sleep 1: Wipe "30": Play bad$: GoTo Move
End If
Colr = Val(Right$(Hand$(Plr, Pick), 1))
Select Case Colr
Case Is = 1
Red
Case Is = 2
Green
Case Is = 3
Purple
Case Is = 4
White
End Select
MeldH = 12 + ((BoxNum - 1) Mod 4) * 15
Locate Meldv, MeldH + NumInMeld(Plr, BoxNum)
Print Letr$
NumInMeld(Plr, BoxNum) = NumInMeld(Plr, BoxNum) + 1
Meld$(Plr, BoxNum, NumInMeld(Plr, BoxNum)) = Hand$(Plr, Pick)
Hand$(Plr, Pick) = Chr$(249) + "4"
Locate Meldv
Locate 19, CsrPos + 2: Print Chr$(249)
TotalPicked = TotalPicked + 1
If TotalPicked = 11 Then Exit Sub ' if only 1 left in hand, don't pick it up - needed for discard
GoTo Move
Case 13
Exit Sub
End Select
GoTo Move
End Sub
Sub DiscardTile
CsrPos = 40: Pick = 6
Yellow: Wipe "20303132": Centre "Left/right csr to move to your Discard, and press Space", 30
Locate 20, CsrPos: Print "^"
_KeyClear
MoveToTile:
k = 0
While k < 1: k = _KeyHit: Wend
Select Case k
Case Is = 19200 ' left csr
If CsrPos < 22 Then Play bad$: GoTo MoveToTile
CsrPos = CsrPos - 4
Pick = Pick - 1
Locate 20, CsrPos - 4: Print " ^ "
GoTo MoveToTile
Case Is = 19712 ' right csr
If CsrPos > 61 Then Play bad$: GoTo MoveToTile
CsrPos = CsrPos + 4
Pick = Pick + 1
Locate 20, CsrPos - 4: Print " ^ "
GoTo MoveToTile
Case Is = 32 ' space - tile above cursor will be discarded
letr$ = Left$(Hand$(Plr, Pick), 1) ' get its letter (if any)
If letr$ = Chr$(249) Then ' if no tile at this position,
Play bad$:
Red: Centre "No tile there!", 31: Sleep 1: Wipe "31"
GoTo MoveToTile ' pick another tile
End If
Discard$ = Hand$(Plr, Pick) ' place this tile in Discard box
Hand$(Plr, Pick) = Hand$(Plr, 12) ' move tile in hand array from 12 to this position, leaving 12 vacant
Hand$(Plr, 12) = Chr$(249) ' clear position 12 in hand array
If NP = 1 Then ' if single player,
Discard$ = Tile$(NextTile): NextTile = NextTile + 1 ' replace discard with new tile from stock
End If
Case Else
GoTo MoveToTile
End Select
End Sub
Sub EndGame
Play alert$
SortMelds ' sort melds to place Wilds and blanks at end
For a = 1 To NP ' for each player
Cls
Print Name$(a) ' show their name
For b = 1 To 4 ' for each of their boxes
If NumInMeld(a, b) < 3 Then GoTo BoxFinished ' if less than 3 tiles, ignore the box
Print "box"; b; " "; ' show box number
For c = 1 To 12: Print Meld$(a, b, c); " ";: Next ' show each tile in the box
CheckForSet: ' 3 or more of same letter or Wild, no other letters in box
MeldMult(a, b) = 2 ' assume it's a Set, MeldMult 2 (meldmult is code of adjusted value for melds)
For c = 2 To NumInMeld(a, b)
T$ = Left$(Meld$(a, b, c), 1)
If T$ = Chr$(249) Then Exit For ' empty cell has been reached - skip the rest of this box
If T$ <> Left$(Meld$(a, b, 1), 1) And T$ <> "W" Then ' if any letter is not same as cell 1 and is not Wild,
MeldMult(a, b) = 0 ' this is not a set; set MeldMult to 0
End If
Next
If MeldMult(a, b) = 2 Then GoTo CheckForPure ' if all same letter, it's a Set; set MeldMult to 2 and skip Runs check
CheckForRun: ' 3 or more consecutive letters, no repeats or extra letters in box
MeldMult(a, b) = 1 ' assume this is a Run, MeldMult 1
For c = 2 To NumInMeld(a, b)
If T$ = Chr$(249) Then Exit For ' empty cells are at end of meld, so when reached, stop checking
T$ = Left$(Meld$(a, b, c), 1) ' get letter
T = Asc(Left$(Meld$(a, b, c), 1)) ' get its ascii code
If T <> Asc(Meld$(a, b, c - 1), 1) + 1 And T$ <> "W" Then
MeldMult(a, b) = 0 ' if any tile not consecutive and not Wild, it's not a run; meldmult is 0
End If
Next
If MeldMult(a, b) = 0 Then GoTo BoxFinished ' if not run or set, no value - skip Pure check
CheckForPure: ' Pure means a meld with all tiles same colour
Pure = 1
For c = 2 To NumInMeld(a, b) ' check all colours same as cell 1
T$ = Left$(Meld$(a, b, c), 1)
If Right$(Meld$(a, b, c), 1) <> Right$(Meld$(a, b, 1), 1) And T$ <> "W" Then Pure = 0
Next
If Pure = 1 Then MeldMult(a, b) = MeldMult(a, b) + 2 ' if pure meld, add 2 to MeldMult (Set becomes MeldMult 4, Run MeldMult 3)
CheckForWild: ' each wild adds 4 to meldmult
For c = 1 To NumInMeld(a, b)
If Left$(Meld$(a, b, c), 1) = "W" And MeldMult(a, b) > 0 Then MeldMult(a, b) = MeldMult(a, b) + 4
Next
BoxFinished: ' jump to here when empty cell is reached
Next
Next
ShowResults:
txt$ = ""
Cls: Centre "Scores", 2
For a = 1 To NP ' for each player
Yellow: Centre Name$(a), a * 6 - 2: White
For b = 1 To 4 ' for each box
txt$ = "Box " + Str$(b)
Print Tab(17); txt$;
Print Tab(30);
If NumInMeld(a, b) > 0 Then
For c = 1 To NumInMeld(a, b) ' for each occupied cell in meld
Letr$ = Left$(Meld$(a, b, c), 1) ' get its lettr
Colr = Val(Right$(Meld$(a, b, c), 1)) ' get its colour
Select Case Colr
Case Is = 1
Red
Case Is = 2
Green
Case Is = 3
Purple
Case Is = 4
White
End Select
Print Letr$; " ";: White ' show each tile in its box
Next
Print Tab(60);
score = 0
n = NumInMeld(a, b)
Select Case MeldMult(a, b) ' adjust meld values for Pure melds and Wild tiles
Case 0 ' Junk tiles (no Meld, or a foreign tile in box)
MeldVal(a, b) = NumInMeld(a, b) * -5
Case 1 ' run (e.g. DEF) 1
MeldVal(a, b) = n * 10
Case 2 ' set (eg DDD) 2
MeldVal(a, b) = n * 12
Case 3, 5 ' pure run 3 (e.g. DEF all same colour), run + 1 wild 1+4
MeldVal(a, b) = n * 20
Case 4, 6 ' pure set 2*2 (eg DDD all same colour), pure run + 1 wild 3*2
MeldVal(a, b) = n * 24
Case 7, 13 ' pure run + 1 wild 3+4, run + 3 wild 1+4+4+4
MeldVal(a, b) = n * 40
Case 8, 14 ' pure set+ 1 wild 4+4, set + 3 wild 2+4+4+4
MeldVal(a, b) = n * 48
Case 9 ' run + 2 wild 1+4+4
MeldVal(a, b) = n * 30
Case 10 ' set + 2 wild 2+4+4
MeldVal(a, b) = n * 36
Case 11, 18 ' pure run + 2 wild 3+4+4, set + 4 wild 2+4+4+4+4
MeldVal(a, b) = n * 60
Case 12 ' pure set + 2 wild 4+4+4
MeldVal(a, b) = n * 72
Case 15 ' pure run + 3 wild 3+4+4+4
MeldVal(a, b) = n * 80
Case 16 ' pure set + 3 wild 4+4+4+4
MeldVal(a, b) = n * 96
Case 17 ' run + 4 wild 1+4+4+4+4
MeldVal(a, b) = n * 50
Case 19 ' pure run + 4 wild 3+4+4+4+4
MeldVal(a, b) = n * 100
Case 20 ' pure set + 4 wild 4+4+4+4+4
MeldVal(a, b) = n * 120
End Select
Print MeldVal(a, b) ' show value of tiles in the box
End If
Score(a) = Score(a) + MeldVal(a, b) ' total box values for player's final score
Next
White
Next
If NP = 1 Then ' no top score for 1 player
txt$ = "Well done, " + Name$(1) + ", you scored " + Str$(Score(1))
Sleep: System
End If
txt$ = ""
Print: Yellow: Centre "Final Results", 28: White
For a = 1 To NP: txt$ = txt$ + Name$(a) + ":" + Str$(Score(a)) + " ": Next
Centre txt$, 29
Findwinners:
winr = 1: txt$ = Name$(1) ' make player 1 the winner
For a = 2 To NP ' compare each player's score with player 1
If Score(a) = Score(winr) Then txt$ = txt$ + " " + Name$(a) ' if equal to winner's score, add this player to winner list
If Score(a) > Score(winr) Then ' if higher, scrap previous winners list, make this player the winner
winr = a: txt$ = Name$(a)
End If
Next ' continue to compare with the rest of player's scores
txt$ = "Congratulations, " + txt$ + ", you won!" ' display winner/s
Yellow: Centre txt$, 32
Sleep: System
End Sub
Sub Yellow
Color _RGB(255, 255, 0)
End Sub
Sub White
Color _RGB(255, 255, 255)
End Sub
Sub Red
Color _RGB(255, 0, 0)
End Sub
Sub Green
Color _RGB(0, 255, 0)
End Sub
Sub Purple
Color _RGB(255, 116, 255)
End Sub
Sub Wipe (LN$) ' LN$ is 2-digit line nums, eg "0122" is lines 1 and 22)
For a = 1 To Len(LN$) - 1 Step 2 ' get 2 digits for line to be wiped,
wl = Val(Mid$(LN$, a, 2)) ' erase that line
Locate wl, 1: Print Space$(CPL - 1);
Next
End Sub
Sub Centre (Txt$, LineNum)
ctr = Int(CPL / 2 - Len(Txt$) / 2) + 1 ' find (horiz centre - half text length) for this screen setting
Locate LineNum, ctr
Print Txt$; ' print txt$ at that position
End Sub
Sub Instructions
Cls
Play ok$
Yellow: Centre "Rummage", 2: White: Print
Print " Rummage is a game for 1 to 4 players, based on the card-game Rummy. It uses"
Print " a set of 100 ";: Yellow: Print "Tiles";: White: Print " composed of 4 of each letter A to H in 3 colours, and 4"
Print " white ";: Yellow: Print "Wild";: White: Print " Tiles that increase the value of any Meld containing them.": Print
Yellow: Print " Aim:": White
Print " Players try to form ";: Yellow: Print "Melds";: White: Print " of 3 or more tiles, which can be either ";
Yellow: Print "Sets";: White: Print " of"
Print " 3 or more tiles with the same letter, e.g. EEE, or ";
Yellow: Print "Runs";: White: Print " of consecutive"
Print " letters, e.g. DEF. Melds can be of mixed colours, but if all are the same"
Print " colour, they are called ";: Yellow: Print "Pure Melds";: White: Print ", and their value is doubled.": Print
Yellow: Print " Preparation:": White
Print " The Tiles are shuffled and players are each dealt 11 Tiles as their ";: Yellow: Print "Hand";: White: Print "."
Print " The next Tile becomes the first ";: Yellow: Print "Discard";: White: Print " and the remainder are the ";
Yellow: Print "Stock";: White: Print "."
Print: Yellow: Print " Play:": White
Print " Players take turns to draw a Tile, either from Stock or Discard, to add to"
Print " their Hand, then select Tiles to ";: Yellow: Print "Lay Down";: White
Print " in one of their 4 ";: Yellow: Print "Boxes";: White: Print " to create"
Print " or improve a Meld. They must then discard one Tile, which becomes the new"
Print " Discard, and their hand is re-filled from Stock. The next player then plays.": Print
Yellow: Print " Meld Boxes:": White
Print " Each Box can contain up to 12 Tiles, but only 1 Meld. More Tiles may be"
Print " added to Boxes later to improve Melds, and can be in any order. Tiles can"
Print " not be moved after being placed in a Box, but the Box can be ";: Yellow: Print "Purged";
White: Print ", or": Print " emptied, before laying down more tiles in it, if not completely full."
Print " If any Tile in a box is not part of its Meld at the end of the game, all"
Print " tiles in the box are ";: Yellow: Print "Junk";: White: Print ", and incur a penalty.": Print
Yellow: Print " Finish:": White
Print " When there are no Stock Tiles left, the game ends. All Boxes and scores are"
Print " displayed and for multiple players, winner (or winners) announced."
Yellow: Centre "Press a key", 34: Sleep
Cls: Centre "Rummage Terms Used", 2: Print
Print " Melds";: White: Print " are groups of 3 or more Tiles in a box, all with either the same"
Print " letter or consecutive letters, with no extra letters in the box.": Print
Yellow: Print " Runs";: White: Print " are Melds that have 3 or more ";: Yellow: Print "consecutive";: White: Print " letters."
Print " These score 10 points per Tile, so C D E F G scores 50 points.": Print
Yellow: Print " Sets";: White: Print " are Melds that have 3 or more of the ";: Yellow: Print "same";: White: Print " letter."
Print " These score 12 points per letter, so E E E E E scores 60 points.": Print
Yellow: Print " Pure Melds";: White: Print " are Melds with Tiles all of the same colour (except Wild Tiles)."
Print " The value of any Meld, either Run or Set, is doubled if Pure.": Print
Yellow: Print " Wild Tiles";: White: Print " (displayed as white W) can be used in any Box. They have no"
Print " points value of their own, but are treated as part of the Meld, with each"
Print " adding one more Tile to the size of the Meld, plus an extra copy of the"
Print " whole of that Meld. For example, a box with a Pure Set of 3 Tiles,"
Print " E E E, plus 3 Wild Tiles, would score 6 x 12 (for the 6 tile set) = 72,"
Print " which is then doubled because it's Pure, to 144, then has 3 extra copies"
Print " added, to score a total of 4 x 144 = 576 points.": Print
Yellow: Print " Discards";: White
Print " are tiles discarded by players on completion of their turn. If"
Print " there is only 1 player, the Discard is replaced by the next Stock tile.": Print
Yellow: Print " Junk Tiles";: White: Print " are ALL tiles in boxes where some Tiles are not part of a Meld."
Print " All Junk Tiles (including Wild Tiles) cost 5 points per Tile, so AAAAAD"
Print " (foreign D) and BDEFGW (missing C) both cost 30 points penalties, and"
Print " DFW (missing E) costs 15 points (Wilds can't be used to complete a Meld).": Print
Yellow: Print " Unused Tiles";: White: Print " are Tiles remaining in players' hands when the game ends."
Print " Unused Tiles are ignored, and give neither score nor penalty."
Yellow: Centre "Press a key", 33: Sleep: Cls
Centre "Notes and Strategies", 2
Centre "Maximum Scores", 4
Centre "(Each Box can hold up to 12 Tiles)", 5:: White: Print: Print
Print Tab(5); "Run of 8:"; Tab(30); "8x10 = 80 points"; Tab(56); "ABCDEFGH"
Print Tab(5); "Set of 12:"; Tab(30); "12x12 = 144 points"; Tab(56); "AAAAAAAAAAAA"
Print Tab(5); "Run of 8 + 1 Wild:"; Tab(30); "9x10x2 = 180 points"; Tab(56); "ABCDEFGHW"
Print Tab(5); "Set of 11 + 1 Wild:"; Tab(30); "12x12*2 = 288 points"; Tab(56); "AAAAAAAAAAAW"
Print Tab(5); "Run of 8 + 4 Wild:"; Tab(30); "12x10*5 = 600 points "; Tab(56); "ABCDEFGHWWWW"
Print Tab(5); "Set of 8 + 4 Wild:"; Tab(30); "12x12x5 = 720 points "; Tab(56); "AAAAAAAAWWWW"
Centre "(Each of these scores will be doubled for pure melds)", 13: Print: Print
Print Tab(5); "Keep Wild Tiles in Hand until near end of the game, then place them in"
Print Tab(5); "your highest-scoring Box (but be sure to do this before the game ends).": Print
Print Tab(5); "Never discard a Wild Tile. There is NEVER any benefit from doing so.": Print
Print Tab(5); "Use Purge if all boxes are used and a better Meld can be placed in a box,"
Print Tab(5); "or if a foreign letter is accidentally placed in a box."
Print Tab(5); "(Purge can't be used if a box is completely full)": Print
Print Tab(5); "Watch the next player's Melds and Hand, and avoid discarding a Tile that"
Print Tab(5); "will allow them to build a high-scoring Meld."
Yellow: Centre "Press a key", 32: Sleep: Cls
Cls
End SubRE: Rummage - Magdha - 12-19-2025
@PhilOfPerth
Phil, I was wondering why you use COMMON SHARED followed by DIM rather than DIM SHARED when there are no external modules.
Code: (Select All)
COMMON SHARED CPL, LN$, ok$, bad$, Tile$(), Name$(), NP, Plr, Hand$(), Meld$(), NumInMeld(), MeldVal(), MeldMult()
COMMON SHARED Discard$, NextTile, NextTile$, Final, Score()
DIM Tile$(100), Name$(NP), Hand$(NP, 12), Meld$(NP, 4, 12), NumInMeld(NP, 4), MeldVal(NP, 4), MeldMult(NP, 4), Score(NP)
DIM SHARED Tile$(100), Name$(NP), Hand$(NP, 12), Meld$(NP, 4, 12), NumInMeld(NP, 4), MeldVal(NP, 4), MeldMult(NP, 4), Score(NP)The first 2 lines and line 4 are your code, the last line is what I would do. Is there any difference?
RE: Rummage - PhilOfPerth - 12-19-2025
(12-19-2025, 11:25 AM)Magdha Wrote: @PhilOfPerth
Phil, I was wondering why you use COMMON SHARED followed by DIM rather than DIM SHARED when there are no external modules.
Code: (Select All)COMMON SHARED CPL, LN$, ok$, bad$, Tile$(), Name$(), NP, Plr, Hand$(), Meld$(), NumInMeld(), MeldVal(), MeldMult()
COMMON SHARED Discard$, NextTile, NextTile$, Final, Score()
DIM Tile$(100), Name$(NP), Hand$(NP, 12), Meld$(NP, 4, 12), NumInMeld(NP, 4), MeldVal(NP, 4), MeldMult(NP, 4), Score(NP)
DIM SHARED Tile$(100), Name$(NP), Hand$(NP, 12), Meld$(NP, 4, 12), NumInMeld(NP, 4), MeldVal(NP, 4), MeldMult(NP, 4), Score(NP)
The first 2 lines and line 4 are your code, the last line is what I would do. Is there any difference?
Yes Maghda, you're right (as usual), it should be written as you say, with Dim Shared. Just sloppy programming. Old habits are hard to break!
Thanks for the advice.