03-27-2025, 09:46 AM
This is my latest attempt at a word-game. It uses my Random-Access word list R_ALL15, which is attached (I hope).
It uses a text-to-speech subroutine that was posted by bplus recently.
It uses a text-to-speech subroutine that was posted by bplus recently.
Code: (Select All)
Screen _NewImage(1040, 768, 32) ' Chars Per Row is 80, 36 rows
SetFont: f& = _LoadFont("C:\WINDOWS\fonts\courbd.ttf", 20, "monospace"): _Font f&
Common Shared CPR, Name$(), NP, Score(), Words$(), Win$
CPR = 1040 / _PrintWidth("X") ' Chars Per Line used for centring text and wiping lines
_ScreenMove (_DesktopWidth - 1040) / 2, 100
Instructions
Randomize Timer
Dim Name$(4), Letter$(100), Value(27), UsedWds$(20), Hand$(20)
Bad$ = "o2l16fedc": OK$ = "o3l64ceg": Win$ = "o3l32cego4ceg"
Play Win$
StockSetup:
Data "A","A","A","A","A","A","B","B","B","C","C","C","C","D","D","D","D","E","E","E"
Data "E","E","E","E","F","F","F","G","G","G","G","H","H","H","H","I","I","I","I","I"
Data "I","J","K","K","K","L","L","L","L","M","M","M","M","N","N","N","N","N","O","O"
Data "O","O","O","P","P","P","P","Q","R","R","R","R","R","S","S","S","S","S","T","T"
Data "T","T","T","U","U","U","U","V","V","V","W","W","W","X","X","Y","Y","Y","Z","Z"
For a = 1 To 100: Read Letter$(a): Next
ShuffleLetters:
For Shuf = 1 To 3 ' shuffle 3 times, just to be sure
For a = 1 To 100
swp = Int(Rnd * 100) + 1
Swap Letter$(a), Letter$(swp)
Next
Next
First = 1
LetterValues: ' for A to Z
Data 1,5,3,3,1,6,4,4,1,9,6,2,4,2,1,4,9,1,1,1,1,7,7,8,5,8
For a = 1 To 26: Read Value(a): Next
NP = 1
GetNames:
WIPE "15"
Locate 15, 15: Print "Enter a name for player"; NP; "(Enter for no more)";
Input Name$(NP) ' get a name
If Len(Name$(NP)) < 1 Then GoTo GotThem
Name$(NP) = UCase$(Name$(NP)) ' change to Upper Case
If Len(Name$(NP)) > 7 Then Name$(NP) = Left$(Name$(NP), 7)
WIPE "15": Centre Name$(NP), 15: _Delay .5 ' display name briefly
NP = NP + 1 ' inc number of players
If NP > 4 Then NP = 5: Cls: GoTo GotThem ' limit to 4 players
GoTo GetNames
GotThem:
NP = NP - 1
If NP = 0 Then NP = 1: Name$(1) = "SOLO"
Plr = Int(Rnd * NP) + 1
Dim Score(NP), Words$(NP)
Sets = NP: set = 0 ' sets 1plr 1 2plrs 2 3plrs 3 4plrs 4
Hands = 16: If NP = 3 Then Hands = 18 ' hands 1plr 16 2plrs 16 3 plrs 18 4plrs 16
ShowUsedWords:
Show = 1
WIPE "15": Locate 15, 30: Print "Keep used letters visible (y/n)?"
While k$ = "": k$ = InKey$: Wend
If UCase$(k$) = "N" Then Show = 0
ShowValues:
Cls: yellow: Centre "Letter Values", 31
Txt$ = " "
For a = 1 To 26: Txt$ = Txt$ + Chr$(a + 64) + " ": Next
Centre Txt$, 32
Txt$ = " "
For a = 1 To 26: Txt$ = Txt$ + LTrim$(Str$(Value(a))) + " ": Next ' show letter-values
white: Centre Txt$, 33
ShowScores:
Txt$ = " "
For a = 1 To NP
Txt$ = Txt$ + " " + Name$(a) + ":" + Str$(Score(a)) + " "
Next
yellow: Centre Txt$, 2
PlayerTurn:
Hand = Hand + 1
If Hand > Hands Then Finish
Plr = Plr + 1: If Plr > NP Then Plr = 1 ' cycle players
First = (Hand - 1) * 10 - 1
If First > NP * 20 Then First = 0
For a = 1 To 10
Hand$(a) = Letter$(First + a)
Next
Locate 8, 35
For a = 1 To 10: Print Hand$(a);: Next
Txt$ = Name$(Plr) + " playing"
WIPE "0516": yellow: Centre Txt$, 5
GetWord:
yellow: Centre "Type your word", 11
Locate 13, 37: white: Input Wrd$
Wrd$ = UCase$(Wrd$)
l = Len(Wrd$)
WIPE "1113": Centre Wrd$, 13
CheckLength:
If l < 2 Then
Play Bad$: Wrd$ = "": wdval = 0: l = 0
red: Centre " Too short, or no word entered", 15
yellow: Sleep 1: GoTo GetScore
End If
NonAlphas:
For a = 1 To l
L$ = Mid$(Wrd$, a, 1)
If L$ < "A" Or L$ > "Z" Then ' if non-alpha,
Play Bad$: Wrd$ = "": wdval = 0: l = 0
red: Centre "Only letters may be used", 15
yellow: Sleep 1: GoTo GetScore
End If
Next
BadLetrs:
For a = 1 To l ' for each letter of wrd$
L$ = Mid$(Wrd$, a, 1)
Fail = 1 ' flag as failed
For b = 1 To 10 ' for each letter in hand$ L$ = Mid$(Wrd$, a, 1)
If L$ = Hand$(b) Then
Hand$(b) = " "
Fail = 0
Exit For
End If
Next
If Fail = 1 Then
Play Bad$: Wrd$ = "": wdval = 0: l = 0
red: Centre "Bad letter", 15
yellow: Sleep 2: Exit For
End If
Next
If Fail = 1 Then GoTo GetScore
CheckWord:
Found = 0 ' set Found flag to fail
Open "R_ALL15" For Random As #1 Len = 19
FL = LOF(1) \ 19 + 1 ' number of words in file
bot = 0: top = FL
While Abs(top - bot) > 1
srch = Int((top + bot) / 2)
Get #1, srch, a$
a$ = UCase$(a$)
Select Case a$
Case Is = Wrd$
Found = 1
Exit While
Case Is < Wrd$
bot = srch
Case Is > Wrd$
top = srch
End Select
Wend
Close
If Found = 0 Then
Txt$ = Wrd$ + " is not a legal word"
Play Bad$: Wrd$ = "": wdval = 0: l = 0
red: Centre Txt$, 15
yellow: Sleep 2: GoTo GetScore ' score zero
Else
Play OK$
For a = 1 To l
L$ = Mid$(Wrd$, a, 1)
wdval = wdval + a + Value(Asc(L$) - 64)
Next
End If
If UsedWds > 0 Then ' if this is not the first good word,
CheckDup: ' check if duplicate
Dup = 0
For a = 1 To UsedWds
If UsedWds$(a) = Wrd$ Then
Txt$ = Wrd$ + " has already been used"
Play Bad$: Wrd$ = ""
wdval = 0: l = 0: Dup = 1
red: Centre Txt$, 15
yellow: Sleep 2 ' score zero
Exit For
End If
Next
If Dup = 1 Then GoTo GetScore
End If
AddToLists:
UsedWds = UsedWds + 1
UsedWds$(UsedWds) = Wrd$
NumWds(Plr) = NumWds(Plr) + 1
Words$(Plr) = Words$(Plr) + Wrd$ + " "
GetScore:
If Show <> 0 Then
Locate 28, 1
For a = 1 To UsedWds: Print UsedWds$(a); " ";: Next ' show used words
End If
Close
Sleep 2
Txt$ = "Hand " + LTrim$(Str$(Hand + 1)) + " of " + LTrim$(Str$(Hands))
Centre Txt$, 18
Txt$ = "You scored" + Str$(wdval)
yellow: Centre Txt$, 16
Score(Plr) = Score(Plr) + wdval
wdval = 0
Sleep 1
WIPE "1315"
GoTo PlayerTurn
Sub Finish
Play Win$
Cls
yellow: Centre "Scores", 6: white
Txt$ = " "
For a = 1 To NP
Txt$ = Txt$ + " " + Name$(a) + ":" + Str$(Score(a)) + " "
Next
yellow: Centre Txt$, 8: white
winr = 1
For a = 2 To NP
If Score(a) > Score(winr) Then winr = a
Next
Locate 10, 1
For a = 1 To NP
Print Tab(30); Name$(a); Tab(45); Words$(a)
Next
Txt$ = "Well done, " + Name$(winr)
yellow: Centre Txt$, 15
Sleep
Run
End Sub
Sub WIPE (LN$) ' LN$ is string with 2 digits for each line to be wiped
If Len(LN$) = 1 Then LN$ = "0" + LN$ ' catch single-digit line numbers
For a = 1 To Len(LN$) - 1 Step 2
WL = Val(Mid$(LN$, a, 2)) ' get 2 digit number of lineto be wiped
Locate WL, 1: Print Space$(CPR - 1); ' print line of spaces on the line
Next
End Sub
Sub Centre (Txt$, LineNum) ' centres text on selected line
ctr = Int(CPR / 2 - Len(Txt$) / 2) + 1 ' centre is half of Chars Per Line minus half Txt$ length
Locate LineNum, ctr
Print Txt$;
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
Centre "Hear the instructions (y/n)", 12
k$ = ""
While k$ = "": k$ = InKey$: Wend
yellow: Centre "Scramble", 5
Centre "A word game for up to 4 players", 6
white: Print: Print
Print " The game uses a Stack of 100 tiles, each holding a letter with a value of"
Print " from 1 to 9 points, and these are shuffled before the game begins.": Print
Print " A Set of 10 tiles is prepared and presented to a player for their turn,"
Print " and they try to form a word (minimum 2 letters) from these tiles. Every"
Print " player plays all Sets of letters, but in a different order, and they all"
Print " have the same number of "; Chr$(34); "first bite at the cherry"; Chr$(34); " for Sets"; ".": Print
Print " Each word is checked, and if it is a real word, points are awarded for the"
Print " tiles used. If not, no points are scored (but no penalty is applied).": Print
Print " Points are also scored for the length of the word: 1 point for the first"
Print " letter, 2 points for the next, 3 for the next etc. so a 6-letter word will"
Print " score 1+2+3+4+5+6, or 21 points, plus the letter-value points.": Print
Print " Each word may only be used once - even from different Sets. At the start,"
Print " players agree on whether used words will remain visible or not during the"
Print " game. If not, memory becomes another factor in winning. Words that are"
Print " repeated score no points (but no penalty is applied).": Print
Print " The game ends when all players have played all Sets, and the player with"
Print " the most points wins."
yellow
If UCase$(k$) = "Y" Then
_KeyClear
speak ("The game uses a Stack of 100 tiles, each holding a letter with a value of from 1 to 9 points, and these are shuffled before the game begins.")
If _KeyHit >= 0 Then GoTo Done
speak ("A Set of 10 tiles is prepared and presented to a player for their turn, and they try to form a word (minimum 2 letters) from these tiles.")
speak ("Every player plays all Sets of letters, but in a differnt order, and they all have the same number of first bite at the cherry for Sets")
speak ("Each word is checked, and if it is a real word, points are awarded for the tiles used. If not, no points are scored (but no penalty is applied).")
speak ("Points are also scored for the length of the word: 1 point for the first letter, 2 points for the next, 3 for the next etc.")
speak ("So a 6-letter word will score 1+2+3+4+5+6, or 21 points, plus the letter-value points.")
speak ("Each word may only be used once - even from different Sets.")
speak ("At the start, players agree on whether used words will remain visible or not during the game.")
speak ("If not, memory becomes another factor in winning. Words that are repeated score no points (but no penalty is applied).")
speak ("The game ends when all players have played all Sets, and the player with the most points wins.")
End If
Centre "Press a key when ready", 31: Sleep
Done: Cls
End Sub
Sub speak (message As String)
Shell _Hide "Powershell -Command " + Chr$(34) + "Add-Type -AssemblyName System.Speech; (New-Object System.Speech.Synthesis.SpeechSynthesizer).Speak('" + message + "');" + Chr$(34)
End Sub
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.) 
Please visit my Website at: http://oldendayskids.blogspot.com/
Please visit my Website at: http://oldendayskids.blogspot.com/
(AND NOT the exe)
