Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

3D ray casting code.

3 views
Skip to first unread message

S.K.

unread,
Sep 24, 1996, 3:00:00 AM9/24/96
to

Does anybody have or know where I can get a source code for 3D RAY
CASTING engine for QBasic ?

Thankx

Peter Cooper

unread,
Sep 24, 1996, 3:00:00 AM9/24/96
to

In article <32488E...@worldnet.att.net>, "S.K." <web...@worldnet.att.net>
writes

>Does anybody have or know where I can get a source code for 3D RAY
>CASTING engine for QBasic ?

Lets start this thread off again hehehe :) There was quite a bit of talk about
this a little while ago see.. heres the updated code of the engine we used to
talk about so far: (there is a pb engine too)

Newsgroups: comp.lang.basic.misc
Subject: Re: DOOM/Wolf3d engine LATEST VERSION!!!!!!! (was: Doom/Wolf 3d engine
now has bitmapped ceilings/floors!!!!!)
Date: Thu, 15 Aug 1996 23:13:58 GMT
Organization: XS4ALL, networking for the masses
Lines: 262
Message-ID: <321398b1...@news.xs4all.nl>
References: <4uosp3$d...@news-e2b.gnn.com> <4ur59s$3...@news.xs4all.nl>
<4uvhi7$c...@news-e2c.gnn.com> <4uvhp3$c...@news-e2c.gnn.com> <4uvl1b$arf@news-
e2b.gnn.com>
Reply-To: ex...@xs4all.nl
NNTP-Posting-Host: mas02-02.dial.xs4all.nl
X-XS4ALL-Date: Fri, 16 Aug 1996 00:13:07 MET DST
X-Newsreader: Forte Agent .99e/32.227

' Just a minor change, but it's good for a speed increase
' of about 30% on my P133. Changed the LINE,BF to draw the
' walls into seperate LINE's.

'=======================================================================
' RAY CASTER 3D sorta ENGINE thingymajig
'=======================================================================
' Wrote this about a month ago, it's a sort of wolfenstien\doom
' lookalike but all in native QBasic source! Uses an interesting ray
' Cheers, {:o) Peter Cooper

' Clean-up by Brent P. Newhall

' Improvments by Nick Cangiani (nic...@gnn.com)
' Sped up maketables by v Zoelen AA (vs...@xs4all.nl)
' Minor improvement by Marc vd Dikkenberg (ex...@xs4all.nl)

' Left arrow == Move left
' Right arrow == Move right
' Up arrow == Move forward
' Down arrow == Move backward
' [ESC] == Quit

DECLARE SUB screensetup ()
DECLARE SUB makeworld ()
DECLARE SUB maketables ()

DIM SHARED st%(0 TO 360)
DIM SHARED ct%(0 TO 360)
DIM SHARED a$(1 TO 10)
DIM SHARED grid(1 TO 12, 1 TO 12)
px% = 15: py% = 35: sa% = 0
PRINT "Please wait...";
RANDOMIZE TIMER
makeworld
maketables
screensetup
m% = 1
DO
IF m% = 1 THEN
IF P = 2 THEN PCOPY 2, 0 ELSE PCOPY 3, 0
IF P = 2 THEN P = 3 ELSE P = 2
m% = 0
END IF
FOR t% = sa% TO sa% + 59 STEP 1
xb = st%(t% MOD 360) / 100 'get inc
yb = ct%(t% MOD 360) / 100 'get inc
bx = px% 'decimal copy
by = py% 'decimal copy
l% = 0 'reset length
DO
bx = bx + xb
by = by + yb
l% = l% + 1
'k% = ASC(MID$(a$(CINT(by / 10)), CINT(bx / 10), 1)) - 48
k% = grid(CINT(by / 10), CINT(bx / 10))
LOOP UNTIL k% <> 0
'LOCATE 1, 1
'PRINT l%; 'this would print the distance to wall
X% = (t% - sa%) * 5
dd% = (1000 / l%)
'LINE (X%, 1)-(X% + 5, 99 - dd%), 15, BF 'paint ceiling
'LINE (X%, 101 + dd%)-(X% + 5, 200), 2, BF 'paint floor
'LINE (X%, 100 - dd%)-(X% + 5, 100 + dd%), k%, BF 'paint walls

FOR U% = 0 TO 5 'paint walls
LINE (X% + U%, 100 - dd%)-(X% + U%, 100 + dd%), k%
NEXT U%
' Could be even 20% faster: FOR U% = 0 to 4
' This will skip one line at the right of the screen, though.

LINE (X%, 100 - dd%)-(X% + 5, 100 - dd%), 0 'top lines
LINE (X%, 100 + dd%)-(X% + 5, 100 + dd%), 0 'bottom lines
NEXT t%
PCOPY 0, 1
DO: in$ = INKEY$: LOOP UNTIL in$ <> ""
SELECT CASE in$
CASE CHR$(0) + "M" ' [LEFT]
sa% = sa% + 3
m% = 1
CASE CHR$(0) + "K" ' [RIGHT]
sa% = (sa% + 357) MOD 360
m% = 1
CASE CHR$(27) ' [ESC]
quit = 1
CASE CHR$(0) + "H" ' [UP]
Oldpx% = px%: Oldpy% = py% ' Save where you are
px% = px% + (st%((sa% + 30) MOD 360) / 30)
py% = py% + (ct%((sa% + 30) MOD 360) / 30)
IF grid(CINT(py% / 10), CINT(px% / 10)) > 0 THEN 'Walking thru
walls?
SOUND 80, 1
px% = Oldpx% ' Forget it! Don't move
py% = Oldpy%
ELSE
m% = 1
END IF

CASE CHR$(0) + "P" ' [DOWN]
Oldpx% = px%: Oldpy% = py% ' Save where you are
px% = px% - (st%((sa% + 30) MOD 360) / 30)
py% = py% - (ct%((sa% + 30) MOD 360) / 30)
IF grid(CINT(py% / 10), CINT(px% / 10)) > 0 THEN 'Walking thru
walls?
SOUND 80, 1
px% = Oldpx% ' Forget it! Don't move
py% = Oldpy%
ELSE
m% = 1
END IF
END SELECT
LOOP UNTIL quit > 0
SCREEN 0
WIDTH 80, 25
SYSTEM

' Level data (this way you can have walls colored 10, 11, etc.)
' 12x12
DATA 1, 9, 1, 9, 1, 9, 1, 9, 1, 9, 1, 9
DATA 9, 0, 4, 0, 0, 0, 0, 0, 0, 5, 0, 1
DATA 1, 0,12, 0, 0, 0, 0, 0, 0,13, 0, 9
DATA 9, 0, 4, 0, 0, 0, 0, 0, 0, 5, 0, 1
DATA 1, 0,12, 0, 0, 0, 0, 0, 0,13, 0, 9
DATA 9, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1
DATA 1, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 9
DATA 9, 0,12, 0, 0, 0, 0, 0, 0, 0, 0, 1
DATA 1, 0, 4, 0, 0, 0, 0, 0, 3,11, 0, 9
DATA 9, 0,12, 0, 0, 0, 0, 0,11, 3, 0, 1
DATA 1, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 9
DATA 9, 1, 9, 1, 9, 1, 9, 1, 9, 1, 9, 1

' Old level. If you want it, come and get it.
' 1, 9, 1, 9, 1, 9, 1, 9, 1, 9
' 9, 0, 0, 0, 0, 0, 0, 0, 0, 1
' 1, 0, 0, 0, 0, 0, 0, 4, 0, 9
' 9, 0, 1, 0, 0, 0, 5, 0, 0, 1
' 1, 0, 2, 0, 0, 4, 0, 0, 0, 9
' 9, 0, 3, 0, 0, 0, 0, 0, 0, 1
' 1, 0, 0, 0, 0, 7, 8, 0, 0, 9
' 9, 0, 5, 0, 0, 8, 7, 0, 0, 1
' 1, 0, 6, 0, 0, 0, 0, 0, 0, 9
' 9, 1, 9, 1, 9, 1, 9, 1, 9, 1

SUB maketables

' Peters boring _yawn_ table creation
FOR tmp1% = 0 TO 360
st%(tmp1%) = SIN(tmp1% * .0174) * 100
'IF tmp1% MOD 100 = 0 THEN PRINT ; ".";
'NEXT tmp1%
'FOR tmp1% = 0 TO 360
ct%(tmp1%) = COS(tmp1% * .0174) * 100
'IF tmp1% MOD 100 = 0 THEN PRINT ; ".";
NEXT tmp1%

END SUB

SUB makeworld

' Read in this level's data
FOR j = 1 TO 12
FOR I = 1 TO 12
READ grid(I, j)
NEXT I
NEXT j

' Peter Coopers demonstration level. Change it if you wish! Each
number
' is a color number
'a$(1) = "1919191919"
'a$(2) = "9000000001"
'a$(3) = "1000000409"
'a$(4) = "9010005001"
'a$(5) = "1020040009"
'a$(6) = "9030000001"
'a$(7) = "1000078009"
'a$(8) = "9050087001"
'a$(9) = "1060000009"
'a$(10) = "9191919191"

END SUB

SUB screensetup

SCREEN 7
LOCATE 4
PRINT " RAYCASTER DEMO"
PRINT
PRINT " UP ARROW........Move Forward"
PRINT " DOWN ARROW......Move Backward"
PRINT " RIGHT ARROW.....Turn Right"
PRINT " LEFT ARROW......Turn Left"

SCREEN 7, , 2, 0

CLS
'WINDOW SCREEN (1, 1)-(320, 200)

' Sky
LINE (0, 0)-(300, 99), 3, BF

FOR cnt = 1 TO 10 ' Clouds
a = INT(RND * 319)
b = INT(RND * 80 + 10)
c = INT(RND * 50)
d = INT(RND * 10): d = d / 100
CIRCLE (a, b), c, 1, , , d: PAINT (a, b), 1
CIRCLE (a, b), c, 15, , , d: PAINT (a, b), 15
NEXT cnt
LINE (301, 0)-(319, 199), 0, BF ' Erase clouds on right

' Obelisk
'LINE (200, 20)-(240, 99), 0, BF
'LINE (201, 21)-(239, 98), 8, BF

LINE (200, 20)-(220, 15), 8 ' Building (gray)
LINE (220, 15)-(240, 20), 8
LINE (200, 20)-(200, 99), 8
LINE (240, 20)-(240, 99), 8
LINE (200, 99)-(240, 99), 8
PAINT (220, 50), 8
FOR cnt = 1 TO 20 ' Lights
PSET (INT(RND * 38 + 201), INT(RND * 80 + 20)), 14
NEXT cnt
LINE (200, 20)-(220, 15), 0 ' Building (border)
LINE (220, 15)-(240, 20), 0
LINE (219, 15)-(219, 99), 0
LINE (200, 20)-(200, 99), 0
LINE (240, 20)-(240, 99), 0

' Sun
CIRCLE (50, 30), 10, 14: PAINT (50, 30), 14, 14

PCOPY 2, 3

FOR Y% = 100 TO 199
FOR X% = 0 TO 300
IF RND > .5 THEN c% = 6 ELSE c% = 0
PSET (X%, Y%), c%
NEXT X%
NEXT Y%

SCREEN 7, , 3, 0
FOR Y% = 100 TO 199
FOR X% = 0 TO 300
IF RND > .5 THEN c% = 6 ELSE c% = 0
PSET (X%, Y%), c%
NEXT X%
NEXT Y%

SCREEN 7, , 0, 1

END SUB

Marc van den Dikkenberg
-----------------------------o---------------------
http://145.89.78.151/~excel | Programming Archives
http://www.xs4all.nl/~excel | antU, Humour, Sci-Fi

Cheers! :)

--
Peter Cooper

0 new messages