2d Torch
'Demostrates how to calculate line of sight and display visible and non visible tiles
'Richard D. Clark
'Public Domain
'Key consts Const xk = Chr$(255) Const key_up = xk + "H" Const key_dn = xk + "P" Const key_rt = xk + "M" Const key_lt = xk + "K" Const torchrad = 5 'radius of torch light
Dim Shared map(1 To 80, 1 To 30) As Integer 'the display map Dim Shared vismap(1 To 80, 1 To 30) As Integer
'the visibility map Dim Key As String Dim Shared As Integer playerx, playery
'current player location Dim As Integer tplayerx, tplayery 'tmp player position
'Fills the map array with random blocks Sub CreateMap
Dim As Integer x, y, i
For i = 1 To 400
x = (Rnd * 79) + 1
y = (Rnd * 29) + 1
map(x, y) = 1 'Block in this location
Next
'Player start spot
map(40, 20) = 0 End Sub
'Clears the visbility map Sub ClearVisMap
Dim As Integer x, y
For x = 1 To 80
For y = 1 To 30
vismap(x, y) = 0 '0 means isn't visible
Next
Next End Sub
'Calcs line of sight Function LineOfSight(x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer) As Integer
Dim As Integer i, deltax, deltay, numtiles
Dim As Integer d, dinc1, dinc2
Dim As Integer x, xinc1, xinc2
Dim As Integer y, yinc1, yinc2
Dim As Integer isseen = 1
deltax = Abs(x2 - x1)
deltay = Abs(y2 - y1)
If deltax >= deltay Then
numtiles = deltax + 1
d = (2 * deltay) - deltax
dinc1 = deltay * 2
dinc2 = (deltay - deltax) * 2
xinc1 = 1
xinc2 = 1
yinc1 = 0
yinc2 = 1
Else
numtiles = deltay + 1
d = (2 * deltax) - deltay
dinc1 = deltax * 2
dinc2 = (deltax - deltay) * 2
xinc1 = 0
xinc2 = 1
yinc1 = 1
yinc2 = 1
End If
If x1 > x2 Then
xinc1 = - xinc1
xinc2 = - xinc2
End If
If y1 > y2 Then
yinc1 = - yinc1
yinc2 = - yinc2
End If
x = x1
y = y1
For i = 2 To numtiles
If map(x, y) = 1 Then
isseen = 0 'Can't see
Exit For
End If
If d < 0 Then
d = d + dinc1
x = x + xinc1
y = y + yinc1
Else
d = d + dinc2
x = x + xinc2
y = y + yinc2
End If
Next
Return isseen End Function
'Calculates current light map Sub CalcVisMap
Dim As Integer x, y, d, dx, dy
ClearVisMap 'Set vismap to 0, unseen
For x = 1 To 80
For y = 1 To 30
dx = (playerx - x) * (playerx - x) 'calc circle diameter of torch light
dy = (playery - y) * (playery - y)
d = Sqr(dx + dy)
If d <= torchrad Then 'if within circle of torch light then calc vismap
If LineOfSight(playerx, playery, x, y) = 1 Then
vismap(x, y) = 1 'Can see the current tile
End If
End If
Next
Next End Sub
'Fast distance calc Function CalcDist(x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer) As Integer
Dim As Integer xdiff, ydiff
xdiff = Abs(x1 - x2)
ydiff = Abs(y1 - y2)
If xdiff >= ydiff Then Return xdiff
If ydiff >= xdiff Then Return ydiff End Function
'Calcs light intensity based on distance Function CalcLight(x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer) As Double
Dim As Integer dist
dist = CalcDist(x1, y1, x2, y2)
If dist > 0 Then
Return 1 / dist
Else
Return 1.0
End If
End Function
'Draws current visible map Sub DrawMap
Dim As Integer x, y, clr
Dim As Double li 'light intensity
Cls
For x = 1 To 80
For y = 1 To 30
If vismap(x, y) <> 0 Then
'calc the light intenisty
li = CalcLight(x, y, playerx, playery)
clr = li * 255 'set light value
Locate y, x
If map(x, y) = 1 Then
Color RGB(clr, clr, clr)
Print Chr(219); 'print a wall
Else
Color RGB(clr, clr, clr)
Print Chr(176); 'print a floor
End If
End If
Next
Next
End Sub
Sub DrawPlayer
Locate playery, playerx
Color RGB(255, 255, 0)
Print Chr(1); End Sub
Randomize Timer 'init the random number generator Screen 18, 32 'player start position playerx = 40 playery = 20 'Create the map and draw it CreateMap CalcVisMap DrawMap DrawPlayer
Do
Key = Inkey
If Key = key_up Then
tplayerx = playerx
tplayery = playery - 1
If tplayery > 0 Then 'make sure still on screen
If map(tplayerx, tplayery) = 0 Then 'check for blocking tile
playerx = tplayerx 'move player to new location
playery = tplayery
CalcVisMap 'Calc the new vis map
DrawMap 'Draw the map
DrawPlayer 'Draw the player
End If
End If
Elseif Key = key_dn Then
tplayerx = playerx
tplayery = playery + 1
If tplayery < 31 Then 'make sure still on screen
If map(tplayerx, tplayery) = 0 Then 'check for blocking tile
playerx = tplayerx 'move player to new location
playery = tplayery
CalcVisMap 'Calc the new vis map
DrawMap 'Draw the map
DrawPlayer 'Draw the player
End If
End If
Elseif Key = key_rt Then
tplayerx = playerx + 1
tplayery = playery
If tplayerx < 81 Then 'make sure still on screen
If map(tplayerx, tplayery) = 0 Then 'check for blocking tile
playerx = tplayerx 'move player to new location
playery = tplayery
CalcVisMap 'Calc the new vis map
DrawMap 'Draw the map
DrawPlayer 'Draw the player
End If
End If
Elseif Key = key_lt Then
tplayerx = playerx - 1
tplayery = playery
If tplayerx > 0 Then 'make sure still on screen
If map(tplayerx, tplayery) = 0 Then 'check for blocking tile
playerx = tplayerx 'move player to new location
playery = tplayery
CalcVisMap 'Calc the new vis map
DrawMap 'Draw the map
DrawPlayer 'Draw the player
End If
End If
Elseif Key = Chr(32) Then 'Create new map
'player start position
playerx = 40
playery = 20
'Create the map and draw it
CreateMap
CalcVisMap
DrawMap
DrawPlayer
End If
Loop Until Key = Chr(27)