Qbasicnews.com
February 28, 2020, 06:42:10 PM *
Welcome, Guest. Please login or register.

Login with username, password and session length
News: Back to Qbasicnews.com | QB Online Help | FAQ | Chat | All Basic Code | QB Knowledge Base
 
   Home   Help Search Login Register  
Pages: [1]
  Print  
Author Topic: raycaster challenge  (Read 5924 times)
barok
Na_th_an
*****
Posts: 1727


How about a tasty lead sandwich?


« on: June 29, 2003, 11:36:17 PM »

the challenge: create a raycaster in pure qb.  no other restrictions.
Logged

Jumping Jahoolipers!
Antoni Gual
Na_th_an
*****
Posts: 1434



WWW
« Reply #1 on: June 30, 2003, 06:44:03 PM »

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

Logged

Antoni
relsoft
*/-\*
*****
Posts: 3927



WWW
« Reply #2 on: July 01, 2003, 12:19:57 AM »

16 lines...

Code:

'MiniRaycaster
'Relsoft 2003
'June 30,2003
'KEYS:
'LShift= Move Forward
'L CTRL = LEFT
'L ALT = RIGHT
'Sheesh!!! 16 lines. Pthhhh
'I got a 13 line Raycaster but I forgot its filename. ;*(

'*****NOTE: YOU HAVE TO WAIT A WHILE TO SEE THE MAP*********

1  IF I& = 0 THEN SCREEN 7, , 1, 2 ELSE DIM MAP(0 TO 21, 0 TO 25) AS INTEGER
2  IF I& < 572 THEN READ MAP(I& MOD 22, I& \ 22) ELSE PCOPY 1, 2
3  I& = I& + 1
4  IF I& AND 1 THEN Xv! = Xv! - ABS((PEEK(1047) AND 2) = 2) * ((COS((CSNG(Heading%) * ((ATN(1) * 8) / 360))) * .1) * 4) ELSE Yv! = Yv! - ABS((PEEK(1047) AND 2) = 2) * ((SIN((CSNG(Heading%) * ((ATN(1) * 8) / 360))) * .1) * 4)
5  IF I& AND 1 THEN Heading% = (Heading% - ((PEEK(1047) AND 4) = 4) * 15) MOD 360 ELSE Heading% = ((Heading% - (360 - ((PEEK(1047) AND 8) = 8) * 15)) MOD 360)
6  IF I& = 1 THEN Xv! = 1 ELSE LINE (0, 0)-(319, 199), 0, BF
7  IF I& = 2 THEN Yv! = 1 ELSE drawover% = 0
8  FOR A% = Heading% + 32 TO Heading% - 31 STEP -2
9    IF I& = 1 THEN DEF SEG = 0 ELSE Leng% = 0
10   IF I& = 2 THEN Heading% = 180 ELSE Leng% = Leng% + 1
11   IF I& > 572 THEN IF MAP(Xv! - (COS((CSNG(A%) * ((ATN(1) * 8) / 360))) * .1) * Leng%, Yv! - (SIN((CSNG(A%) * ((ATN(1) * 8) / 360))) * .1) * Leng%) = 0 THEN 10 ELSE LINE (drawover%, 100 - (900 \ Leng%))-STEP(9, (900 \ Leng%) * 2), MAP(Xv! - (COS( _
(CSNG(A%) * ((ATN(1) * 8) / 360))) * .1) * Leng%, Yv! - (SIN((CSNG(A%) * ((ATN(1) * 8) / 360))) * .1) * Leng%), BF
12   drawover% = drawover% + 10
13 NEXT A%
14 IF INKEY$ <> CHR$(27) THEN 2
DATA  3,11, 3,11, 3,11, 3,11, 3,11, 3,11, 3,11, 3,11, 3,11, 3,11, 3,11,11, 0, 0, 0, 0, 0, 0, 0, 0, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3,3, 0, 0, 0, 0, 0, 0, 0, 0, 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ,0,11,11, 0, 0, 12, 0, 0, 12, 0, 0, 6, 0, 0, 0, 0, 0, 0, 0, 0,15, 0, 0, 3,3, 0, 0, 0, 0, 0, 0, 0, 0, 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ,0,11,11, 0, 0, 0, 0, 0, 0, 0, 0, 6, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 3,3, 0, 0, 12, 0, 0, 12, 0, 0, 5, 0, 0, 0,12, 0, 0, 0, 0, 0, 0 ,0,11,11, 0, 0, 0, 0, 0, 0, 0, 0, 6, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 3,3, 0, 0, 0, 0, 0, 0, 0, 0, 5, 0, 0, 0,12, 0, 0, 0, 0, 0, 0 ,0,11,11, 0, 0, 12, 0, 0, 12, 0, 0, 6, 0, 0, 0, 4,12, 4,12, 4,12, 0, 0, 3,3, 0, 0, 0, 0, 0, 0, 0, 0, 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ,0,11,11, 0, 0, 0, 0, 0, 0, 0, 0, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3,3, 2,10, 2,10, 2,10, 0, 0, 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ,0,11,11, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3,3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ,0,11
DATA  11, 0, 0, 0, 0, 0, 0, 9, 0, 0, 0, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3,3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4,12, 4,12, 4,12, 0 ,0,11,11, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0, 0, 0, 3,3, 0, 0, 7, 8, 7, 8, 7, 8, 7, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0 ,0,11,11, 0, 0, 0, 0, 0,14, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0, 0, 0, 3,3, 0, 0, 0, 0, 0,10, 0, 0, 0, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0 ,0,11,11, 0, 0, 0, 0, 0,14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3,3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,15, 0 ,0,11,11, 0, 0, 0, 0, 0,14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3,3, 0, 0, 0, 0, 0,10, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ,0,11,11, 3,11, 3,11, 3,11, 3,11, 3,11, 3,11, 3,11, 3,11, 3,11, 3,11, 3

Logged

y smiley is 24 bit.


Genso's Junkyard:
http://rel.betterwebber.com/
barok
Na_th_an
*****
Posts: 1727


How about a tasty lead sandwich?


« Reply #3 on: July 01, 2003, 02:00:33 AM »

geez, that's choppy.  very choppy.  but still, it's pretty good for a 16 liner.
Logged

Jumping Jahoolipers!
HystericPoison
New Member

Posts: 23



WWW
« Reply #4 on: July 02, 2003, 01:59:10 PM »

i cant get the 16-liner to work....kept getting out of data...

oh well, whatever

i like the first one by Antoni Gual, really nice, even though i didnt have that library ffix, all i did was get rid of that "ffix" line and it worked fine
Logged

This is the end of everything, you are the end of everything." -Slipknot - Everything Ends

"GOD HATES US ALL!!" -Slayer - God Hates Us All
Antoni Gual
Na_th_an
*****
Posts: 1434



WWW
« Reply #5 on: July 02, 2003, 04:59:42 PM »

Ffix just adds speed to the program. The raycaster can be  run without ffix, just uncomment the two lines were ffix is mentioned and it should work fine.
If you are interested, i have a copy of fffix at my site.


And this one is probably the best pure QB raycaster http://math.artshost.com/1psqb-a8.bas
Logged

Antoni
ravenxau
New Member

Posts: 9


« Reply #6 on: March 31, 2004, 08:25:35 AM »

6 lines!
Code:
1 DIM L(7, 7): FOR Y = 0 TO 7: FOR X = 0 TO 7: READ L(X, Y): NEXT X: NEXT Y: X = 24: Y = 24: F = 45: SCREEN 1
2 FOR S = -160 TO 149 STEP 10: R = F + (S * .1875): R = R + 360 * ((R > 360) - (R < 0)): XI = COS(R / 57): YI = SIN(R / 57): X1 = X: Y1 = Y
3 X1 = X1 + XI: Y1 = Y1 + YI: IF L(X1 / 16, Y1 / 16) = 0 THEN GOTO 3
4 D = ABS((X - X1) / COS(R / 57)): H = (1816 / D): LINE (S + 160, 100 - H)-(S + 169, 100 + H), 1, BF: LINE (S + 160, 0)-(S + 169, 99 - H), 0, BF: LINE (S + 160, 101 + H)-(S + 169, 320), 0, BF
5 NEXT S: A$ = INKEY$: F = F + 5 * (A$ = ",") - 5 * (A$ = "."): F = F - 355 * (F = -5) + 360 * (F = 365): IF A$ = " " AND (L((X + COS(F / 57)) / 16, (Y + SIN(F / 57)) / 16) = 0) THEN X = X + COS(F / 57): Y = Y + SIN(F / 57)
6 GOTO 2: DATA 1,1,1,1,1,1,1,1,1,0,0,1,0,0,0,1,1,1,0,1,0,1,0,1,1,0,0,0,0,1,0,1,1,0,1,1,0,1,0,1,1,0,1,1,0,1,1,1,1,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1
Logged
na_th_an
*/-\*
*****
Posts: 8244



WWW
« Reply #7 on: March 31, 2004, 09:26:53 AM »

Posting the same thing twice: Not cool. Sad
Logged

SCUMM (the band) on Myspace!
ComputerEmuzone Games Studio
underBASIC, homegrown musicians
[img]http://www.ojodepez-fanzine.net/almacen/yoghourtslover.png[/i
KiZ
__/--\__
*****
Posts: 2879


WWW
« Reply #8 on: March 31, 2004, 11:24:00 AM »

:barf:

Please dont dig up old topics... ^_^
Logged
oracle
*/-\*
*****
Posts: 3652



WWW
« Reply #9 on: March 31, 2004, 07:45:28 PM »

And that's not 6 lines, it uses the colon seperator.
Logged

adosorken
*/-\*
*****
Posts: 3655



WWW
« Reply #10 on: March 31, 2004, 08:08:55 PM »

Quote from: "dark_prevail"
Please dont dig up old topics... ^_^

Oh will you people find something legitimate to complain about!  :evil:  :Huh:  :-?  Sad  :cry:
Logged

I'd knock on wood, but my desk is particle board.
KiZ
__/--\__
*****
Posts: 2879


WWW
« Reply #11 on: April 01, 2004, 07:42:01 AM »

sorry, ado, its just that when i see this topic, i think wow!
A new challenge, i go in and see that lots of people have
entered. Wow! How could I have missed this?

read through the posts... hang on... this is a year old!!??!?!

That is just slightly annoying. Dont tell me its not. It is. ok?
Logged
Rokkuman
Na_th_an
*****
Posts: 1973



« Reply #12 on: April 01, 2004, 12:24:00 PM »

Quote from: "dark_prevail"
That is just slightly annoying. Dont tell me its not. It is. ok?



It's not... I don't care if people bring up a topic that Jesus himself created, as long as they posted something legitament, and not something stupid like, "hahahahaha"...
Logged
KiZ
__/--\__
*****
Posts: 2879


WWW
« Reply #13 on: April 01, 2004, 02:38:24 PM »

Oh calm down.


and btw, you dont rule.... sheesh.
Logged
Pages: [1]
  Print  
 
Jump to:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2015, Simple Machines Valid XHTML 1.0! Valid CSS!