'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

