Posts: 1,688
Threads: 119
Joined: Jun 2003
the challenge: create a raycaster in pure qb. no other restrictions.
Jumping Jahoolipers!
Posts: 1,407
Threads: 117
Joined: Dec 2002
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
Posts: 3,288
Threads: 167
Joined: Nov 2001
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
Posts: 1,688
Threads: 119
Joined: Jun 2003
geez, that's choppy. very choppy. but still, it's pretty good for a 16 liner.
Jumping Jahoolipers!
Posts: 23
Threads: 1
Joined: Jun 2003
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
This is the end of everything, you are the end of everything." -Slipknot - Everything Ends
"GOD HATES US ALL!!" -Slayer - God Hates Us All
Posts: 1,407
Threads: 117
Joined: Dec 2002
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
Antoni
Posts: 9
Threads: 3
Joined: Jun 2003
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
Posts: 6,419
Threads: 74
Joined: Mar 2002
Posting the same thing twice: Not cool. 
Posts: 2,771
Threads: 96
Joined: Oct 2003
:barf:
Please dont dig up old topics... ^_^
Posts: 3,343
Threads: 83
Joined: Mar 2003
And that's not 6 lines, it uses the colon seperator.
|
![[Image: anya2.jpg]](http://rel.betterwebber.com/Mypics/anya2.jpg)