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)
Unless otherwise stated, the content of this page is licensed under Creative Commons Attribution-Share Alike 2.5 License.