'From http://lodev.org/cgtutor/raycasting.html
nomainwin
mapWidth = 24
mapHeight = 24
dim worldMap(mapWidth, mapHeight)
gosub [readMap]
dim wallTexture(5)
wallTexture(1)=128
wallTexture(2)=64
wallTexture(3)=384
wallTexture(4)=512
wallTexture(5)=448
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
graphicbox #raycaster.gb 0,0,DisplayWidth,DisplayHeight
open "Raycaster " for window_popup as #raycaster
#raycaster "trapclose [quit]"
loadbmp "wolf","wolf.bmp"
'LBB has a screen DC and a buffer DC, we only need a resource DC
'get the handle of our graphicbox
hWnd=hwnd(#raycaster.gb)
'get the handle to its associated DC
'LBB intercepts this call and passes us the buffer DC
bDC=GetDC(hWnd)
'create a copy called rDC (Resource)
'and load image
rDC=CreateCompatibleDC(bDC)
hBitmap=hbmp("wolf")
oldBmp=SelectObject(rDC,hBitmap)
'#raycaster.gb " down ; setfocus"
w=800
h=600
moveSpeed = .2
rotSpeed = .1
posX = 22: posY = 12
dirX = -1: dirY = 0
planeX = 0: planeY = 0.66
'timer 16,[blit]
'wait
[blit]
'blit the buffer full screen from its 800x600 origin
'the graphics are drawn to the buffer 800x600, we expand this to full
'screen once each cycle
call StretchBlt,bDC,0,0,DisplayWidth,DisplayHeight,bDC,0,0,800,600
'tell Windows the full area of the buffer needs flipped onscreen
calldll #user32, "InvalidateRect", hWnd as ulong, 0 as long, 0 as long, ret as void
'pause a little, else it is too fast and buffer conflict/flicker
calldll #kernel32, "Sleep",16 as ulong, NULL as void
'clear the 800x600 area of buffer by blitting the sky and ground images from rDC
call StretchBlt,bDC,0,0,800,600,rDC,0,0,64,128
[drawingloop]
scan
cameraX = 2 * x / w - 1 'x-coordinate in camera space
rayPosX = posX
rayPosY = posY
rayDirX = dirX + planeX * cameraX
rayDirY = dirY + planeY * cameraX
mapX = int(rayPosX)
mapY = int(rayPosY)
select case
case rayDirY=0
deltaDistX = 1: deltaDistY=999999
case rayDirX=0
deltaDistX = 999999: deltaDistY=1
case else
deltaDistX = sqr(1 + (rayDirY * rayDirY) / (rayDirX * rayDirX))
deltaDistY = sqr(1 + (rayDirX * rayDirX) / (rayDirY * rayDirY))
end select
if rayDirX<0 then
stepX=-1
sideDistX=(rayPosX-mapX)*deltaDistX
else
stepX=1
sideDistX=(mapX+1-rayPosX)*deltaDistX
end if
if rayDirY<0 then
stepY=-1
sideDistY=(rayPosY-mapY)*deltaDistY
else
stepY=1
sideDistY=(mapY+1-rayPosY)*deltaDistY
end if
while worldMap(mapX,mapY)=0
if sideDistX<sideDistY then
sideDistX = sideDistX+deltaDistX
mapX=mapX+stepX
side=0
else
sideDistY=sideDistY+deltaDistY
mapY=mapY+stepY
side=1
end if
wend
if (side = 0) then
perpWallDist = abs((mapX - rayPosX + (1 - stepX) / 2) / rayDirX)
else
perpWallDist = abs((mapY - rayPosY + (1 - stepY) / 2) / rayDirY)
end if
lineHeight = abs(int(h / perpWallDist))
drawStart = int(0-lineHeight / 2 + h / 2)
if (side = 1) then
wallX = rayPosX + ((mapY - rayPosY + (1 - stepY) / 2) / rayDirY) * rayDirX
ws=64
else
wallX = rayPosY + ((mapX - rayPosX + (1 - stepX) / 2) / rayDirX) * rayDirY
ws=0
end if
wallX = wallX - int((wallX))
texW=64
texX=int(wallX*texW)
if side=0 and rayDirX>0 then texX=texW-texX-1
if side=1 and rayDirY<0 then texX=texW-texX-1
srcW=int(lineHeight/32+1)
'draw the relevant line segment to the 800x600 area of the buffer from rDC
call StretchBlt,bDC,x,drawStart,srcW,lineHeight,rDC,wallTexture(worldMap(mapX,mapY))+texX,ws,2,64
x=x+srcW
if x<800 then goto [drawingloop]
x=0
if GetAsnycKeyState(_VK_ESCAPE) then goto [quit]
if GetAsnycKeyState(_VK_UP) then
if(worldMap(int(posX + dirX * moveSpeed),int(posY)) = 0) then posX = posX +dirX * moveSpeed
if(worldMap(int(posX),int(posY + dirY * moveSpeed)) = 0) then posY = posY +dirY * moveSpeed
end if
if GetAsnycKeyState(_VK_DOWN) then
if(worldMap(int(posX - dirX * moveSpeed),int(posY)) = 0) then posX = posX -dirX * moveSpeed
if(worldMap(int(posX),int(posY - dirY * moveSpeed)) = 0) then posY = posY -dirY * moveSpeed
end if
if GetAsnycKeyState(_VK_RIGHT) then
oldDirX = dirX
dirX = dirX * cos(0-rotSpeed) - dirY * sin(0-rotSpeed)
dirY = oldDirX * sin(0-rotSpeed) + dirY * cos(0-rotSpeed)
oldPlaneX = planeX
planeX = planeX * cos(0-rotSpeed) - planeY * sin(0-rotSpeed)
planeY = oldPlaneX * sin(0-rotSpeed) + planeY * cos(0-rotSpeed)
end if
if GetAsnycKeyState(_VK_LEFT) 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)
end if
goto [blit]
wait
[quit]
timer 0
call ReleaseDC hwnd,bDC
call ReleaseDC hWnd,rDC
call DeleteDC rDC
close #raycaster
end
[readMap]
data "{1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1},"
data "{1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1},"
data "{1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1},"
data "{1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1},"
data "{1,0,0,0,0,0,1,1,2,1,1,0,0,0,0,3,0,3,0,3,0,0,0,1},"
data "{1,0,0,0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,1},"
data "{1,0,0,0,0,0,2,0,0,0,2,0,0,0,0,3,0,0,0,3,0,0,0,1},"
data "{1,0,0,0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,1},"
data "{1,0,0,0,0,0,1,1,0,1,1,0,0,0,0,3,0,3,0,3,0,0,0,1},"
data "{1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1},"
data "{1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1},"
data "{1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1},"
data "{1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1},"
data "{1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,5,0,0,0,0,0,0,0,1},"
data "{1,0,0,0,0,0,0,0,0,0,0,0,0,0,5,0,5,0,0,0,0,0,0,1},"
data "{1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1},"
data "{1,4,4,4,4,4,4,4,4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1},"
data "{1,4,0,4,0,0,0,0,4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1},"
data "{1,4,0,0,0,0,5,0,4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1},"
data "{1,4,0,4,0,0,0,0,4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1},"
data "{1,4,0,4,4,4,4,4,4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1},"
data "{1,4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1},"
data "{1,4,4,4,4,4,4,4,4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1},"
data "{1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1}"
for j= 1 to mapHeight
read a$
a$=mid$(a$,2)
for i = 1 to mapWidth
worldMap(i,j)=val(word$(a$,i,","))
'print worldMap(i,j);
next
'print
next
return
Function GetDC(hWnd)
CallDLL #user32, "GetDC",_
hWnd As Ulong,_
GetDC As Ulong
End Function
Sub ReleaseDC hWnd, hDC
CallDLL#user32,"ReleaseDC",_
hWnd As Ulong,_
hDC As Ulong,_
result As Long
End Sub
Function CreateCompatibleDC(hDC)
CallDLL #gdi32,"CreateCompatibleDC",_
hDC As Ulong,_
CreateCompatibleDC As Ulong
End Function
Sub DeleteDC hDC
CallDLL #gdi32, "DeleteDC",_
hDC As Ulong,_
result As Ulong
End Sub
Sub StretchBlt hDCdest,x,y,w,h,hDCsrc,x2,y2,w2,h2
CallDLL #gdi32, "StretchBlt",_
hDCdest As Ulong,_
x As Long,_
y As Long,_
w As Long,_
h As Long,_
hDCsrc As Ulong,_
x2 As Long,_
y2 As Long,_
w2 As Long,_
h2 As Long,_
_SRCCOPY As Ulong,_
result As Ulong
End Sub
Function SelectObject(hDC,hObject)
CallDLL #gdi32,"SelectObject",_
hDC As Ulong,_
hObject As Ulong,_
SelectObject As Ulong
End Function
function GetAsnycKeyState(key)
calldll #user32, "GetAsyncKeyState",_
key as long,ret as long
if ret <> 0 then GetAsnycKeyState = 1
end function