12-17-2025, 05:20 AM
This game is based on Boggle, a dice-based word game. Rules are included.
Code: (Select All)
Common Shared CPR, Bad$, OK$, Plr, NRounds, Round, Name$(), Points, Score(), Wd$
Common Shared NumWds, Words$(), DiceLetrs$, Passes, Time, Mode, Fail, Found
SW = 1040: sh = 720
Screen _NewImage(SW, sh, 32)
SetFont: f& = _LoadFont("C:\WINDOWS\fonts\courbd.ttf", 20, "monospace"): _Font f&
CPR = SW / _PrintWidth("X")
_ScreenMove (_DesktopWidth - SW) / 2, 100
Randomize Timer
Bad$ = "w1o2l16gc": OK$ = "w1o3l64ceg"
Dim Name$(2), Score(2), Letter$(100)
Play OK$: Instructions
GetNames
GetNumRounds:
_KeyClear
Centre "How many rounds (1 to 5)?", 12
While NRounds$ = "": NRounds$ = InKey$: Wend
NRounds = Val(NRounds$): If NRounds < 1 Or NRounds > 5 Then NRounds = 2
Centre Str$(NRounds), 14: _Delay .5: WIPE "12"
Round = 0: Plr = Int(Rnd * 2) + 1
Play OK$: Cls
Data "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 "F","F","F","F","G","G","G","H","H","H","I","I","I","I","I","I","I","I","J","K","L","L","L","L","M"
Data "M","M","M","N","N","N","N","N","N","N","O","O","O","O","O","O","O","O","P","P","P","Q","R","R","R"
Data "R","R","R","S","S","S","S","T","T","T","T","T","T","U","U","U","U","V","V","W","W","X","Y","Y","Z"
Plr = Int(Rnd * 2) + 1
For a = 1 To 100: Read Letter$(a): Next
GetBoxSize:
_KeyClear
Centre "Box size (1=4 dice, 2=9 dice, 3=16 dice, 4=25 dice)?", 12 ' size 1 very quick, 4 can give very long game
While size$ = "": size$ = InKey$: Wend
Size = Val(size$): If Size < 1 Or Size > 4 Then Size = 2
Centre Str$(Size), 14
_Delay .5: Play OK$: Cls
GeMode:
_KeyClear
Centre "Mode (1: multiple use of dice, 2: single use of dice; default 1)?", 12 ' mode 2 allows more and longer words and higher scores
While Mode$ = "": Mode$ = InKey$: Wend
Mode = Val(Mode$): If Mode < 1 Or Mode > 2 Then Mode = 1
txt$ = "Multiple use of dice is allowed": If Mode = 2 Then txt$ = "Single use of dice only allowed"
Centre txt$, 14
_Delay .5: Play OK$: Cls
SetUpBox:
BoxV = 176: Row = 8
RowSize = Size + 1
NumDice = RowSize * RowSize
ReDim Dice$(RowSize, RowSize)
Colm = 36 - 3 * Size
BoxH = 492 - 40 * Size
PSet (BoxH, BoxV)
For a = 1 To RowSize
For b = 1 To RowSize
Draw "r65d60l65u60r65"
Next
nxtrow$ = "l" + Str$(65 * RowSize) + "d60"
Draw nxtrow$
Next
DrawBox:
If Round = NRounds Then EndGame
PSet (BoxH, BoxV)
Draw box$
Round = Round + 1
ShowDicePos:
For a = 1 To RowSize
For b = 1 To RowSize
Locate Row + a * 3, Colm + b * 5
Print "*"
Next
Print
Next
Shake:
Centre "Press any key to shake the Box", 31
Sleep
For a = 1 To 15: Play "v100w8l32o5t240l64c": _Delay .1: Next
_Delay .5: WIPE "31"
GetDice:
NumWds = 1: DiceLetrs$ = ""
Passes = 0
ReDim Words$(75)
For a = 1 To RowSize
For b = 1 To RowSize
Dice$(a, b) = Letter$(Int(Rnd * 100) + 1) ' get random letter for each die
DiceLetrs$ = DiceLetrs$ + Dice$(a, b)
Locate Row + a * 3, Colm + b * 5
Print Dice$(a, b)
Next
Next
AddVowel: ' ensure there is always at least 1 vowel
RV = Int(Rnd * 5) + 1
Vwl$ = Mid$("AEIOU", RV, 1)
VV = Int(Rnd * RowSize) + 1: VH = Int(Rnd * RowSize) + 1
VwlVert = 8 + VV * 3: VwlHor = Colm + VH * 5
Locate VwlVert, VwlHor: Print Vwl$ ' place in random grid position
Dice$((VwlVert - Row) / 3, (VwlHor - Colm) / 5) = Vwl$
po = (VV - 1) * RowSize + VH
DiceLetrs$ = Left$(DiceLetrs$, po - 1) + Vwl$ + Right$(DiceLetrs$, Len(DiceLetrs$) - po)
PlayerUp:
Locate 1, 2: Print Name$(1); ": "; LTrim$(Str$(Score(1)))
Locate 1, 67: Print Name$(2); ": "; LTrim$(Str$(Score(2)))
txt$ = Name$(Plr) + " Playing"
Centre txt$, 8
White: Locate 1, 23: Print "Round:"; Round; "of"; NRounds: Locate 1, 45: Print "Passes:"; Passes;: Yellow
If Passes = 2 Then Passes = 0: Cls: GoTo SetUpBox
WIPE "01"
Locate 1, 2: Print Name$(1); ": "; LTrim$(Str$(Score(1)))
Locate 1, 67: Print Name$(2); ": "; LTrim$(Str$(Score(2)))
txt$ = Name$(Plr) + " Playing"
Centre txt$, 8
If Mode = 1 Then txt$ = "(Multiple letter use)" Else txt$ = "(Single letter use)"
Centre txt$, 28
Yellow: Locate 1, 21: Print "Round:"; Round; "of"; NRounds: Locate 1, 46: Print "Passes:"; Passes;
txt$ = " Type your word"
Centre txt$, 30
Centre "?", 32
k$ = ""
t1 = Timer ' start timer
GetLetter:
k$ = ""
_KeyClear
While k$ = ""
k$ = InKey$
Time = Int(Timer - t1)
If Time > 15 Then Red
Locate 6, 36: Print "Time:"; Str$(15 - Time); " "
Yellow
Wend
k$ = UCase$(k$)
If k$ = Chr$(13) Then ' pass, or no word submitted
CheckWord
Sleep 1 ' check length, letters, dup words and legal word
Result
Wd$ = "": GoTo PlayerUp
ElseIf k$ < "A" Or k$ > "Z" Then GoTo GetLetter
End If
l$ = UCase$(k$)
Wd$ = Wd$ + l$
Centre Wd$, 32
GoTo GetLetter
Sub CheckWord
Fail = 0
Length:
If Len(Wd$) < 2 Then
WIPE "30": Red: Centre "Word too short, or passed", 30: Yellow
Passes = Passes + 1
Fail = 1: Exit Sub ' too short (or passed) set Fail flag, stop checking
End If
ValidLetters:
For a = 1 To Len(Wd$)
L$ = Mid$(Wd$, a, 1)
Po = InStr(DiceLetrs$, L$)
If Po = 0 Then ' letter is not found, set fail flag, stop checking
Fail = 1
txt$ = "Illegal letter (" + Mid$(Wd$, a, 1) + ")"
WIPE "30": Red: Centre txt$, 30: Sleep 2: WIPE "30": Yellow
Wd$ = LCase$(Wd$)
Exit For
End If
If Mode = 2 Then Mid$(DiceLetrs$, Po, 1) = LCase$(Mid$(DiceLetrs$, Po, 1))
Next '
DiceLetrs$ = UCase$(DiceLetrs$) ' all letters valid, back to Upper-case for next check
If Fail = 1 Then Exit Sub
DupWord:
For a = 1 To NumWds
If Wd$ = Words$(a) Then
WIPE "30": Red: Centre "This word has already been used in this round", 30: Yellow
Fail = 1 ' this word is already in the list, set fail flag, stop checking
End If
Next
LegalWord::
Found = 0
Open "R_ALL15" For Random As #1 Len = 19 ' random-access word list, up to 15 letters
FL = LOF(1) \ 19 + 1 ' get length of file
bot = 0: top = FL ' set bottom as 0 and top as FileLength for search area
While Abs(top - bot) > 1
srch = Int((top + bot) / 2)
Get #1, srch, A$ ' get middle word of search area
Select Case A$
Case Is = Wd$
Found = 1: Exit While ' word matched, set Found flag, stop searching
Case Is < Wd$
bot = srch ' word-list word lower is too low, move bottom up to middle
Case Is > Wd$
top = srch ' word-list word is too high move top to middle
End Select
Wend ' repeat until gap is 1 or word is found
Close
If Found = 0 Then
WIPE "30": Red: Centre "Your word was not found in the Dictionary", 30: Yellow
Fail = 1 ' we didn't find the word, set fail flag
End If
Sleep 1: WIPE "30"
End Sub
Sub Result:
LetrPoints = 0 ' start with no points
TimeCredit = 15 - Time ' credits (or debits) due for unused time
For a = 1 To Len(Wd$): LetrPoints = LetrPoints + a: Next ' get letter-points value
If Fail = 1 Then
Play Bad$: LetrPoints = -LetrPoints ' if word failed, letter-points will be deducted
Else
Play OK$
End If
If Fail = 1 And TimeCredit > 0 Then TimeCredit = 0 ' if word failed, no credits for unused time
Points = LetrPoints + TimeCredit ' add time credits to points (negative for excess time)
Score(Plr) = Score(Plr) + Points
Announce:
txt$ = "Letter value: " + Str$(LetrPoints) + " points"
Yellow: Centre txt$, 30
txt$ = "Time adustment: " + Str$(TimeCredit) + " points"
Centre txt$, 31
txt$ = "Result:" + Str$(Points) + " points"
Centre txt$, 32
Sleep 1
If Fail = 1 Then Wd$ = LCase$(Wd$) ' change failed words to lower-case for display
NumWds = NumWds + 1: Words$(NumWds) = Wd$ ' add to found-words list (whether good or bad)
For a = 0 To 4
Locate a + 2, 1
For b = 1 To 10 ' show 10 words per row
If Words$(a * 10 + b) > "Z" Then Red Else White ' if word is lower-case, show in red, otherwise white
Print " "; Words$(a * 10 + b);
Next
Next
Locate 1, 49: Print "Passes:"; Passes
If Plr = 1 Then Plr = 2 Else Plr = 1 ' next player
WIPE "303132": Wd$ = ""
End Sub
Sub EndGame
Cls
Play OK$
Yellow: Centre "Game Finished", 10: Sleep 1
Cls: Centre "Final Scores", 12: White
Print: Print Tab(33); Name$(1); Tab(46); Score(1)
Print: Print Tab(33); Name$(2); Tab(46); Score(2)
Winr = 1 ' assume player 1 is winner
If Score(2) > Score(1) Then Winr = 2 ' if player 2 score higher, change winner to player 2
txt$ = "Congratulations, " + Name$(Winr)
If Score(2) = Score(1) Then txt$ = "A drawn game!"
Yellow: Centre txt$, 18: Sleep: System
End Sub
Sub Centre (txt$, linenum) ' centre Txt$ on Line Number
ctr = Int(CPR / 2 - Len(txt$) / 2) + 1
Locate linenum, ctr
Print txt$
End Sub
Sub WIPE (ln$)
If Len(ln$) = 1 Then ln$ = "0" + ln$
For a = 1 To Len(ln$) - 1 Step 2
wl = Val(Mid$(ln$, a, 2))
Locate wl, 1: Print Space$(CPR); ' print line of spaces on Line WL (2 digit line numbers)
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 GetNames:
_KeyClear
For a = 1 To 2
Nm:
Locate 14, 18
Yellow: Print "Name for player"; a; "(or just <ENTER> to finish) ";
Input Name$(a)
Name$(a) = UCase$(Name$(a))
If Name$(a) < "A" Then Name$(a) = "PLAYER" + Str$(a)
If Len(Name$(a)) > 8 Then Name$(a) = Left$(Name$(a), 8)
Centre Name$(a), 16
Play OK$
WIPE "1416"
Next
End Sub
Sub Instructions:
Yellow: Centre "Bogglish", 5: White: Print
Print " Bogglish is a game for 2 players, loosely based around the dice game of"
Print " Boggle. It uses 9, 16, 25 or 36 virtual dice. Players take turns to form"
Print " words from the letters revealed when the dice are shaken.": Print
Print " Before the game starts, players select how many dice to use, and how many"
Print " rounds will be played. Each round is started by shaking the box containing"
Print " the dice, and players then take turns to find words of two or more letters"
Print " that they can form using the revealed letters. Points are earned for valid"
Print " words, or lost for invalid ones, based on their length.": Print
Print " Points can also be earned or lost depending on the time spent entering the"
Print " word, with 15 seconds of free time before a time penalty of 1 point per"
Print " second is applied. Unused time earns credits, but only on valid words.": Print
Print " There are two modes of play. In Mode 1, dice can only be used once in a word"
Print " while in Mode 2, they can be re-used any number of times. Words can not be"
Print " repeated in the same round. If a player can't find a new word they may pass,"
Print " but continue to play, and can submit words they find later.": Print
Print " When both players pass consecutively, that round ends and the next round is"
Print " started. The game ends after the agreed number of rounds have been played."
Yellow: Centre "Press any key to start", 29
Sleep: Play OK$: 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/