CODE repost: WOLF3D.BAS
Brent P. Newhall
' Here's the Wolfenstein 3D-esque code originally posted a couple of
' months ago. Read the post "Doom.bas: The Legacy" for more info.
' Check for weird line lengths to the width of this post.
'=======================================================================
' 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
' tracing technique could be optimized x1000 Infact, it's being
' converted to ASM and stuff like textures will be added and maybe a bit
' of shading
'
' Anyway, this code is _public domain_, change it, modify it, whatever,
' it only took about 40 mins in total, So whatever.. you have fun with
' it <grin>
'
' Cheers, {:o) Peter Cooper
' Minor clean-up by Brent P. Newhall (bneh...@gmu.edu)
' Up arrow == Move forward
' Left arrow == Move left
' Right arrow == Move right
' [ESC] == Quit
' Ceilings/floors added by Nick Cangiani
' nic...@gnn.com
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) AS INTEGER
REDIM sky(1 TO 100, 0 TO 302) AS INTEGER
REDIM sky1(1 TO 100, 1 TO 1) AS INTEGER
px% = 15: py% = 35: sa% = 0
PRINT "Please wait...";
RANDOMIZE TIMER
makeworld
maketables
screensetup
m% = 1
P = 3
DO
IF m% = 1 THEN
PCOPY P, 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
MonstK% = 0
DO
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
IF k% < 0 THEN
MonstK% = -k%
MonstX% = (t% - sa%) * 5
MonstDD% = (1000 / l%) / 5
END IF
LOOP UNTIL k% > 0
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
FOR cnt = 0 TO 4 'paint walls
LINE (x% + cnt, 100 - dd%)-(x% + cnt, 100 + dd%), k%
NEXT cnt
LINE (x%, 100 - dd%)-(x% + 4, 100 - dd%), 0 'top line
LINE (x%, 100 + dd%)-(x% + 4, 100 + dd%), 0 'bottom line
IF MonstK% > 0 THEN
FOR cnt = 0 TO 4
LINE (MonstX% + cnt, 100 - MonstDD%)-(MonstX% + cnt, 100 +
MonstDD%), MonstK%
NEXT cnt
END IF
NEXT t%
PCOPY 0, 1
DO: in$ = INKEY$: LOOP UNTIL in$ <> ""
SELECT CASE in$
CASE CHR$(0) + "M" ' [LEFT]
sa% = sa% + 3
IF sa% > 360 THEN sa% = sa% - 360
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 through
walls?
px% = Oldpx% ' Forget it! Don't move
py% = Oldpy%
END IF
m% = 1
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,-4, 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
DATA 1, 9, 1, 9, 1, 9, 1, 9, 1, 9
DATA 9, 0, 0, 0, 0, 0, 0, 0, 0, 1
DATA 1, 0, 0, 0, 0, 0, 0, 4, 0, 9
DATA 9, 0, 1, 0, 0, 0, 5, 0, 0, 1
DATA 1, 0, 2, 0, 0, 4, 0, 0, 0, 9
DATA 9, 0, 3, 0, 0, 0, 0, 0, 0, 1
DATA 1, 0, 0, 0, 0, 7, 8, 0, 0, 9
DATA 9, 0, 5, 0, 0, 8, 7, 0, 0, 1
DATA 1, 0, 6, 0, 0, 0, 0, 0, 0, 9
DATA 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 ; ".";
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, , 2, 0 ' Write on page 2
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 (300, 0)-(319, 199), 0, BF ' Clear up 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 ' Now both 2 and 3 have a sky, sun, and clouds
' \/ Draw pixels on page 2
FOR y% = 100 TO 199
FOR x% = 0 TO 298
IF RND > .5 THEN c% = 6 ELSE c% = 0
PSET (x%, y%), c%
NEXT x%
NEXT y%
SCREEN 7, , 3, 0
' \/ Draw pixels on page 3
FOR y% = 100 TO 199 'STEP 2
FOR x% = 0 TO 298 'STEP 2
IF RND > .5 THEN c% = 6 ELSE c% = 0
PSET (x%, y%), c%
'LINE (X%, Y%)-(X% + 1, Y% + 1), c%, B
NEXT x%
NEXT y%
SCREEN 7, , 0, 1
END SUB