En tiedä eroaako tämä versio koodistasi juurikaan, mutta arvelisin sen olevan nopeampi. Ohjelma käyttää 'yhteensuuntaan' rasteroivaa Bresenhamin algoritmiä, jolloin taulukon muokkaus lopetetaan heti kun osutaan törmäyskerrokseen. Lisäksi kartasta muokataan vain näkyvää osaa.
Code: Select all
SCREEN 800,600
Dim LOSMap(0,0,0)
Global LOSMap_w As integer
Global LOSMap_h As integer
Global LOSMap_obj As integer
Const LOSMAP_TW = 32.0
Const LOSMAP_TH = 32.0
map = LoadMap("Media\cdm2.til","Media\tileset.bmp")
InitLOS(map)
PositionCamera -10,-50
Repeat
TranslateCamera (KeyDown(cbkeyd)-KeyDown(cbkeya))*5,(KeyDown(cbkeyw)-KeyDown(cbkeys))*5
CalculateLOS(MouseWX(), MouseWY())
SetWindow "FPS: "+FPS()
DrawScreen
Forever
Function InitLOS(map)
//pistetään talteen ettei tartte kokoajan kysellä
LOSMap_obj = map
LOSMap_w = MapWidth()-1
LOSMap_h = MapHeight()-1
ReDim LOSMap(LOSMap_w, LOSMap_h,2)
For y=0 To LOSMap_h
For x=0 To LOSMap_w
LOSMap(x,y,0)=GetMap2 (0,x+1,y+1) // pohja kerros
LOSMap(x,y,1)=GetMap2 (2,x+1,y+1) // törmäys kerros
Next x
Next y
End Function
Function CalculateLOS(x, y)
// kameran näkymä tile koordinaateissa
begin_x% = RoundDown(ObjectSizeX(LOSMap_obj)/2.0 + (CameraX() - ScreenWidth() / 2.0 - LOSMAP_TW)) / LOSMAP_TW
begin_y% = RoundDown(ObjectSizeY(LOSMap_obj)/2.0 - (CameraY() + ScreenHeight() / 2.0 + LOSMAP_TH)) / LOSMAP_TH
end_x% = begin_x + RoundUp((ScreenWidth() + LOSMAP_TW) / LOSMAP_TW)
end_y% = begin_y + RoundUp((ScreenHeight() + LOSMAP_TH) / LOSMAP_TH)
// rajataan näkymä kartan alueelle.
begin_x = Min(Max(begin_x, 0), LOSMap_w)
begin_y = Min(Max(begin_y, 0), LOSMap_h)
end_x = Min(Max(end_x, 0), LOSMap_w)
end_y = Min(Max(end_y, 0), LOSMap_h)
If Abs(begin_x-end_x) < 2 Or Abs(begin_y-end_y) < 2 Then Return 0
x = Min(Max((ObjectSizeX(LOSMap_obj)/2.0+(x-LOSMAP_TW/2.0))/LOSMAP_TW, begin_x+1), end_x-1)
y = Min(Max((ObjectSizeY(LOSMap_obj)/2.0-(y+LOSMAP_TH/2.0))/LOSMAP_TH, begin_y+1), end_y-1)
DrawGame
Text 0,0,Str(begin_x)+","+Str(begin_y)
Text 0,12,Str(end_x)+","+Str(end_y)
Text 0,24,Str(LOSMap_w)+"x"+Str(LOSMap_h)
Text 0,36,Str(x)+","+Str(y)
'DrawScreen
'WaitKey
// Nollataan näkyvä alue
For i = begin_y To end_y
For j = begin_x To end_x
LOSMap(j,i,2)=0
Next j
Next i
// Lasketaan LOS näkymälle, skannataan kameran reunoihin asti.
For dx=begin_x To end_x
LOSBresenham(x,y,dx, begin_y)
LOSBresenham(x,y,dx, end_y)
Next dx
For dy=begin_y To end_y
LOSBresenham(x,y, begin_x,dy)
LOSBresenham(x,y, end_x,dy)
Next dy
// Editoidaan karttaan (joka ON nyt vain näytön kokoinen alue)
ClearText
For i = begin_y To end_y
For j = begin_x To end_x
'DrawGame
'Text 0,0,"EditMap "+Str(LOSMap_obj)+", 0, "+Str(j+1)+", "+Str(i+1)+", "+Str(LOSMap(j,i,2))
'DrawScreen
EditMap LOSMap_obj, 0, j+1, i+1, LOSMap(j,i,2)
Next j
Next i
EndFunction
Function LOSBresenham(x1%, y1%, x2%, y2%)
dx% = Abs(x2 - x1)
dy% = Abs(y2 - y1)
y% = y1
x% = x1
error% = 0
If dx > dy
add% = 1 - (y2 < y1) Shl 1
If x1 < x2
While x <= x2
LOSMap(x,y,2) = LOSMap(x,y,0)
If LOSMap(x,y,1) Then Return 0
error = error + dy
If error Shl 1 >= dx
y = y + add
error = error - dx
EndIf
x = x + 1
Wend
Else
While x >= x2
LOSMap(x,y,2) = LOSMap(x,y,0)
If LOSMap(x,y,1) Then Return 0
error = error + dy
If error Shl 1 >= dx
y = y + add
error = error - dx
EndIf
x = x - 1
Wend
EndIf
Else
add% = 1 - (x2 < x1) Shl 1
If y1 < y2
While y <= y2
LOSMap(x,y,2) = LOSMap(x,y,0)
If LOSMap(x,y,1) Then Return 0
error = error + dx
If error Shl 1 >= dy
x = x + add
error = error - dy
EndIf
y = y + 1
Wend
Else
While y >= y2
LOSMap(x,y,2) = LOSMap(x,y,0)
If LOSMap(x,y,1) Then Return 0
error = error + dx
If error Shl 1 >= dy
x = x + add
error = error - dy
EndIf
y = y - 1
Wend
EndIf
EndIf
EndFunction