Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
raycaster challenge
#2
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
Reply


Messages In This Thread
raycaster challenge - by barok - 06-30-2003, 07:36 AM
raycaster challenge - by Antoni Gual - 07-01-2003, 02:44 AM
raycaster challenge - by relsoft - 07-01-2003, 08:19 AM
raycaster challenge - by barok - 07-01-2003, 10:00 AM
raycaster challenge - by HystericPoison - 07-02-2003, 09:59 PM
raycaster challenge - by Antoni Gual - 07-03-2003, 12:59 AM
raycaster challenge - by ravenxau - 03-31-2004, 04:25 PM
raycaster challenge - by na_th_an - 03-31-2004, 05:26 PM
raycaster challenge - by KiZ - 03-31-2004, 07:24 PM
raycaster challenge - by oracle - 04-01-2004, 03:45 AM
raycaster challenge - by adosorken - 04-01-2004, 04:08 AM
raycaster challenge - by KiZ - 04-01-2004, 03:42 PM
raycaster challenge - by Rokkuman - 04-01-2004, 08:24 PM
raycaster challenge - by KiZ - 04-01-2004, 10:38 PM

Forum Jump:


Users browsing this thread: 1 Guest(s)