09-15-2025, 01:07 AM
(This post was last modified: 09-15-2025, 05:06 AM by PhilOfPerth.)
This is a re-make of a game I submitted a couple of years ago. It's a variant of the Word-Search genre, but a bit more dynamic.
It received no reponse then so I guess it won't get much now either, but the remake was a good exercise anyway.
It might appeal to some word-game enthusiasts, but as mouse-keys were not practical this may be off-putting.
Anyway, here it is:
It received no reponse then so I guess it won't get much now either, but the remake was a good exercise anyway.
It might appeal to some word-game enthusiasts, but as mouse-keys were not practical this may be off-putting.
Anyway, here it is:
Code: (Select All)
Common Shared CPL ' Chars Per Line
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
lhs = (_DesktopWidth - CPL) / 2
_ScreenMove (_DesktopWidth - 1040) / 2, 100 '
Randomize Timer
Common Shared Words$(), Tiles$(), Names$(), Plr, Delay, Letrs$(), Scores(), ThisWord$, T0, T1, T2, Best$()
Common Shared WinScore, WinScore$, OK$, Bad$, Value, Bonus, Speed, TileNum, CsrV, CsrH, NP, WordVal, TimePenalty
Data "A","A","A","A","A","B","B","B","C","C","C","D","D","D","D","E","E","E","E","E","F","F","F","F","G","G","G","H","H","H"
Data "I","I","I","I","I","I","J","J","K","K","L","L","L","M","M","M","M","N","N","N","N","O","O","O","O","P","P","P","Q","Q"
Data "R","R","R","R","S","S","S","S","T","T","T","T","T","T","U","U","U","V","V","V","W","W","W","X","X","Y","Y","Y","Z","Z"
Dim Tiles$(90), Names$(2), Scores(2), Words$(2), Letrs$(90), Best$(5, 2)
GameSettings:
Bad$ = "o2l16gc": OK$ = "o3l64ceg"
WinScore = 200: Speed = 10: Delay = .28 ' delay will change with speed adjustment by player
SetUpBestfile:
If Not _FileExists("ripbest") Then
Open "ripbest" For Output As #1
For a = 1 To 5: Best$(a, 1) = "ANON": Best$(a, 2) = Str$(600 + 60 * a)
Write #1, Best$(a, 1), Best$(a, 2)
Next
Close
End If
SetLetterArray:
For a = 1 To 90: Read Letrs$(a): Next ' (replaces alphabet to increaase common letter use)
SetNewGrid:
For a = 0 To 9 ' 10 rows
For b = 1 To 9 ' 9 chars per row
Tiles$(a * 9 + b) = Letrs$(a * 9 + b) ' first 90 letters
Next
Next
Intro:
Play OK$
yellow: centre "RIPPLE", 12: white
centre "A dynamic word-search game for one or two players", 14
Sleep 3
instructions
NP = 0
GetNames:
If NP = 2 Then GoTo GotPlrs
NP = NP + 1
_KeyClear
yellow
Txt$ = "Name of player" + Str$(NP)
centre Txt$, 14
Locate 14, 50: Input Names$(NP)
If Names$(NP) = "" Then NP = 1: GoTo GotPlrs
If Names$(NP) = "" Then GoTo GotPlrs
Names$(NP) = UCase$(Names$(NP))
If Len(Names$(NP)) > 9 Then Names$(NP) = Left$(Names$(NP), 9) ' limit names to 9 characters
WIPE "14": centre Names$(NP), 14
Play OK$: _Delay .5: WIPE "14"
GoTo GetNames
GotPlrs:
WIPE "14"
If Names$(1) = "" Then
Names$(1) = "PLAYER"
End If
centre "Welcome,", 12: white
centre Names$(1), 14: centre Names$(2), 15
SinglePlayer:
If NP = 1 Then
yellow: Print: centre "Previous fastest single-players", 20: white: Print
Open "ripbest" For Input As #1
For a = 1 To 5
Input #1, Best$(a, 1), Best$(a, 2)
Print Tab(30); Best$(a, 1); Tab(40); Best$(a, 2); " seconds"
Next
Close
centre "Would you like to reset the Best Scores chart (y/n)", 28
While k$ = ""
k$ = UCase$(InKey$)
If k$ = "Y" Then Kill "ripbest": Cls: Run
Wend
End If
Cls
SetUpGame:
yellow: Print " Target SCORE:"; WinScore; Tab(32);
If NP = 1 Then Print "SINGLE PLAYER MODE"; Else Print "TWO PLAYER MODE";
Print Tab(71); "SPEED:";: Print Using "##"; Speed: white
Sleep 1
FreshGrid:
Shuffle:
For a = 1 To 90
swp = Int(Rnd * 90) + 1
Swap Letrs$(a), Letrs$(swp)
Next ' now have 90 shuffled letters
CsrV = 7: CsrH = 25 ' grid starts at row 7, column 25
For a = 0 To 9 ' 10 rows
For b = 1 To 9 ' 9 chars per row
Tiles$(a * 9 + b) = Letrs$(a * 9 + b) ' first 90 letters
Locate a * 2 + CsrV, b * 3 + CsrH ' find screen position for this tile
Print Tiles$(a * 9 + b); " "; ' display it
Next
Next
yellow: PSet (340, 110): Draw "r350d400l350u400": white
CsrV = 7: CsrH = 28: TileNum = 1 ' put cursor at tile 1 position ready for ripple start
Txt$ = Names$(1) + " left-shift " + "to claim a word " + Names$(2) + " right-shift"
If NP = 1 Then Txt$ = "Left-shift " + "to claim a word"
Locate 29, 1: Print Space$(CPL)
yellow: centre Txt$, 29
TileNum = 1: T0 = Timer ' game start time, used for single-player total time
Ripple:
centre "(+/- to change speed)", 33
_KeyClear: k = 0
tile$ = Letrs$(Int(Rnd * 90) + 1) ' pick a random tile from tile set
Tiles$(TileNum) = tile$ ' store it in array
Locate CsrV, CsrH: red: Print tile$ ' display it in red at cursor point
_Delay Delay ' show for a short time
Locate CsrV, CsrH: white: Print tile$ ' change to white
k = _KeyHit ' look for key- press
If k = 27 Then System ' Esc to quit game
If k > 1 Then
GoTo KeyHit ' any other key pressed jump to KeyHit
Else ' otherwise,
TileNum = TileNum + 1 ' change the tile number to the next tile
If TileNum > 90 Then TileNum = 1 ' cycle the ripple through the 90 tiles
CsrH = CsrH + 3 ' get horizontal position for new tile (3 columns wide)
If CsrH > 54 Then
CsrH = 28: CsrV = CsrV + 2 ' if past end of row, change to start of next row (2 rows deep)
Bonus = Bonus + 1 ' and add bonus point,
Txt$ = "Bonus:" + Str$(Bonus)
WIPE "32"
yellow: centre Txt$, 32
Play "o4l32c"
If CsrV > 26 Then
CsrV = 7
TileNum = 1 ' if past last row, change to first row and reset to tile 1,
End If
_Delay Delay ' pause for delay time set by Speed setting,
End If
GoTo Ripple ' and return for next new tile
End If
KeyHit: ' (key may be +/- for speed change, or a Shift key)
Select Case k
Case Is = 45 ' - to reduce speed
If Speed < 2 Then ' if min speed (1) already reached, ignore
GoTo Ripple
Else
Speed = Speed - 1 ' otherwise reduce speed number and increase Delay time
Delay = Delay + .025 '
Locate 1, 77: Print Using "##"; Speed
GoTo Ripple ' get next action
End If
Case Is = 61
If Speed > 19 Then
GoTo Ripple ' if max speed (20) already reached , ignore
Else
Speed = Speed + 1
Delay = Delay - .025 ' otherwise reduce increase speed number and reduce Delay time
Locate 1, 77: Print Using "##"; Speed
GoTo Ripple ' get next action
End If
Case Is = 100303, 100304 ' right-shift for player 1 claim
WordVal = 0
If k = 100303 Then Plr = 2 Else Plr = 1 ' identify as player 2
If NP = 1 Then Plr = 1 ' but if single-player game, change to player 1
ClaimWord ' deal with word-claim
GoTo FreshGrid ' and continue ripple
End Select
GoTo Ripple
' -------------------------------------------------------------------------------- Subs ------------------------------------------------------------------
Sub ClaimWord
WIPE "29"
pickup = 0: white: centre "Letter-pickup is Off ", 5 ' new claim, start with letter-pickup off
PlaceCursor:
Play OK$
ThisWord$ = "" ' clear ThisWord$ for start of new word
CsrV = 27: CsrH = 40: Tile$ = " " ' place cursor below centre of grid
TileNum = 95 ' set tile number to middle below grid
oldtile$ = " " ' haven't picked a tile yet
yellow: Locate 27, CsrH: Print "*" ' show cursor below grid
centre Names$(Plr), 29
centre "Use Numeric keypad to move to the Start of your word", 30 ' invite move to first letters of word
centre "Press Space to start/end selecting letters for your word", 31 ' prompt for start/stop letter pickup
WIPE "33"
_KeyClear
T1 = Timer ' start timing this word
Move:
k = _KeyHit ' Space, or keypad keys 49 to 57 - 58 (0) not used
_Limit 30
If k < 1 Then GoTo Move ' wait for key press
Select Case k
Case 56 ' 8, up
If CsrV < 8 Then GoTo Move ' ignore if top limit of grid
Locate CsrV, CsrH: white: Print Tile$ ' repaint current tile white (tile$ is Space for first step)
CsrV = CsrV - 2: TileNum = TileNum - 9 ' cursor vertical -2, tile number -9 (-1 row)
Tile$ = Tiles$(TileNum) ' identify the tile
Case Is = 55 ' 7, up-left
If CsrV < 8 Or CsrH < 31 Then GoTo Move ' ignore if left limit or top limit
Locate CsrV, CsrH: white: Print Tile$ ' repaint current tile white
CsrV = CsrV - 2: CsrH = CsrH - 3: TileNum = TileNum - 10 ' cursor vertical -2, horiz -3, tile number -8 (-1 row -1)
Tile$ = Tiles$(TileNum) ' identify the tile
Case 57 ' 9, up-right
If CsrV < 8 Or CsrH > 49 Then GoTo Move
Locate CsrV, CsrH: white: Print Tile$
CsrV = CsrV - 2: CsrH = CsrH + 3: TileNum = TileNum - 8
Tile$ = Tiles$(TileNum)
Case Is = 52 ' 4, left
If CsrH < 31 Then GoTo Move
Locate CsrV, CsrH: white: Print Tile$
CsrH = CsrH - 3: TileNum = TileNum - 1
Tile$ = Tiles$(TileNum)
Case Is = 54 ' 6, right
If CsrH > 49 Then GoTo Move
Locate CsrV, CsrH: white: Print Tile$
CsrH = CsrH + 3: TileNum = TileNum + 1
Tile$ = Tiles$(TileNum)
Case Is = 50 ' 2, down
If CsrV > 24 Then GoTo Move
Locate CsrV, CsrH: white: Print Tile$
CsrV = CsrV + 2: TileNum = TileNum + 9
Tile$ = Tiles$(TileNum)
Case Is = 49 ' 1, down left
If CsrV > 24 Or CsrH < 31 Then GoTo Move
Locate CsrV, CsrH: white: Print Tile$
CsrV = CsrV + 2: CsrH = CsrH - 3: TileNum = TileNum + 8
Tile$ = Tiles$(TileNum)
Case Is = 51 ' 3, down right
If CsrV > 24 Or CsrH > 49 Then GoTo Move
Locate CsrV, CsrH: white: Print Tile$
CsrV = CsrV + 2: CsrH = CsrH + 3: TileNum = TileNum + 10
Tile$ = Tiles$(TileNum)
Case Is = 53 ' 5, repeat letter under the cursor
If pickup = 0 Then Play Bad$: GoTo Move ' if pickup not active, ignore
white: Locate CsrV, CsrH: Print Tile$: _Delay .2: Locate CsrV, CsrH: red: Print Tile$ ' flash this tile
Case Is = 32 ' Space, toggle pickup on/off
If CsrV = 27 Then GoTo Move ' if still outside the grid, ignore
WIPE "05"
If pickup = 0 Then
pickup = 1 ' if pickup is off, turn it on,
Locate CsrV, CsrH
white: Locate CsrV, CsrH: Print Tile$: _Delay .2: Locate CsrV, CsrH: red: Print Tile$ ' flash this tile,
centre "Letter-pickup is ON ", 5 ' advise pickup turned on
Else
pickup = 0 ' but if pickup is on, turn it off,
T2 = Timer ' get finish time for word entry
WIPE "05"
Evaluate ' evaluate the word
Exit Sub
End If
Case Else
Play Bad$
GoTo Move
End Select
red: Locate CsrV, CsrH: Print Tile$ ' show the current tile in red
If pickup = 1 Then
ThisWord$ = ThisWord$ + Tile$ ' if pickup active, add this tile to picked tiles string,
WordVal = WordVal + Len(ThisWord$) ' inc value by length of word$
yellow: centre ThisWord$, 27
centre Str$(WordVal), 28
End If
GoTo Move
End Sub
Sub Evaluate ' good words score wordval+runbonus-timepenalty
Value = 0 ' initialise word value
WordTime = Int(T2 - T1) ' get time taken in entering word
OverTime = WordTime - 5 - Len(ThisWord$) ' allow 5 seconds free, and 1 second per letter
If OverTime < 0 Then OverTime = 0 ' no bonus for quick entry
Checkdictionary:
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 = ThisWord$
Found = 1
Exit While
Case Is < ThisWord$
bot = srch
Case Is > ThisWord$
top = srch
End Select
Wend
Close
txt$ = "Word value" + Str$(WordVal) + " Run-Bonus:" + Str$(Bonus) + " Time penalty:" + Str$(OverTime)
centre txt$, 2
If Found = 0 Then
Play Bad$
txt$ = "The word is not accepted"
red: centre txt$, 4
Scores(Plr) = Scores(Plr) - WordVal - Bonus - OverTime ' basic value subtracted for fail
Else
Play OK$
txt$ = "The word is accepted "
yellow:: centre txt$, 4
Words$(Plr) = Words$(Plr) + " " + ThisWord$
Scores(Plr) = Scores(Plr) + WordVal + Bonus - OverTime ' basic value added for accepted word
End If
If Scores(1) >= WinScore Or Scores(2) >= WinScore Then
Winner ' if win score is reached, game ends, jump to Winner sub
Else ' but if winscore is not reached,
Bonus = 0
pickup = 0 ' reset bonus and turn off pickup
End If
Sleep 2
yellow
WIPE "0203042734"
yellow: Locate 3, 5: Print Names$(1); ": ";: white: Print Scores(1);
If NP = 2 Then yellow: Locate 3, 65: Print Names$(2); ": ";: white: Print Scores(2)
WIPE "272829"
Sleep 2
End Sub
Sub Winner
GameTime = Int(T2 - T0)
Sleep 2: Cls
Txt$ = Names$(1) + " scored" + Str$(Scores(1))
centre Txt$, 15
centre "Words:", 16
white: centre Words$(1), 17
If NP = 2 Then
yellow: Txt$ = Names$(2) + " scored" + Str$(Scores(2))
centre Txt$, 19
centre "Words:", 20
white: centre Words$(2), 21
yellow: centre "And the winner is...", 23
For a = 1 To 10: Play OK$: Next: Sleep 1
If Scores(2) > Scores(1) Then winr = 2 Else winr = 1
centre Names$(winr), 24
_Delay 5
Else ' single-player ending
Txt$ = "Your time to reach Target was " + LTrim$(Str$(GameTime)) + " seconds"
yellow: centre Txt$, 21
ShowBest:
yellow: Print: centre "Previous fastest single-players", 24: white: Print
For a = 1 To 5
Print Tab(30); Best$(a, 1); Tab(40); Best$(a, 2); " seconds"
Next
_Delay 5
CompareBest:
swop = 0
For a = 1 To 5 ' compare this game with best 5
If GameTime < Val(Best$(a, 2)) Then ' if the record time is longer than this game time
For b = 5 To a + 1 Step -1
Best$(b, 1) = Best$(b - 1, 1): Best$(b, 2) = Best$(b - 1, 2) ' move all after a down 1
Next
Best$(a, 1) = Names$(Plr): Best$(a, 2) = Str$(GameTime) ' place this player name and time in position a
swop = 1 ' flag swap made and stop checking
Exit For
End If ' if no swap, check next best
Next
BestBeaten:
If swop = 1 Then
centre "Updating", 32
Sleep 1
Open "ripbest" For Output As #1
For a = 1 To 5
Write #1, Best$(a, 1), Best$(a, 2)
Next
Close
End If
Cls
yellow: Print: centre "Fastest single-players", 12: white: Print
Open "ripbest" For Input As #1
For a = 1 To 5
Input #1, Best$(a, 1), Best$(a, 2)
Print Tab(30); Best$(a, 1); Tab(40); Best$(a, 2); " seconds"
Next
Close
_Delay 5
Run
End If
End Sub
Sub WIPE (ln$) ' ln$ is 2-digit line-numbers eg "0122" is lines 1 and 22)
For a = 1 To Len(ln$) - 1 Step 2 ' get 2 digits for wipe-line,
wl = Val(Mid$(ln$, a, 2)) ' and wipe that line
Locate wl, 1: Print Space$(CPL);
Next
End Sub
Sub red
Color _RGB(255, 0, 0)
End Sub
Sub yellow
Color _RGB(255, 255, 0)
End Sub
Sub white
Color _RGB(255, 255, 255)
End Sub
Sub centre (txt$, linenum) ' centres text on selected line
ctr = Int(CPL / 2 - Len(txt$) / 2) + 1 ' centre is half of chars per line minus half string-length
Locate linenum, ctr
Print txt$
End Sub
Sub instructions
Cls: yellow: centre "Ripple Instructions", 3: Print: white
Print " A square grid of letters is presented, and changes in the letters "; Chr$(34); "ripple"; Chr$(34);
Print " down the screen continually, one letter at a time. The players try to find"
Print " words in the grid, earning points for each word based on its length. The"
Print " speed of the ripple can be adjusted during play.": Print
Print " Words consist of a series of adjacent letters. The first letter scores one"
Print " point, and successive letters score one more point than the previous one."
Print " For example a 4-letter word is worth 1+2+3+4=10 points."
Print " Letters can be used multiple times, and the word can bend in any direction,"
Print " including across previous letters. All words are checked by the computer.": Print
Print " To discourage players from claiming to have found a word, then trying to"
Print " find one, a Timer measures the time taken to enter each word, allowing five"
Print " free seconds, then one second per letter. Excess time lowers the score,"
Print " while lesser time raises it, one second per letter.": Print
Print " When the player finds a word, they press a Shift key. Then they move to the"
Print " first letter of the word and press Space to start choosing letters, and move"
Print " to each letter of the word in turn to select them. They finish their word by"
Print " pressing Space again.": Print
Print " For two-player games, the winner is the first to reach the target of 200"
Print " points, while for single-player games, the time taken to reach this target"
Print " is compared with a record of previous game times, and if shorter, their name"
Print " and time are placed in this record. This time may be reduced by selecting a"
Print " faster Ripple rate, but words will be more difficult to find."
yellow: centre "Press any key for Game Keys", 32
Sleep: Play OK$: Cls
centre "GridWords Instructions - Game Keys", 4: white: Print: Print
Print Tab(22); "Left-shift"; Tab(34); "Assigned Claim key for Player 1": Print
Print Tab(21); "Right-shift"; Tab(34); "Assigned Claim key for Player 2": Print
Print Tab(25); "<Space>"; Tab(34); "Starts/stops letter-pickup and timer": Print
Print Tab(18); "Numeric keypad"; Tab(34); "Moves in direction of keys:": Print: yellow
Print Tab(36); "7 8 9"
Print Tab(37); "\ "; " "; Chr$(179); " "; " /"
Print Tab(36); "4 -";: red: Print " 5";: yellow: Print " - 6"
Print Tab(37); "/ "; " "; Chr$(179); " "; " \"
Print Tab(36); "1 2 3": white: Print
Print Tab(16); "Numeric keypad 5"; Tab(34); "Repeats the letter under the cursor": Print
Print Tab(26); "- or _"; Tab(34); "Slows down letter-changing": Print
Print Tab(26); "= or +"; Tab(34); "Speeds up letter-changing": Print
Print Tab(24); "Q or Esc"; Tab(34); "Quits the game and returns to System"
yellow: centre "Press a key to start", 30: Sleep: Cls: Play OK$
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/
