Text Crawling

Letters crawl around screen to make a word. Press space to see it again. ESC to exit.

'text crawl
Option Explicit

'directions
#Define north 1
#Define east 2
#Define south 3
#Define west 4

#Define True 1
#Define False 0

Const fbBlack = Rgb(0, 0, 0)
Const fbYellow = Rgb (255, 255, 0)

Type lcoord
col As Integer
row As Integer
End Type

Type lettertype
letter As String * 1
lcolor As Integer
curloc As lcoord
tgtloc As lcoord
End Type

Declare Function GetCol(mess As String) As Integer
Declare Function GetCoord(direction As Integer, ccoord As lcoord) As lcoord
Declare Function GetRandom(lowerbound, upperbound As Integer) As Integer
Declare Function CalcMHDist(cc1 As lcoord, cc2 As lcoord) As Integer
Declare Sub DisplayLetters
Declare Function InLocation(idx As Integer) As Integer
Declare Sub SetUpWord(mytext As String)
Declare Sub MoveLetters

Dim As String mytext, skey

Screen 18, 32
Width 80, 60
Randomize Timer

'get the letter array
mytext = "Ascii-World.com"
'build the array of letters
Dim Shared word(Len(mytext)) As lettertype
SetUpWord mytext

Do
skey = Inkey$
If skey = Chr$(32) Then SetUpWord mytext
Displayletters
MoveLetters
Sleep 30
Loop Until skey = Chr$(27)

'center text on row
Function GetCol(mess As String) As Integer
Return 40 - (Len(mess) / 2)
End Function

Function GetCoord(direction As Integer, ccoord As lcoord) As lcoord
Dim rcoord As lcoord

Select Case direction
Case north
rcoord.col = ccoord.col
rcoord.row = ccoord.row - 1
Case east
rcoord.col = ccoord.col + 1
rcoord.row = ccoord.row
Case south
rcoord.col = ccoord.col
rcoord.row = ccoord.row + 1
Case west
rcoord.col = ccoord.col - 1
rcoord.row = ccoord.row
End Select
Return rcoord
End Function

'get a random number between low and high
Function GetRandom(lowerbound, upperbound As Integer) As Integer
GetRandom = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
End Function

'calc manhattan distance
Function CalcMHDist(cc1 As lcoord, cc2 As lcoord) As Integer
Return Abs(cc1.col - cc2.col) + Abs(cc1.row - cc2.row)
End Function

'display current locations of letters
Sub DisplayLetters
Dim As Integer i

'comment out cls to leave trails
Color , fbBlack
Cls
For i = 1 To UBound(word)
With word(i)
Color .lcolor, fbBlack
Locate .curloc.row, .curloc.col
Print .letter;
End With
Next

End Sub

Function InLocation(idx As Integer) As Integer
Dim ret As Integer = True

If word(idx).curloc.row  word(idx).tgtloc.row Then
ret = False
End If
If word(idx).curloc.col  word(idx).tgtloc.col Then
ret = False
End If

Return ret
End Function

Sub SetUpWord(mytext As String)
Dim As Integer i, tcol, r, g, b

'get the col of target string
tcol = GetCol(mytext)
'init the array of letters
For i = 0 To UBound(word)
With word(i)
'get the letter
.letter = Mid$(mytext, i, 1)
'set the color
r = GetRandom(128, 255)
g = GetRandom(128, 255)
b = GetRandom(128, 255)
.lcolor = Rgb(r, g, b)
'set the current location
.curloc.col = GetRandom(1, 79)
.curloc.row = GetRandom(1, 59)
'calc the target location
.tgtloc.col = tcol + i
.tgtloc.row = 30
End With
Next
End Sub

Sub MoveLetters
Dim As Integer i, j, dist, dist2
Dim As lcoord cloc, nloc, sloc

For i = 0 To UBound(word)
'check to see if letter is in right location
If Not InLocation(i) Then
dist = 0
dist2 = 10000
sloc.col = 0
sloc.row = 0
'get the current letter word
cloc = word(i).curloc
'get a new location
For j = north To west
nloc = GetCoord(j, cloc)
If nloc.col > 1 And nloc.col < 80 Then
If nloc.row > 1 And nloc.row < 60 Then
'calc the distance
dist = CalcMHDist(word(i).tgtloc, nloc)
'save the location
If dist  0 And sloc.row > 0 Then
word(i).curloc = sloc
End If
End If
Next
End Sub
Unless otherwise stated, the content of this page is licensed under Creative Commons Attribution-Share Alike 2.5 License.