mirror of
https://github.com/QB64-Phoenix-Edition/QB64pe.git
synced 2024-07-03 15:51:20 +00:00
9ee89d6ff4
These tests use a variety of sample code (with some of the larger files removed, so they are not complete!) and verifies that they all compile successfully.
302 lines
8.3 KiB
QBasic
302 lines
8.3 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
|
|
|