+- 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: Last one - honest! (/showthread.php?tid=3758)
Last one - honest! - PhilOfPerth - 06-20-2025
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.
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 SubRE: Last one - honest! - NakedApe - 06-20-2025
Questions, Phil:
Why is this your "last one" and why are you bidding us adios?
Where's the "R_ALL15" file with all the words? I played a round of the game, but all my words (bang, mood, they) were not "real words." I play Wordle regularly and this game seems like it could be cool!
RE: Last one - honest! - PhilOfPerth - 06-20-2025
(06-20-2025, 03:21 AM)NakedApe Wrote: Questions, Phil:
Why is this your "last one" and why are you bidding us adios?
Where's the "R_ALL15" file with all the words? I played a round of the game, but all my words (bang, mood, they) were not "real words." I play Wordle regularly and this game seems like it could be cool!
Sorry, forgot to include the word-file. Attached below (I hope).
Also, found anerror in the code; Here's the corrected one:
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 win cash based on the value of its letters."
Print " If not, they are penalised. Their Hand is then re-filled to 10 letters,"
Print " using letters from the Pot, or when none left, the Free letter. When used,"
Print " the Free and Pot-Luck letters are replaced from the Pot.": Print
Print " Laying down letters, without forming a word can be a good strategy for"
Print " removing unwanted letters or increasing the chance 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