Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Rummage
#1
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 Sub
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, Western Australia.) Big Grin
Please visit my Website at: http://oldendayskids.blogspot.com/
Reply
#2
@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?
Reply
#3
(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.
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, Western Australia.) Big Grin
Please visit my Website at: http://oldendayskids.blogspot.com/
Reply


Possibly Related Threads…
Thread Author Replies Views Last Post
  Rummage PhilOfPerth 0 299 09-07-2025, 12:37 AM
Last Post: PhilOfPerth

Forum Jump:


Users browsing this thread: 1 Guest(s)