06-20-2025, 02:58 AM
One final word game before I bid adios:
In this game you are given a group of letters, plus options to add to the group, from which to form words and earn cash.
In this game you are given a group of letters, plus options to add to the group, from which to form words and earn cash.
Code: (Select All)
Common Shared CPL, Name$(), Hand$(), Plr, NP, OK$, Bad$, Pip$, Word$, Words$(), 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$ = "o1l32fedc": 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 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
Centre Name$(NP), 15: _Delay .4 ' display name briefly
Play OK$
If NP = 4 Then GoTo SetHands
Cls
GoTo GetNames
SetHands:
Cls
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), Words$(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)
yellow: Locate 9, 32: Print "FREE"; Tab(41); "Pot-Luck": white
Locate 10, 34: Print Free$; Tab(45); "?" ' show Free letter and Pot-Luck box
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
totwin = 0
ShowStatus
yellow: Locate 9, 32: Print "FREE"; Tab(41); "Pot-Luck": white
Locate 10, 34: Print Free$; Tab(45); "?" ' show Free letter and Pot-Luck box
txt$ = "Pot contains" + Str$(Remain) + " letters"
'Wipe "1215"
Centre txt$, 12
yellow: txt$ = " " + Name$(Plr) + " playing, choose..." ' announce current player
Centre txt$, 15
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
yellow: Line (372, 410)-(678, 470), , B
Locate 35, 2: 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$: If k$ = "" Then GoTo GetAction
k = Val(k$): If k < 1 Or k > 3 Then Play Bad$: 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
yellow: Line (372, 410)-(678, 470), , B
Play OK$
NextL = NextL + 1: Remain = Remain - 1
txt$ = "Pot contains" + Str$(Remain) + " letters"
Wipe "12": Centre txt$, 12
GetWord:
yellow: Locate 27, 28: Print "What is your word";: white: Input Word$
Word$ = UCase$(Word$)
If Word$ < "A" Or Len(Word$) < 1 Then
red: Centre "No word", 29: Fail = 1: passes = passes + 1
Sleep 1: 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
txt$ = L$ + " is not available to you!"
red: Centre txt$, 29 ' if a letter fails, report it, set Fail and jump to GetValue
Sleep 3
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
If Fail = 1 Then
red: Centre "This is not a word!", 29: Sleep 3 '
End If
GetValue:
TotVal = 0
For a = 1 To Len(Word$)
Win = value(Asc(Mid$(Word$, a, 1)) - 64)
TotVal = TotVal + Win ' calculate word value, call it TotWin
Next
If Fail = 1 Then
TotVal = -TotVal
red: Play Bad$
Else
yellow: Play OK$
Words$(Plr) = Words$(Plr) + Word$ + " "
End If
ShowWin: ' announce result and comment on word
txt$ = "You Earned $" + LTrim$(Str$(TotVal))
Wipe "29": Centre txt$, 30
yellow:
Select Case TotVal
Case Is = 0
Case Is < 11
Centre "That word is OK", 32
Case Is < 21
Color _RGB(0, 255, 255): Centre "Great word!", 32: yellow
Case Is > 20
Color _RGB(255, 150, 255): Centre "Brilliant!!", 32: yellow
End Select
Cash(Plr) = Cash(Plr) + TotVal
ShowStatus
Sleep 2
Wipe "273032"
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
Locate 2, 1
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)
Cash(Plr) = Cash(Plr) - 2
ShowStatus
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 ($5)", 25: _Delay 1
Centre " Press the letter to buy ", 25
ChooseLetter:
k$ = InKey$
Select Case k$
Case "A" To "Z", "a" To "z"
Hand$(Plr, 11) = UCase$(k$)
Cash(Plr) = Cash(Plr) - 5
ShowStatus
Case Else
GoTo ChooseLetter
End Select
Locate 23, 31: For a = 1 To 11: Print Hand$(Plr, a); " ";: Next
Wipe "25"
End Sub
Sub ShowStatus
Locate 2, 1
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
End Sub
Sub Done ' game ended
Play "o2l32cego3cego4c"
yellow
For a = 1 To 3
Centre "Game over - no Pot letters left!", 12: _Delay .3: Wipe "12"
Next
Cls
Locate 2, 1
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: Centre "Final Scores", 15
Centre "Adjusting scores for remaining Hand tiles", 16: white: Print
For a = 1 To NP ' deduct value of players' remaining tiles from their hand
For b = 1 To 11
If Hand$(a, b) = Chr$(249) Then GoTo skip
Cash(a) = Cash(a) - value(Asc(Hand$(a, b)) - 64)
skip:
Next
Next
Print: Sleep 2
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
For a = 1 To NP: yellow: Locate 26 + a, 20: Print Name$(a); ": ";: white: Print Tab(40); Words$(a): Next
FindWinner:
winrs$ = "": 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(Winr) Then
Winr = a: winr$ = Name$(Winr) ' if this player's cash is greater, make them Winr
End If
Next
MultipleWinners:
For a = 1 To NP
If Cash(a) = Cash(Winr) And a <> Winr Then winr$ = winr$ + " & " + Name$(a) ' in case 2 with same winning amount
Next
yellow: txt$ = "Winner: " + winr$
Centre txt$, 32
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$) ' clear 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
Centre "A word game for 1 to 4 players, requiring both strategy and word-skills.", 4: white: 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 earn 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 " If the letters form a word, they score points based on the value of its"
Print " letters. If not, they are penalised. Their Hand is then re-filled to 10"
Print " letters, using letters from the Pot, or when none left, the Free letter."
Print " When used, the Free and Pot-Luck letters are replaced from the Pot.": Print
Print " Laying down letters, without forming a word, 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. Each player's cash is reduced by"
Print " the value of tiles remaining in their Hand, and the player with the most"
Print " cash wins the game."
yellow: Centre "Press any key to start", 32
Sleep
Cls
End Sub
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, Western Australia.) 
Please visit my Website at: http://oldendayskids.blogspot.com/
Please visit my Website at: http://oldendayskids.blogspot.com/
