Floormapper plus - Printable Version

Code:
DECLARE SUB docloud (k%)

DECLARE SUB raytrace ()

'DECLARE SUB ffix ()



'rotating floormaper by Antoni Gual 8/2004      



'ffix

SCREEN 13



DIM SHARED tex(31, 31, 1) AS INTEGER       'texture array

DIM SHARED kbd(128) AS INTEGER              'keyboard reader array

DIM SHARED frames%

DIM SHARED persplut(-200 TO 200) AS SINGLE  'vertical offsets for roof and floor



'read map,do fixed part of persp lut (sky is always in the infinite)



FOR i% = -200 TO -1

    persplut(i%) = 25590 / i%

    persplut(-i%) = -25590 / i%

NEXT



'cloudy texture 1

docloud 1



'cloudy texture for sky

docloud 0



'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, 63 - i% / 2: OUT &H3C9, 63 - i% / 2: OUT &H3C9, 63

NEXT



CLS

COLOR 128

PRINT "Floormapper by Antoni Gual"

PRINT

PRINT "number pad to move around"

PRINT "Q and A    to tilt horizon"

PRINT

PRINT "Press any key..."

a$ = INPUT$(1)



'erase key buffer and set num lock off

DEF SEG = &H40: POKE &H1C, PEEK(&H1A): POKE &H17, PEEK(&H17) AND NOT 32



'launch raytracer

tim! = TIMER

frames% = 0

raytrace

LOCATE 1, 1: PRINT frames% / (TIMER - tim!)

a$ = INPUT$(1)

END



SUB docloud (k%)

d1% = 64

d% = 32

tex(0, 0, k%) = 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%, k%) = (tex(i%, j%, k%) + tex((i% + d%) AND 31, j%, k%) + (RND - .5) * d1%) / 2

      tex(i%, (j% + d2%) AND 31, k%) = (tex(i%, j%, k%) + tex(i%, (j% + d%) AND 31, k%) + (RND - .5) * d1%) / 2

      tex((i% + d2%) AND 31, (j% + d2%) AND 31, k%) = (tex(i%, j%, k%) + tex((i% + d%) AND 31, (j% + d%) AND 31, k%) + (RND - .5) * d1%) / 2

  NEXT j%, i%

  d1% = d1% / 2

  d% = d2%

WEND



END SUB



SUB raytrace

CONST rtf = 2048

CONST rtl = .0001

CONST inf = 3000000

CONST incu = .05

xpos = 1.5

ypos = 1.5

angle = 0

tilt = 0

ini% = 1

'frames loop

d1% = -1

d2% = 1



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

      turn% = kbd(&H4D) - kbd(&H4B)': kbd(&H4D) = 0: kbd(&H4B) = 0

      mov% = kbd(80) - kbd(72) + ini%': kbd(80) = 0: kbd(72) = 0

      dtilt% = kbd(16) - kbd(30) + ini%

    END IF

    'a movement has happened, update and collision detect

    IF turn% OR mov% OR dtilt% THEN

       

        angle = angle + turn% * .1

        tilt = tilt + dtilt% * .1

        dct = COS(tilt)

        dst = SIN(tilt)

        

        IF ini% THEN ini% = 0

        dys = SIN(angle) * incu

        dxs = dys / 160

        dxc = COS(angle) * incu

        dyc = dxc / 160

       

        xpos = xpos - dxc * mov%

        xpos32 = xpos * 32

       

        ypos = ypos - dys * mov%

        ypos32 = ypos * 32

     END IF

      'rendering  loop (too many products and divisions)

      DEF SEG = &HA000

      p1& = 0

      FOR y1% = -100 TO 99

        yc! = y1% * dct

        ys! = y1% * dst

        p& = p1&

        FOR x1% = -160 TO 159

        x% = x1% * dct - ys!

        y% = yc! + x1% * dst

        dx = dxc - x% * dxs

        dy = x% * dyc + dys

            pl = persplut(y%)

            SELECT CASE y%

            'sky

            CASE IS < d1%

                tt% = 128 + tex((xpos32 - dx * pl) AND 31, (ypos32 - dy * pl) AND 31, 0)

            'wall

            CASE IS < d2%

                tt% = 138

            'ground

            CASE ELSE

                tt% = 44 + tex((xpos32 + dx * pl) AND 31, (ypos32 + dy * pl) AND 31, 1)

            END SELECT

            POKE p&, tt%

            p& = p& + 1

        NEXT x1%

       p1& = p1& + 320

    NEXT y1%

LOOP

END SUB