07-01-2003, 02:44 AM
Code:
DECLARE SUB raytrace ()
DECLARE SUB ffix ()
ffix
SCREEN 13
DIM SHARED map(9, 9) AS INTEGER, skylut(200) AS SINGLE
DIM SHARED tex(31, 31) AS INTEGER, foff(15) AS INTEGER
DIM SHARED tex1(31, 31) AS INTEGER
DIM SHARED tex2(31, 31) AS INTEGER
DIM SHARED kbd(128) AS INTEGER
DIM SHARED frames%
DIM SHARED y99lut!(100 TO 199)
'read map,do sky lut
FOR i% = 0 TO 99
READ map(i% \ 10, i% MOD 10)
skylut(i%) = 25590 / (i% - 100)
NEXT
'make texture maps
FOR i% = 0 TO 31
FOR j% = 0 TO 31
tex(i%, j%) = 16 + (i% XOR j%) 'xor walls
i1% = i% - 16: j1% = j% - 16
tex1(i%, j%) = 64 + SQR((i1% * i1%) + (j1% * j1%)) 'concentric ground
tex2(i%, j%) = 128 + RND * 63 'rnd sky
NEXT j%, i%
'step-simulation vertical offset
CONST 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% + 16: OUT &H3C9, i% + 16: OUT &H3C9, i% + 16
NEXT
'green:ground
FOR i% = 0 TO 63
OUT &H3C9, 0: OUT &H3C9, 140 + 2 * i%: OUT &H3C9, 0
NEXT
'blue:sky
FOR i% = 0 TO 63
OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 140 + i%
NEXT
tim! = TIMER
frames% = 0
raytrace
LOCATE 1, 1: PRINT frames% / (TIMER - tim!)
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
SUB raytrace
CONST rtf = 2048
CONST rtl = .0001
CONST inf = 3000000
CONST incu = .05
xpos = 1.5
ypos = 1.5
ini% = 1
'erase key buffer and set num lock off
DEF SEG = &H40: POKE &H1C, PEEK(&H1A): POKE &H17, PEEK(&H17) AND NOT 32
'frames loop
DO
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 EXIT DO
END IF
'calculate new position and angle
turn% = kbd(&H4D) - kbd(&H4B): kbd(&H4D) = 0: kbd(&H4B) = 0
mov% = kbd(80) - kbd(72) + ini%
'a movement has happened, update and collision detect
IF turn% OR mov% THEN
angle = angle + turn% * .06
xpos2 = mov% * COS(angle) * incu
ypos2 = mov% * SIN(angle) * incu
xpos32 = xpos * 32
ypos32 = ypos * 32
'calculate walk offsets
f% = f% + mov%
foff% = foff(f% AND 15)
calc = 25600 - 32 * foff%
FOR y% = 100 TO 199: y99lut!(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
xp22 = xpos - xpos2 - xpos2
IF map(INT(ypos - incu), INT(xp22 - incu)) = 0 THEN
IF map(INT(ypos - incu), INT(xp22 + incu)) = 0 THEN
IF map(INT(ypos + incu), INT(xp22 - incu)) = 0 THEN
IF map(INT(ypos + incu), INT(xp22 + incu)) = 0 THEN
xpos = xpos - xpos2
END IF
END IF
END IF
END IF
yp22 = ypos - ypos2 - ypos2
IF map(INT(yp22 - incu), INT(xpos - incu)) = 0 THEN
IF map(INT(yp22 + incu), INT(xpos - incu)) = 0 THEN
IF map(INT(yp22 - incu), INT(xpos + incu)) = 0 THEN
IF map(INT(yp22 + incu), INT(xpos + incu)) = 0 THEN
ypos = ypos - ypos2
END IF
END IF
END IF
END IF
xp1! = (xpos - INT(xpos)) * rtf
yp1! = (ypos - INT(ypos)) * rtf
END IF
'screen sweep loop
DEF SEG = &HA000:
FOR x% = 0 TO 319
'INIT RAYCASTER
dx = dxc - (x% - 160) * dxs
dy = (x% - 160) * dyc + dys
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)
'raycast until wall hit
DO
IF nextxt& < nextyt& THEN
xm% = xm% + sdx%
IF map(ym%, xm%) THEN ti = rtf / nextxt&: EXIT DO
nextxt& = nextxt& + dxt&
ELSE
ym% = ym% + sdy%
IF map(ym%, xm%) THEN ti = rtf / nextyt&: EXIT DO
nextyt& = nextyt& + dyt&
END IF
LOOP
d1% = 99 - CINT((800 + foff%) * ti)
d2% = 102 + CINT((800 - foff%) * ti)
d21% = d2% - d1%
'draw a vertical slice.
tx% = ((xpos + ypos + (dx + dy) / ti) * 32) AND 31
p& = x%
FOR y% = 0 TO 199
SELECT CASE y%
'sky
CASE IS < d1%
'tt% = 1
tt% = tex2(dx * skylut(y%) AND 31, dy * skylut(y%) AND 31)
'tt% = tex2(skx(y%), sky(y%))
'wall
CASE IS < d2%
tt% = tex((32 * (y% - d1%) \ d21%) AND 31, tx%)
CASE ELSE
'ground
'tt% = 2
tt% = tex1(xpos32 + dx * y99lut!(y%) AND 31, ypos32 + dy * y99lut!(y%) AND 31)
'tt% = tex1(y99x(y%), y99y(y%))
END SELECT
POKE p&, tt%
p& = p& + 320
NEXT
NEXT x%
LOOP
END SUB
Antoni