mirror of
https://github.com/QB64Official/qb64.git
synced 2024-08-31 15:50:17 +00:00
301 lines
8.6 KiB
QBasic
301 lines
8.6 KiB
QBasic
'DECLARE SUB raytrace ()
|
|
'Antoni Gual raycaster
|
|
'Modified from Entropy's an 36-lines entry for the Biskbart's
|
|
'40-lines QB Raycaster Compo of fall-2001
|
|
'
|
|
'Added multikey handler
|
|
'Step emulation
|
|
'Added different textures, including clouds
|
|
'Separe
|
|
'with some of my ideas
|
|
|
|
'to do:
|
|
' add screen buffer
|
|
' optimize rendering loop
|
|
' interpolate rays
|
|
' shadowing
|
|
' subpixel precision
|
|
' make it a game???
|
|
|
|
'DECLARE SUB ffix ()
|
|
|
|
'ffix
|
|
SCREEN 13
|
|
|
|
DIM map(9, 9) AS INTEGER 'the map
|
|
DIM tex(31, 31, 4) AS INTEGER 'texture array
|
|
DIM foff(15) AS INTEGER 'walk simulation vertical offset
|
|
DIM kbd(128) AS INTEGER 'keyboard reader array
|
|
DIM frames%
|
|
DIM persplut(200) AS SINGLE 'vertical offsets for roof and floor
|
|
DIM d1(319) AS INTEGER 'temporal arrays raycaster->renderer
|
|
DIM d2(319) AS INTEGER
|
|
DIM tx(319) AS INTEGER
|
|
DIM tm(319) AS INTEGER
|
|
DIM dx(319) AS SINGLE
|
|
DIM dy(319) AS SINGLE
|
|
|
|
'read map,do fixed part of persp lut (sky is always in the infinite)
|
|
FOR i% = 0 TO 99
|
|
READ map(i% \ 10, i% MOD 10)
|
|
persplut(i%) = 25590 / (i% - 100)
|
|
NEXT
|
|
|
|
'make texture maps (should be read from file)
|
|
FOR i% = 0 TO 31
|
|
FOR j% = 0 TO 31
|
|
tex(i%, j%, 0) = (i% XOR j%) 'xor walls
|
|
i1% = i% - 16: j1% = j% - 16
|
|
tex(i%, j%, 1) = SQR((i1% * i1%) + (j1% * j1%)) 'concentric ground tiles
|
|
tex(i%, j%, 2) = 16 - SQR((i1% * i1%) + (j1% * j1%))
|
|
NEXT j%, i%
|
|
|
|
'cloudy texture 1
|
|
d1% = 64
|
|
d% = 32
|
|
tex(0, 0, 3) = 32
|
|
WHILE d% > 1
|
|
d2% = d% \ 2
|
|
FOR i% = 0 TO 31 STEP d%
|
|
FOR j% = 0 TO 31 STEP d%
|
|
tex((i% + d2%) AND 31, j%, 3) = (tex(i%, j%, 3) + tex((i% + d%) AND 31, j%, 3) + (RND - .5) * d1%) / 2
|
|
tex(i%, (j% + d2%) AND 31, 3) = (tex(i%, j%, 3) + tex(i%, (j% + d%) AND 31, 3) + (RND - .5) * d1%) / 2
|
|
tex((i% + d2%) AND 31, (j% + d2%) AND 31, 3) = (tex(i%, j%, 3) + tex((i% + d%) AND 31, (j% + d%) AND 31, 3) + (RND - .5) * d1%) / 2
|
|
NEXT j%, i%
|
|
d1% = d1% / 2
|
|
d% = d2%
|
|
WEND
|
|
|
|
'cloudy texture for sky
|
|
d1% = 64
|
|
d% = 32
|
|
tex(0, 0, 4) = 32
|
|
WHILE d% > 1
|
|
d2% = d% \ 2
|
|
FOR i% = 0 TO 31 STEP d%
|
|
FOR j% = 0 TO 31 STEP d%
|
|
tex((i% + d2%) AND 31, j%, 4) = (tex(i%, j%, 4) + tex((i% + d%) AND 31, j%, 4) + (RND - .5) * d1%) / 2
|
|
tex(i%, (j% + d2%) AND 31, 4) = (tex(i%, j%, 4) + tex(i%, (j% + d%) AND 31, 4) + (RND - .5) * d1%) / 2
|
|
tex((i% + d2%) AND 31, (j% + d2%) AND 31, 4) = (tex(i%, j%, 4) + tex((i% + d%) AND 31, (j% + d%) AND 31, 4) + (RND - .5) * d1%) / 2
|
|
NEXT j%, i%
|
|
d1% = d1% / 2
|
|
d% = d2%
|
|
WEND
|
|
|
|
|
|
'fill step-simulation vertical offset
|
|
pioct! = 3.141592 / 8!
|
|
FOR i% = 0 TO 15
|
|
foff(i%) = ABS(COS(i% * pioct!) * 64)
|
|
NEXT
|
|
|
|
|
|
'set palette
|
|
OUT &H3C8, 0
|
|
'grey:walls
|
|
FOR i% = 0 TO 63
|
|
OUT &H3C9, i%: OUT &H3C9, i%: OUT &H3C9, i%
|
|
NEXT
|
|
'green:ground
|
|
FOR i% = 0 TO 63
|
|
OUT &H3C9, 0: OUT &H3C9, 63 - i%: OUT &H3C9, 0
|
|
NEXT
|
|
'blue:sky
|
|
FOR i% = 0 TO 63
|
|
OUT &H3C9, 63 - i% / 2: OUT &H3C9, 63 - i% / 2: OUT &H3C9, 63
|
|
NEXT
|
|
|
|
|
|
|
|
'launch raytracer
|
|
'erase key buffer and set num lock off
|
|
DEF SEG = &H40: POKE &H1C, PEEK(&H1A): POKE &H17, PEEK(&H17) AND NOT 32
|
|
|
|
tim! = TIMER
|
|
frames% = 0
|
|
|
|
|
|
|
|
|
|
'SUB raytrace
|
|
rtf = 2048
|
|
rtl = .0001
|
|
inf = 3000000
|
|
incu = .05
|
|
xpos = 1.5
|
|
ypos = 1.5
|
|
angle = 0
|
|
ini% = 1
|
|
'frames loop
|
|
DO
|
|
|
|
WAIT &H3DA, 8
|
|
WAIT &H3DA, 8, 8
|
|
|
|
frames% = frames% + 1
|
|
|
|
'keyboard input
|
|
k% = INP(&H60):
|
|
IF k% THEN
|
|
kbd(k% AND 127) = -((k% AND 128) = 0)
|
|
DEF SEG = &H40: POKE &H1C, PEEK(&H1A)
|
|
IF kbd(1) THEN GOTO EXITDO1
|
|
turn% = kbd(&H4D) - kbd(&H4B): kbd(&H4D) = 0: kbd(&H4B) = 0
|
|
mov% = kbd(80) - kbd(72) + ini%
|
|
END IF
|
|
'a movement has happened, update and collision detect
|
|
IF turn% OR mov% THEN
|
|
angle = angle + turn% * .1
|
|
xpos2 = mov% * COS(angle) * incu
|
|
ypos2 = mov% * SIN(angle) * incu
|
|
|
|
'calculate walk offsets,and floor part of perspective
|
|
f% = f% + mov%
|
|
foff% = foff(f% AND 15)
|
|
calc = 25600 - 32 * foff%
|
|
FOR y% = 100 TO 199: persplut(y%) = calc / (y% - 99): NEXT
|
|
|
|
IF ini% THEN ini% = 0
|
|
dxc = COS(angle) * incu
|
|
dxs = SIN(angle) * incu / 160
|
|
dyc = COS(angle) * incu / 160
|
|
dys = SIN(angle) * incu
|
|
'colision detector
|
|
|
|
IF map(INT(ypos - incu), INT(xpos - xpos2 - xpos2 - incu)) = 0 THEN
|
|
IF map(INT(ypos - incu), INT(xpos - xpos2 - xpos2 + incu)) = 0 THEN
|
|
IF map(INT(ypos + incu), INT(xpos - xpos2 - xpos2 - incu)) = 0 THEN
|
|
IF map(INT(ypos + incu), INT(xpos - xpos2 - xpos2 + incu)) = 0 THEN
|
|
xpos = xpos - xpos2
|
|
xpos32 = xpos * 32
|
|
xp1! = (xpos - INT(xpos)) * rtf
|
|
END IF
|
|
END IF
|
|
END IF
|
|
END IF
|
|
IF map(INT(ypos - ypos2 - ypos2 - incu), INT(xpos - incu)) = 0 THEN
|
|
IF map(INT(ypos - ypos2 - ypos2 + incu), INT(xpos - incu)) = 0 THEN
|
|
IF map(INT(ypos - ypos2 - ypos2 - incu), INT(xpos + incu)) = 0 THEN
|
|
IF map(INT(ypos - ypos2 - ypos2 + incu), INT(xpos + incu)) = 0 THEN
|
|
ypos = ypos - ypos2
|
|
ypos32 = ypos * 32
|
|
yp1! = (ypos - INT(ypos)) * rtf
|
|
END IF
|
|
END IF
|
|
END IF
|
|
END IF
|
|
|
|
|
|
'raycast loop
|
|
FOR x% = 0 TO 319
|
|
'INIT RAYCASTER
|
|
dx = dxc - (x% - 160) * dxs
|
|
dy = (x% - 160) * dyc + dys
|
|
dx(x%) = dx
|
|
dy(x%) = dy
|
|
SELECT CASE dx
|
|
CASE IS < -rtl
|
|
nextxt = -xp1! / dx
|
|
dxt = -rtf / dx
|
|
CASE IS > rtl
|
|
nextxt = (rtf - xp1!) / dx
|
|
dxt = rtf / dx
|
|
CASE ELSE
|
|
nextxt = inf
|
|
END SELECT
|
|
SELECT CASE dy
|
|
CASE IS < -rtl
|
|
nextyt = -yp1! / dy
|
|
dyt = -rtf / dy
|
|
CASE IS > rtl
|
|
nextyt = (rtf - yp1!) / dy
|
|
dyt = rtf / dy
|
|
CASE ELSE
|
|
nextyt = inf
|
|
END SELECT
|
|
sdx% = SGN(dx): sdy% = SGN(dy)
|
|
xm% = INT(xpos): ym% = INT(ypos)
|
|
|
|
'cast a ray and increase distance until a wall is hit
|
|
DO
|
|
IF nextxt < nextyt THEN
|
|
|
|
xm% = xm% + sdx%
|
|
IF map(ym%, xm%) THEN ti = rtf / nextxt: GOTO exitdo2
|
|
nextxt = nextxt + dxt
|
|
ELSE
|
|
'ny% = ny% + 1
|
|
ym% = ym% + sdy%
|
|
IF map(ym%, xm%) THEN ti = rtf / nextyt: GOTO exitdo2
|
|
nextyt = nextyt + dyt
|
|
END IF
|
|
LOOP
|
|
exitdo2:
|
|
'Enter texture index, top, bottom into table for this direction
|
|
|
|
tm(x%) = map(ym%, xm%) MOD 5
|
|
d1% = 99 - INT((800 + foff%) * ti)
|
|
IF d1% > md1% THEN md1% = d1%
|
|
d1(x%) = d1%
|
|
d2% = 102 + INT((800 - foff%) * ti)
|
|
d2(x%) = d2%
|
|
IF d2% < md2% THEN md2% = d2%
|
|
tx(x%) = ((xpos + ypos + (dx + dy) / ti) * 32) AND 31
|
|
|
|
NEXT x%
|
|
END IF
|
|
|
|
'rendering loop (too many products and divisions)
|
|
|
|
DEF SEG = &HA000
|
|
FOR x% = 0 TO 319
|
|
d1% = d1(x%)
|
|
d2% = d2(x%)
|
|
tx% = tx(x%)
|
|
d21% = d2% - d1%
|
|
dx = dx(x%)
|
|
dy = dy(x%)
|
|
p& = x%
|
|
mmap% = tm(x%)
|
|
FOR y% = 0 TO 199
|
|
pl = persplut(y%)
|
|
SELECT CASE y%
|
|
'sky
|
|
CASE IS < d1%
|
|
tt% = 128 + tex(dx * pl AND 31, dy * pl AND 31, 4)
|
|
'wall
|
|
CASE IS < d2%
|
|
tt% = 10 + tex(32 * (y% - d1%) \ d21%, tx%, mmap%)
|
|
'ground
|
|
CASE ELSE
|
|
tt% = 56 + tex((xpos32 + dx * pl) AND 31, (ypos32 + dy * pl) AND 31, 4)
|
|
END SELECT
|
|
POKE p&, tt%
|
|
p& = p& + 320
|
|
NEXT y%
|
|
NEXT x%
|
|
LOOP
|
|
EXITDO1:
|
|
|
|
|
|
|
|
|
|
|
|
|
|
COLOR 12
|
|
LOCATE 1, 1: PRINT frames% / (TIMER - tim!); " fps"
|
|
a$ = INPUT$(1)
|
|
END
|
|
|
|
'map data
|
|
DATA 7,8,7,8,7,8,7,8,7,8
|
|
DATA 7,0,0,0,0,0,0,0,0,8
|
|
DATA 8,0,9,1,0,2,10,2,0,7
|
|
DATA 7,0,1,9,0,0,0,10,0,8
|
|
DATA 8,0,0,0,0,0,0,0,0,7
|
|
DATA 7,0,3,11,3,11,0,0,0,8
|
|
DATA 8,0,11,0,0,3,0,0,0,7
|
|
DATA 7,0,3,0,0,11,0,0,0,8
|
|
DATA 8,0,0,0,0,0,0,0,0,7
|
|
DATA 8,7,8,7,8,7,8,7,8,8
|
|
|