Pitkästä aikaa jotain järkevämpää toteutettu, eli raycaster. Pientä ongelmaa havaittavissa kun katsoo laatikoita tietyistä suunnista, tiedä sitten missä vika.
Code: Select all
SCREEN 640,480,0,1
h=479
w=639
Dim map(32,32)
Dim row(32) As String
row(1)= "1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,"
row(2)= "1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(3)= "1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(4)= "1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(5)= "1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(6)= "1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(7)= "1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(8)= "1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(9)= "1,2,2,0,0,2,2,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(10)="2,0,0,0,0,0,2,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(11)="2,0,0,0,0,0,2,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(12)="2,0,0,0,0,0,2,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(13)="2,0,0,0,0,0,2,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(14)="2,0,0,0,0,0,2,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(15)="1,2,2,2,2,2,1,1,0,0,0,0,0,0,0,1,5,5,5,5,5,6,6,6,6,6,7,7,7,7,7,1,"
row(16)="1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,"
row(17)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(18)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(19)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(20)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(21)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(22)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(23)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(24)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(25)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(26)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(27)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(28)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(29)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(30)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(31)="1,5,2,6,3,7,4,5,2,6,3,7,4,5,2,6,3,7,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(32)="1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,3,3,3,3,3,3,3,3,3,3,3,3,1,"
For n=1 To 32
For nn=1 To Len(row(n))
For i=1 To 32
map(32-i,n)=Int(Left(row(n),InStr(row(n),",")))
row(n)=StrRemove(row(n),1,InStr(row(n),","))
Next i
Next nn
Next n
posX#=8
posY#=24
dirX#=-1
dirY#=0
planeX#=0
planeY#=0.66
rotSpeed#=2
otim#=Timer()
tim#=Timer()-otim
Repeat
otim#=Timer()
rotSpeed#=tim/10
moveSpeed#=tim/100
If KeyDown(32) Then
oldDirX# = dirX
dirX = dirX * Cos(-rotSpeed) - dirY * Sin(-rotSpeed)
dirY = oldDirX * Sin(-rotSpeed) + dirY * Cos(-rotSpeed)
oldPlaneX# = planeX
planeX = planeX * Cos(-rotSpeed) - planeY * Sin(-rotSpeed)
planeY = oldPlaneX * Sin(-rotSpeed) + planeY * Cos(-rotSpeed)
EndIf
If KeyDown(30) Then
oldDirX# = dirX
dirX = dirX * Cos(rotSpeed) - dirY * Sin(rotSpeed)
dirY = oldDirX * Sin(rotSpeed) + dirY * Cos(rotSpeed)
oldPlaneX# = planeX
planeX = planeX * Cos(rotSpeed) - planeY * Sin(rotSpeed)
planeY = oldPlaneX * Sin(rotSpeed) + planeY * Cos(rotSpeed)
EndIf
If KeyDown(17) Then
If map(Int(posX + dirX * moveSpeed),Int(posY)) = 0 Then posX = posX + dirX * moveSpeed
If map(Int(posX),Int(posY + dirY * moveSpeed)) = 0 Then posY = posY + dirY * moveSpeed
EndIf
If KeyDown(31) Then
If map(Int(posX + dirX * -moveSpeed),Int(posY)) = 0 Then posX = posX + dirX * -moveSpeed
If map(Int(posX),Int(posY + dirY * -moveSpeed)) = 0 Then posY = posY + dirY * -moveSpeed
EndIf
If KeyDown(205) Then
oldDirX# = dirX
dirX = dirX * Cos(-rotSpeed) - dirY * Sin(-rotSpeed)
dirY = oldDirX * Sin(-rotSpeed) + dirY * Cos(-rotSpeed)
oldPlaneX# = planeX
planeX = planeX * Cos(-rotSpeed) - planeY * Sin(-rotSpeed)
planeY = oldPlaneX * Sin(-rotSpeed) + planeY * Cos(-rotSpeed)
EndIf
If KeyDown(203) Then
oldDirX# = dirX
dirX = dirX * Cos(rotSpeed) - dirY * Sin(rotSpeed)
dirY = oldDirX * Sin(rotSpeed) + dirY * Cos(rotSpeed)
oldPlaneX# = planeX
planeX = planeX * Cos(rotSpeed) - planeY * Sin(rotSpeed)
planeY = oldPlaneX * Sin(rotSpeed) + planeY * Cos(rotSpeed)
EndIf
If KeyDown(200) Then
If map(Int(posX + dirX * moveSpeed),Int(posY)) = 0 Then posX = posX + dirX * moveSpeed
If map(Int(posX),Int(posY + dirY * moveSpeed)) = 0 Then posY = posY + dirY * moveSpeed
EndIf
If KeyDown(208) Then
If map(Int(posX + dirX * -moveSpeed),Int(posY)) = 0 Then posX = posX + dirX * -moveSpeed
If map(Int(posX),Int(posY + dirY * -moveSpeed)) = 0 Then posY = posY + dirY * -moveSpeed
EndIf
Lock
For x=0 To 640 Step 2
camX# = Float(2) * Float(x) / Float(w) - 1
rayPosX# = Float(posX)
rayPosY# = Float(posY)
rayDirX# = dirX + planeX * camX
rayDiry# = dirY + planeY * camX
sideDistX#=0
sideDistY#=0
mapX = Int(rayPosX)
mapY = Int(rayPosY)
deltaDistX# = Sqrt(1+(rayDirY*rayDirY)/(rayDirX*rayDirX))
deltaDistY# = Sqrt(1+(rayDirX*rayDirX)/(rayDirY*rayDirY))
stepX=0
stepY=0
hit=0
side=0
If rayDirX<0 Then
stepX = -1
sideDistX = (rayPosX-mapX)*deltaDistX
Else
stepX = 1
sideDistX = (mapX+1-rayPosX)*deltaDistX
EndIf
If rayDirY<0 Then
stepY = -1
sideDistY = (rayPosY-mapY)*deltaDistY
Else
stepY = 1
sideDistY = (mapY+1-rayPosY)*deltaDistY
EndIf
While hit=0
If sideDistX<sideDistY Then
sideDistX=sideDistX+deltaDistX
mapX=mapX+stepX
side=0
'Color 255,0,0
'Dot mapX,mapY
Else
sideDistY=sideDistY+deltaDistY
mapY=mapY+stepY
side=1
'Color 0,255,0
'Dot mapX,mapY
EndIf
If map(mapX,mapY)>0 Then hit=map(mapX,mapY)
Wend
If side=0 Then
perpWallDist# = Abs(Float((mapX-rayPosX+(1-stepX)/2)/rayDirX))
Else
perpWallDist# = Abs(Float((mapY-rayPosY+(1-stepY)/2)/rayDirY))
EndIf
side=side+1
lineHeight#=Abs(h/perpWallDist)
c#=Min(255,Max(0,255/side/perpWallDist))
Select hit
Case 1
Color c,c,c
Case 2
Color c,c,0
Case 3
Color 0,c,c
Case 4
Color c,0,c
Case 5
Color c,0,0
Case 6
Color 0,c,0
Case 7
Color 0,0,c
Default
Color c,c,c
EndSelect
Line x,Max(0,-lineHeight/2+h/2),x,Min(480,lineHeight/2+h/2)
Line x+1,Max(0,-lineHeight/2+h/2),x+1,Min(480,lineHeight/2+h/2)
Select hit
Case 1
Color c/2,c/2,c/2
Case 2
Color c/2,c/2,0
Case 3
Color 0,c/2,c/2
Case 4
Color c/2,0,c/2
Case 5
Color c/2,0,0
Case 6
Color 0,c/2,0
Case 7
Color 0,0,c/2
Default
Color c/2,c/2,c/2
EndSelect
'Line x,Max(0,-lineHeight/2+h/2),x,0
Line x,Min(480,lineHeight/2+h/2),x,Min(480,lineHeight/2+h/2)+lineHeight
'Dot x,-lineheight/2+h/2
'Dot x,lineheight/2+h/2
Next x
c=255
Color 1,1,1
Unlock
Box 2,1,64,32,1
Lock
Color c,c,c
For x=32 To 0 Step -1
For y=0 To 32
Select map(32-x,y)
Case 1
Color c,c,c
Case 2
Color c,c,0
Case 3
Color 0,c,c
Case 4
Color c,0,c
Case 5
Color c,0,0
Case 6
Color 0,c,0
Case 7
Color 0,0,c
Default
Color c,c,c
EndSelect
If map(32-x,y)<>0 Then Line x*2,y,x*2+1,y
If Int(posX)=32-x And Int(posY)=y Then
Line x*2,y,x*2+1,y
Line 2*x+dirX*-4,y-dirY*-2,2*x+dirX*-4+1,y-dirY*-2
EndIf
Next y
Next x
Unlock
Text 70,0,posx+" "+posy
Text 71,0,posx+" "+posy
DrawScreen
tim#=Timer()-otim
Forever