Yep, another Word game from Phil!

Code: (Select All)
'                                                                                        Chars Per Row is 80 , 36 rows

Common Shared CPL, Name$(), Hand$(), Plr, NP, OK$, Bad$, Pip$, Word$, Cash(), value(), Free$, Letter$(), Remain, NextL, fail

Screen _NewImage(1040, 768, 32)

SetFont: f& = _LoadFont("C:\WINDOWS\fonts\courbd.ttf", 20, "monospace"): _Font f& '      choose monospace font

CPL = 1040 / _PrintWidth("X") '                                                          chars per line used for centring text

_ScreenMove (_DesktopWidth - 1040) / 2, 100

Randomize Timer



Instructions



Dim Name$(4), Letter$(100), value(26) '                                                  allow for up to 4 names while accepting them

Bad$ = "o2l16fedc": OK$ = "o3l64ceg": Pip$ = "o4l32c"



LetterDistribution:

Data "A","A","A","A","A","A","A","A","A","B","B","B","C","C","D","D","D","D","E","E","E","E","E","E","E","E"

Data "E","F","F","F","G","G","G","H","H","H","I","I","I","I","I","I","I","I","J","K","L","L","L","L","M","M"

Data "M","M","N","N","N","N","N","N","N","O","O","O","O","O","O","O","O","P","P","Q","R","R","R","R","R","R"

Data "S","S","S","S","T","T","T","T","T","T","U","U","U","U","V","V","W","W","X","Y","Y","Z"

For a = 1 To 100: Read Letter$(a): Next



LetterValues: '                                                                          for A to Z

Data 1,3,3,2,1,4,2,4,1,8,5,1,3,1,1,3,9,1,1,1,1,4,4,8,4,9

For a = 1 To 26: Read value(a): Next



ShuffleLetters:

For a = 1 To 100

    swp = Int(Rnd * 100) + 1

    Swap Letter$(a), Letter$(swp)

Next



_KeyClear: NP = 0



GetNames:

Locate 15, 15: Print "Enter a name for player"; NP + 1; "(Enter for no more)";

Input nm$ '                                                                              get a name

If nm$ < "A" Then Cls: GoTo SetHands '                                                   no name entered for next player

If Len(nm$) > 6 Then nm$ = Left$(nm$, 6) '                                               limit name length to 8 chars

NP = NP + 1 '                                                                            ready for next name

Name$(NP) = UCase$(nm$) '                                                                change to Upper Case

Wipe "15"

Centre Name$(NP), 15: _Delay .4 '                                                        display name briefly

Play OK$

If NP = 4 Then GoTo SetHands

Cls

GoTo GetNames



SetHands:

If NP < 1 Then NP = 1: Plr = 1: Name$(Plr) = "ANON" '                                    default single player name if no names given

Dim Hand$(NP, 11), Cash(NP) '                                                            now we can Dim arrays for each player

For a = 1 To NP

    Cash(a) = 50

    For b = 1 To 10

        Hand$(a, b) = Letter$((a - 1) * 10 + b)

    Next

    Hand$(a, 11) = Chr$(249)

Next

Free$ = Letter$(NP * 10 + 1)

NextL = NP * 10 + 2

Remain = 100 - NextL

Plr = Int(Rnd * NP + 1)



PlayerGo: '                                                                              start player's turn

If passes = NP Then Done

Locate 23, 31: For a = 1 To 11: Print Hand$(Plr, a); " ";: Next '                        show new hand

Cls: Print

For a = 1 To NP

    yellow: Print Tab(17); a; Name$(a); Tab(30);

    white

    For b = 1 To 11

        Print Hand$(a, b); " ";

    Next

    yellow: Print Space$(4); "$"; LTrim$(Str$(Cash(a))): white

Next

yellow: Locate 9, 32: Print "FREE"; Tab(41); "Pot-Luck": white

Locate 10, 34: Print Free$; Tab(45); "?": yellow '                                       show Free letter and Pot-Luck box

Locate 12, 29: Print "Pot contains";: white: Print Remain;: yellow: Print "letters "

txt$ = Name$(Plr) + " playing" '                                                         announce current player

Centre txt$, 14

white '                                                                                  show options

Locate 17, 30: Print "1 Take the FREE letter"

Print Tab(30); "2 Take Pot-Luck letter ($2)"

Print Tab(30); "3 Select any letter ($5)"

yellow: Centre "Your tiles", 22: white

Print Tab(31);: For a = 1 To 11: Print Hand$(Plr, a); " ";: Next '                       show player's hand

Locate 35, 2: yellow: For a = 1 To 26: Print Chr$(a + 64); "  ";: Next

white: For a = 1 To 26: Print Using "###"; value(a);: Next '                             show letter-values



GetAction:

k$ = InKey$

k = Val(k$): If k < 1 Or k > 3 Then GoTo GetAction

Select Case k

    Case 1

        TakeFree

    Case 2

        PotLuck

    Case 3

        SelectLetter

    Case Else

End Select

NextL = NextL + 1: Remain = Remain - 1 '                                                 adjust next letter and remaining letter counts

yellow: Centre "Your tiles", 22: white

Print Tab(31);: For a = 1 To 11: Print Hand$(Plr, a); " ";: Next

Play OK$

NextL = NextL + 1: Remain = Remain - 1

If Remain < 1 Then Done

Locate 12, 29: Print "Pot contains";: white: Print Remain;: yellow: Print "letters "



GetWord:

yellow: Locate 27, 28: Print "What is your word";: white: Input Word$

Word$ = UCase$(Word$)

If Word$ < "A" Or Len(Word$) < 1 Then

    Locate 29, 47: red: Print "No word": fail = 1: white: passes = passes + 1

    Sleep 1: Wipe "29": GoTo GetValue '                                                  if no entry made, report No Word, set Fail and  jump to GetValue

End If

If passes = NP Then Done Else passes = 0



CheckLetters:



For a = 1 To Len(Word$)

    L$ = Mid$(Word$, a, 1) '                                                              get each letter from word$ (call it l$)

    fail = 1 '                                                                            assume test fails

    For b = 1 To 11 '                                                                     for each of player's hand letters (1 to 11)

        If L$ = Hand$(Plr, b) Then '                                                      compare l$ with each hand-letter

            Hand$(Plr, b) = Chr$(249)

            fail = 0

            Exit For '                                                                    if it matches, remove it, remove Fail flag, and get next letter

        End If

    Next '

    If fail = 1 Then

        Locate 29, 30: red: Print L$; " is not in your hand!" '                           if a letter fails, report bad letter, set Fail and jump to GetValue

        white: Sleep 1: Wipe "29": GoTo GetValue

    End If

Next



CheckWord:

fail = 1 '                                                                                set Found flag to fail

Open "R_ALL15" For Random As #1 Len = 19 '                                                open Random Access dictionary

FL = LOF(1) \ 19 + 1 '                                                                    get number of words in file

bot = 0: top = FL '                                                                       set range to search all words

While Abs(top - bot) > 1

    srch = Int((top + bot) / 2) '                                                         find word at mid-point of range

    Get #1, srch, a$ '                                                                    get that word (call it a$)

    a$ = UCase$(a$) '                                                                     ensure a$ is upper case

    Select Case a$

        Case Is = Word$

            fail = 0

            Exit While '                                                                  if a$ = the word, stop searching

        Case Is < Word$

            bot = srch '                                                                  if a$ is less than the word, reduce range to top half

        Case Is > Word$

            top = srch '                                                                  if a$ is greater than the word, reduce range to bottom half

    End Select

Wend '                                                                                    repeat until either range is 1 or word is found  (fail=0)

Close

Locate 29, 28

If fail = 1 Then

    red: Print Tab(33); Word$; " is Not a word!"

    white: Sleep 1: Wipe "29" '

Else

    yellow: Print Tab(37); "Good word!";

End If



GetValue:

TotWin = 0

If fail = 1 Then

    red

    Play Bad$: wordval = 0

    GoTo ShowWin

Else

    Play OK$

    For a = 1 To Len(Word$)

        Win = value(Asc(Mid$(Word$, a, 1)) - 64)

        TotWin = TotWin + Win '                                                           calculate word value, call it TotWin

    Next

End If



ShowWin:

Locate 27, 47: Print Word$

Print Tab(35); "You Earned $"; LTrim$(Str$(TotWin))

Cash(Plr) = Cash(Plr) + TotWin

Sleep 2

yellow

If Remain < Len(Word$) + 1 Then Done '                                                    if not enough tiles to refill hand and provide Free, game ends



Sort:

swp = 0

For a = 1 To 10 '                                                                         for each letter-position in hand,

    If Hand$(Plr, a) > Hand$(Plr, a + 1) Then

        Swap Hand$(Plr, a), Hand$(Plr, a + 1) '                                           if greater than next letter, swap them

        swp = 1 '                                                                         and set flag to indicate swap was made

    End If '

Next

If swp = 1 Then GoTo Sort '                                                               repeat swapping until no swaps are made



RefillHand:

For a = 1 To 10

    If Hand$(Plr, a) = Chr$(249) Then '                                                   find all chr$(249) in hand (to position 10)

        Hand$(Plr, a) = Letter$(NextL) '                                                  replace with next Pot letter

        NextL = NextL + 1: Remain = Remain - 1 '                                          adjust NextL and Remain

    End If

Next

Locate 23, 31

For a = 1 To 11: Print Hand$(Plr, a); " ";: Next '                                        show new hand

For a = 1 To NP

    yellow: Print Tab(17); a; Name$(a); Tab(30); '                                        show all hands

    white

    For b = 1 To 11

        Print Hand$(a, b); " ";

    Next

    yellow: Print Space$(4); "$"; LTrim$(Str$(Cash(a))): white

Next

Plr = Plr + 1: If Plr > NP Then Plr = 1

GoTo PlayerGo



Sub SortHand '                                                                            used letters were replaced with Chr$(249) (greater than z)

    Swapping:

    swp = 0

    For a = 1 To 10 '                                                                     for each letter-position in hand,

        If Hand$(Plr, a) > Hand$(Plr, a + 1) Then

            Swap Hand$(Plr, a), Hand$(Plr, a + 1) '                                       if greater than next letter, swap them

            swp = 1 '                                                                     and set flag to indicate swap was made

        End If '

    Next

    If swp = 1 Then GoTo Swapping '                                                       repeat swapping until no swaps are made

    For a = 1 To 10

        If Hand$(Plr, a) = Chr$(249) Then '                                               find all chr$(249) in hand (to position 10)

            Hand$(Plr, a) = Letter$(NextL) '                                              replace with next Pot letter

            NextL = NextL + 1: Remain = Remain - 1 '                                      adjust NextL and Remain

        End If

    Next

    Locate 23, 31: For a = 1 To 11: Print Hand$(Plr, a); " ";: Next '                     show new hand

End Sub



Sub TakeFree

    Play Pip$

    yellow: Centre "Taking free letter", 25: _Delay .5: Wipe "25"

    Locate 10, 34: Print " "

    Hand$(Plr, 11) = Free$

    Free$ = Letter$(NextL)

    Locate 23, 31: For a = 1 To 11: Print Hand$(Plr, a); " ";: Next

End Sub



Sub PotLuck

    If Cash(Plr) < 2 Then

        Play Bad$: red: Centre "Sorry, not enough cash", 25: white

        _Delay .5: Wipe "25"

        Exit Sub

    End If

    yellow: Play Pip$: Play Pip$

    Centre "Taking Pot-Luck", 25: _Delay .5: Wipe "25"

    Hand$(Plr, 11) = Letter$(NextL)

    Locate 23, 31: For a = 1 To 11: Print Hand$(Plr, a); " ";: Next

End Sub



Sub SelectLetter

    If Cash(Plr) < 5 Then

        Play Bad$: red: Centre "Sorry, not enough cash", 25: white

        Sleep 2: Locate 25, 30: Wipe "25"

        Exit Sub

    End If

    Play Pip$: Play Pip$: Play Pip$

    yellow: Centre "Selecting a Letter ($10)", 25: _Delay 1

    Centre " Press the letter to buy ", 25

    ChooseLetter:

    k$ = InKey$

    Select Case k$

        Case "A" To "Z"

            Hand$(Plr, 11) = k$

        Case "a" To "z"

            Hand$(Plr, 11) = UCase$(k$)

        Case Else

            GoTo ChooseLetter

    End Select

    Locate 23, 31: For a = 1 To 11: Print Hand$(Plr, a); " ";: Next

    Wipe "25"

End Sub



Sub Done '                                                                                game ended

    Play "o2l32cego3cego4c"

    yellow

    For a = 1 To 5

        Centre "Game over - no Pot letters left!", 12: _Delay .4: Wipe "12": _Delay .4

    Next

    Cls

    For a = 1 To NP

        Cls

        For b = 1 To 10

            Cash(a) = Cash(a) - value(Asc(Mid$(Word$, a, 1)) - 64) '                      reduce ech player's cash by value of their hand

        Next

    Next

    Centre "Final Scores", 10: white

    Locate 12, 1

    For a = 1 To NP

        yellow: Print Tab(20); Name$(a); Tab(30); '                                       print player's name

        white

        For b = 1 To 10

            Print Hand$(a, b); " "; '                                                     show their hand

        Next

        yellow: Print Space$(4); "$"; LTrim$(Str$(Cash(a))): white '                      show their cash

    Next

    Winr = 1 '                                                                            assume first player is Winr

    For a = 2 To NP '                                                                     compare each player's cash with Winr's cash

        If Cash(a) > Cash(a - 1) Then Winr = a '                                          if this player's cash is greater, make them Winr

    Next

    yellow: txt$ = "And the winner is " + Name$(Winr)

    Centre txt$, 17

    Sleep: System

End Sub



Sub Centre (txt$, RowNumber) '                                                            prints txt$ at centre of specified screen row number

    If RowNumber < 1 Or RowNumber > 34 Then Exit Sub

    ctr = Int(CPL / 2 - Len(txt$) / 2) + 1

    Locate RowNumber, ctr

    Print txt$

End Sub



Sub Wipe (RowNumber$) '                                                                   clears specified screen row number

    If Len(RowNumber$) = 1 Then RowNumber$ = "0" + RowNumber$ '                           catch single-digit line numbers

    For a = 1 To Len(RowNumber$) - 1 Step 2

        WL = Val(Mid$(RowNumber$, a, 2)) '                                                get 2 digit number of line to be wiped

        Locate WL, 1: Print Space$(CPL - 1); '                                            print line of spaces on the line

    Next

End Sub



Sub white

    Color _RGB(255, 255, 255)

End Sub



Sub yellow

    Color _RGB(255, 255, 0)

End Sub



Sub red

    Color _RGB(255, 0, 0)

End Sub



Sub Instructions

    yellow: Centre "LetterMart", 3: white: Print

    Print "  A word game for 1 to 4 players, requiring both strategy and word-skills.": Print

    Print "  A ";: yellow: Print "Pot";: white: Print " of 100 letters is provided, with each letter having a value of from"

    Print "  $1 to $9. Players try to build words from these letters to win cash.": Print

    Print "  At the start of the game, each player is dealt a ";: yellow: Print "Hand ";: white: Print "of 10 letters, and"

    Print "  receives ";: yellow: Print "Cash ";: white: Print "of $50. An extra letter is taken from the Pot and offered to"

    Print "  players as a ";: yellow: Print "Free";: white: Print " letter. Players take turns to try to form a word from"

    Print "  their letters, but first they must do one of three things:": Print: yellow

    Print Tab(15); "1. Take the Free card and add it to their Hand";: white: Print ", or": yellow

    Print Tab(15); "2. Buy a "; Chr$(34); "Pot-Luck"; Chr$(34); " letter, for $2";: white: Print ", or": yellow

    Print Tab(15); "3. Buy any letter of their choice, for $5": Print: white

    Print "  They then lay down one or more letters, which may or may not be a word."

    Print "  (this allows players to discard problem tiles)."

    Print "  If the letters form a word, they score points based on the value of its"

    Print "  letters. If not, no points are scored. Their Hand is then re-filled to 10"

    Print "  letters, using letters from the Pot, or when none left, the Free letter."

    Print "  When taken, the Free letter is replaced with one from the Pot": Print

    Print "  Laying down letters that are of little use may be used as a strategy for"

    Print "  removing unwanted letters or to increase chances of gaining better ones.": Print

    Print "  Words are checked for validity and must have at least 2 letters. The game"

    Print "  ends when the last Pot letter is taken. At that point, each player's cash"

    Print "  is reduced by the value of their remaining hand. The player with the most"

    Print "  cash wins the game."

    yellow: Centre "Press any key to start", 33

    Sleep

    Cls

End Sub