Rustenstein 3D: программируем, как будто сейчас 1992 год

' Shown by Carl Mahnke, but now offline
' www.youtube.com/watch?v=3Qpht8dSps8
' rws.sebus.de/misc/raycast.rar
' Re-write by Bernhard Slawik 2020-10-01

' But there is stuill a bug in normaly% i think…
' See "***"

DEF SEG = 0
pl.x = 66: pl.xtmp = 66
pl.y = 220: pl.ytmp = 220
pl.ld = 5
angf% = 1440
angtol% = 20
cols% = 320
colstep% = 1 ' Set to >1 to decrease horizontal resolution
notexture% = 0 ' Set to 1 for fast no-texture mode
colsh% = cols% / 2
DIM map(15, 15) AS INTEGER
DIM costable#(angf% — 1)
DIM sintable#(angf% — 1)
pi# = 3.14159265#
DIM buffer%(63, 448)

angh% = angf% / 2
angq% = angf% / 4
angtq% = 3 * angf% / 4

' Pre-calc sine table
PRINT «Calculating sine table...»
FOR x = 0 TO angf% — 1
PRINT (x):
y# = x / (angf% — 1)
costable#(x) = COS(y# * pi# * 2)
sintable#(x) = SIN(y# * pi# * 2)
NEXT x

' Read map data
FOR y = 0 TO 15
FOR x = 0 TO 15
READ map(x, y)
NEXT x
NEXT y

' graphic stuff
SCREEN 13

PRINT «Loading textures...»
'GOTO fake ' Do not load texture, use pattern

' Read from BMP file
OPEN «MAH_TEX2.BMP» FOR BINARY AS #1
'SEEK #1, 1079
SEEK #1, 55 + (4 * 256) + (64 * 32)
FOR y% = 447 TO 0 STEP -1
FOR x% = 0 TO 63
c% = ASC(INPUT$(1, #1))
buffer%(x%, y%) = c%
NEXT x%
NEXT y%

SEEK #1, 55
FOR x% = 0 TO 255
b% = ASC(INPUT$(1, #1)) \ 4
g% = ASC(INPUT$(1, #1)) \ 4
r% = ASC(INPUT$(1, #1)) \ 4
q% = ASC(INPUT$(1, #1))
PALETTE x%, r% + g% * 256 + b% * 256 ^ 2
NEXT x%
CLOSE #1
GOTO main


fake: ' Create procedural textures
PRINT «Generating textures...»
FOR y% = 447 TO 0 STEP -1
FOR x% = 0 TO 63
c = (x% * y%) MOD 256 ' Random
buffer%(x%, y%) = c
NEXT x%
NEXT y%


main:
' Main loop
DO
lookdir% = pl.ld
FOR ray% = 0 TO cols% STEP colstep%
pl.ld = ((lookdir% + angf% — colsh%) + ray%) MOD angf%

' horizontal detection
dis1% = -1
IF pl.ld MOD angh% > angtol% AND pl.ld MOD angh% < (angh% — angtol%) THEN
dir% = (ABS(pl.ld — angh%) / (pl.ld — angh%)) * -1
pl.xb = pl.x \ 64
pl.yb = pl.y \ 64
rest% = ABS(((pl.y MOD 64) + (64 * (dir% * -1)) + ((1 + dir%) / 2)) MOD 64)
shortx% = rest% * costable#(pl.ld) / sintable#(pl.ld) * dir%
actdef% = shortx%
nblockx% = (shortx% + pl.x) \ 64
nblocky% = pl.yb + dir%
IF nblockx% > -1 AND nblockx% < 16 THEN
'dir1% = ABS(rest% / sintable#(pl.ld))
dis1% = ABS(rest% / sintable#(pl.ld))
fblock% = map(nblockx%, nblocky%)
IF fblock% = 0 THEN
count% = 1
dis1% = -1
normalx% = 64 * (costable#(pl.ld) / sintable#(pl.ld)) * dir%
'normalx% = 64 * costable#(pl.ld) / sintable#(pl.ld) * dir%
'normalx% = 64 / costable#(pl.ld) * sintable#(pl.ld) * dir%
DO
actdef% = shortx% + (count% * normalx%)
nblockx% = (actdef% + pl.x) \ 64
nblocky% = pl.yb + (dir% * (count% + 1))
'IF nblockx% < 16 AND nblockx% > -1 THEN fblock% = map(nblockx%, nblocky%)
IF nblockx% > -1 AND nblockx% < 16 AND nblocky% > -1 AND nblocky% < 16 THEN fblock% = map(nblockx%, nblocky%)
IF fblock% > 0 THEN dis1% = ABS(rest% / sintable#(pl.ld) + (64 / sintable#(pl.ld) * count%)): count% = 11
count% = count% + 1
LOOP UNTIL count% > 10
END IF
END IF
IF dis1% <> -1 THEN dis1% = dis1% * costable#(ABS(ray% — colsh%))
texoffh% = ABS((pl.x + actdef%) MOD 64)
tex1% = fblock%
END IF

' vertical detection
dis2% = -1
IF ((pl.ld + angq%) MOD angh% > angtol%) AND ((pl.ld + angq%) MOD angh% < (angh% — angtol%)) THEN
dir% = (ABS((pl.ld MOD angtq%) — angq%) / ((pl.ld MOD angtq%) — angq%)) * -1
pl.xb = pl.x \ 64
pl.yb = pl.y \ 64
rest% = ABS(((pl.x MOD 64) + (64 * (dir% * -1)) + ((1 + dir%) / 2)) MOD 64)
'shorty% = rest% * costable#(pl.ld) / sintable#(pl.ld) * dir%
shorty% = rest% / costable#(pl.ld) * sintable#(pl.ld) * dir%
actdef% = shorty%
nblocky% = (shorty% + pl.y) \ 64
nblockx% = pl.xb + dir%
IF nblocky% > -1 AND nblocky% < 16 THEN
dis2% = ABS(rest% / costable#(pl.ld))
's# = sintable#(pl.ld)
'' IF ABS(s#) < .01 THEN s# = .01 * SGN(s#)
'IF s# >= 0# AND s# < .0001 THEN s# = .0001
'ELSE IF s# < 0# AND s# > -.0001 THEN s# = -.0001
'dis2% = ABS(rest% / s#)

fblock% = map(nblockx%, nblocky%)
IF fblock% = 0 THEN
count% = 1
dis2% = -1
normaly% = 64 / costable#(pl.ld) * sintable#(pl.ld) * dir%
DO
actdef% = shorty% + (count% * normaly%)
nblocky% = (actdef% + pl.y) \ 64
nblockx% = pl.xb + (dir% * (count% + 1))
IF nblocky% < 16 AND nblocky% > -1 THEN fblock% = map(nblockx%, nblocky%)
IF fblock% > 0 THEN dis2% = ABS(rest% / costable#(pl.ld) + (64 / costable#(pl.ld) * count%)): count% = 11
count% = count% + 1
LOOP UNTIL count% > 10
END IF
END IF
IF dis2% <> -1 THEN dis2% = dis2% * costable#(ABS(ray% — colsh%))
texoffv% = ABS((pl.y + actdef%) MOD 64)
tex2% = fblock%
END IF

vertical = 0
IF dis2% <> -1 AND dis1% = -1 THEN dis1% = dis2%: vertical = 1
IF dis2% <> -1 AND dis1% <> -1 AND dis2% < dis1% THEN dis1% = dis2%: vertical = 1
IF dis1% = -1 THEN dis1% = 0
IF vertical = 1 THEN texoffh% = texoffv%: tex1% = tex2%

IF dis1% <> 0 THEN lineh% = 200 * (65 / dis1%)
scaler# = lineh% / 64

IF tex1% <> 0 THEN
linehh% = lineh% / 2
' Draw simple color
IF notexture% > 0 THEN LINE (ray%, 100 — linehh%)-(ray%, 100 + linehh%), tex1%: GOTO skiptexture

' Draw texture
FOR pixel% = 0 TO 63
col% = buffer%(texoffh%, pixel% + ((tex1% — 1) * 64))
IF scaler# > 1 THEN
LINE (ray%, 100 — linehh% + pixel% * scaler#)-(ray%, 100 — linehh% + (pixel% + 1) * scaler#), col%
ELSE 'IF scaler# <= 1 THEN
PSET (ray%, 100 — linehh% + pixel% * scaler#), col%
END IF
NEXT pixel%
skiptexture:
END IF

IF lineh% < 200 AND lineh% > 0 THEN
LINE (ray%, 100 — linehh%)-(ray%, 0), 1 ' Sky
LINE (ray%, 100 + linehh%)-(ray%, 200), 17 ' Floor
END IF
NEXT ray%

pl.ld = lookdir%

' Keyboard

'POKE &H41A, PEEK(&H41C)
'k% = INP(&H60)
k$ = INKEY$
'LOCATE 1, 1: PRINT k$
'IF k% = 30 THEN pl.ld = pl.ld — 20
'IF k% = 32 THEN pl.ld = pl.ld + 20
IF k$ = CHR$(0) + «M» THEN pl.ld = pl.ld + 20
IF k$ = CHR$(0) + «K» THEN pl.ld = pl.ld — 20

walkdir% = (pl.ld + angq%) MOD angf%
'speed# = speed# / 2
speed# = 0
'IF k% = 17 THEN speed# = 10
'IF k% = 31 THEN speed# = -10
IF k$ = CHR$(0) + «H» THEN speed# = 10
IF k$ = CHR$(0) + «P» THEN speed# = -10

pl.ytmp = (pl.ytmp — speed# * costable#(walkdir%))
pl.xtmp = (pl.xtmp + speed# * sintable#(walkdir%))
pl.y = INT(pl.ytmp)
pl.x = INT(pl.xtmp)

pl.ld = ABS((pl.ld + angf%) MOD angf%)
LOOP UNTIL k$ = CHR$(27) 'k% = 16


' Insert Map
DATA 7,2,1,2,1,1,1,2,1,1,1,1,1,1,1,1
DATA 7,0,0,0,2,2,2,2,2,6,0,0,0,0,0,3
DATA 7,0,0,0,0,5,0,0,3,6,0,0,0,0,0,3
DATA 7,0,0,0,0,0,0,0,3,6,0,3,0,3,0,3
DATA 7,0,0,0,0,5,0,0,3,6,0,0,0,0,0,3
DATA 7,2,2,2,2,3,0,0,3,6,0,0,0,0,0,3
DATA 1,4,1,1,1,1,7,0,7,6,0,0,0,0,7,3
DATA 3,4,7,0,0,0,7,0,7,6,0,0,0,0,0,3
DATA 3,0,3,5,0,5,7,0,7,7,0,0,0,0,0,3
DATA 3,0,0,5,0,0,0,0,0,0,0,0,0,0,0,3
DATA 3,0,0,5,5,5,5,1,5,7,0,0,0,0,0,3
DATA 5,0,5,5,2,2,2,2,2,6,0,0,0,0,0,3
DATA 5,0,0,0,7,0,0,0,0,0,0,3,0,3,0,3
DATA 5,0,0,0,0,0,0,0,0,6,0,0,0,0,0,3
DATA 5,0,0,0,7,0,0,0,0,6,0,0,0,0,0,3
DATA 5,5,5,5,2,2,2,2,2,1,1,1,1,1,1,6