Carl Mahnke Raycaster in QBasic

' Shown by Carl Mahnke, but now offline
' https://www.youtube.com/watch?v=3Qpht8dSps8
' http://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