The next improvement I am working on is to add bitmapped wall sections. This
should not be too hard.
Let me know what you think!
nic...@gnn.com
'=======================================================================
' 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
' Left arrow == Move left
' Right arrow == Move right
' [SPACE] == Move
' [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)
px% = 15: py% = 15: sa% = 0
PRINT "Please wait...";
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
LOOP UNTIL k% <> 0
'LOCATE 1, 1
'PRINT l%; 'this would print the distance to wall from player
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
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 " " '[SPACE]
px% = px% + (st%(t% MOD 360) / 50)
py% = py% + (ct%(t% MOD 360) / 50)
m% = 1
END SELECT
LOOP UNTIL quit > 0
SCREEN 0
WIDTH 80, 25
SYSTEM
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
' 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
CLS
'WINDOW SCREEN (1, 1)-(320, 200)
LINE (0, 0)-(300, 99), 3, BF
CIRCLE (50, 30), 10, 14: PAINT (50, 30), 14, 14
LINE (200, 20)-(240, 99), 0, BF
LINE (201, 21)-(239, 98), 8, BF
PCOPY 2, 3
FOR Y% = 100 TO 199
FOR X% = 0 TO 300
C% = INT(RND * 2)
IF C% = 1 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
C% = INT(RND * 2)
IF C% = 1 THEN C% = 6 ELSE C% = 0
PSET (X%, Y%), C%
NEXT X%
NEXT Y%
SCREEN 7, , 0, 1
END SUB
Could someone explain me how the blocks in the scene are defined?
I really wonder about this. I can't [yet] figure this out.
I know it has something to do with the color table in MakeWorld.
Bram
BTW. The SUB MakeTable could be speed up 100% by just removing a few
lines. I have marked them for you.
'=======================================================================
' 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
' Left arrow == Move left
' Right arrow == Move right
' [SPACE] == Move
' [ESC] == Quit
' Ceilings/floors added by Nick Cangiani
' nic...@gnn.com
' Wall collision detection added by v Zoelen AA
' vs...@xs4all.nl
IF L% > 1 THEN <----- Collision detection
px% = px% + (st%(t% MOD 360) / 50)
py% = py% + (ct%(t% MOD 360) / 50)
m% = 1
END IF
END SELECT
LOOP UNTIL quit > 0
SCREEN 0
WIDTH 80, 25
SYSTEM
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 ; ".";
[snip]
> The next improvement I am working on is to add bitmapped wall sections.
> Th is should not be too hard.
> Let me know what you think!
> nic...@gnn.com
It looks good. But its rather slow. May i suggest to continue this nice
project in PowerBasic. I've tried this in PB and got it running and its
really running. I think its possible to push it close to a doom style
game.
Just a tought.
Bram
Yes. Each line is a row of a grid in the world and each digit is one
square.. Change some of the numbers to 0 to see what I mean =)
>Bram
>BTW. The SUB MakeTable could be speed up 100% by just removing a few
>lines. I have marked them for you.
Thanks. I'll make that change for v1.02 - v1.01 just went out btw, =)
There are MANY bugs, and problems. I want to change the whole way the
thing works out the distance of the walls.
I've talked about this in the other thread. Thanks for the ideas.
_/_/_/ e t e r C o o p e r pe...@trenham.demon.co.uk
_/ / ~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~
_/_/_/
_/ http://www.trenham.demon.co.uk/
_/ 'I'm lost in the sea of desire..'
'=======================================================================
' 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
' Left arrow == Move left
' Right arrow == Move right
' [SPACE] == Move
' [ESC] == Quit
' Ceilings/floors added by Nick Cangiani
' nic...@gnn.com
' Sped up maketables routine added by v Zoelen AA
' vs...@xs4all.nl
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 from player
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
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 " " ' [SPACE]
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?
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, 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, , 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%
' OK, this is my latest revision of Peter Cooper's raycast engine. Well,
' actually what I've done is to improve it a lot on my own, and add in
' the best improvements that others have made. In this version:
'
' Move backwards (DOWN ARROW) and forwards (UP ARROW)
' Sounding collision
' No animation on collision
' Collision detection
' Obelisk for backgrounds
' "Moving" floor
' Sped up trig table creation
' Move straight insead of crooked
' Movement seems faster with new table creation
' Better way to define the world
' More colors availible in world
'
' My next improvement will most likely allow for the shooting of projectiles
'
'=======================================================================
' 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
' Clean-up by Brent P. Newhall
' Improvments by Nick Cangiani (nic...@gnn.com)
' Sped up maketables by v Zoelen AA (vs...@xs4all.nl)
' Left arrow == Move left
' Right arrow == Move right
' Up arrow == Move forward
' Down arrow == Move backward
' [ESC] == Quit
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
SUB maketables
END SUB
SUB makeworld
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"
I just sat and painstakingly converted the program into Pascal which
also uses my asm mode 13 unit. It runs about hmm.. 12-15 frames a second
I'd say.
If anyone wants it then gimme a buzz. It's only a direct from basic
translation, I have to optimize with asm now.. bah
Cheers,
I can write the whole thang in assembler, PowerBasic can cope with that
cant it? If you're insistant on using PB 3 then jeez, I might have to
go buy it once and for all! =)
>Just a tought.
>Bram
'=======================================================================
' 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)
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.
SUB maketables
END SUB
SUB makeworld
END SUB
SUB screensetup
PCOPY 2, 3
END SUB
Marc van den Dikkenberg
-----------------------------o---------------------
http://145.89.78.151/~excel | Programming Archives
http://www.xs4all.nl/~excel | antU, Humour, Sci-Fi
[snip]
> I can write the whole thang in assembler, PowerBasic can cope with that
> cant it? If you're insistant on using PB 3 then jeez, I might have to
> go buy it once and for all! =)
Writting it completly in assembler isn't what i mean. And i know for sure
that you know what i mean. I just did a few very rough and quick changes
to make it run under PB 3.1 Only statement changes to let raycast be
accepted by the PB compiler. And the gain in speed is remarkable. I am
not waiting to clutch code full with assembly. Basic is just fine. And
in this case will wait till the time raycast has become almost complete
and i will translate it again in such way it will run under PB. Its
deserves to run under PB also. Just because its a great piece of code.
[it also shows to power of the internet as you see how this code is
evolute to.. Yes to what <g>]
Bram
Could you help me. I am making a game when i run it for a while it
tells me that it is out of stack space. When I use clear it freezes the
program.
what should i do.
>In <321398b1...@news.xs4all.nl> ex...@xs4all.nl (Marc van den
>Dikkenberg) writes:
(hopelessly long code snipped)
>>Marc van den Dikkenberg
>>-----------------------------o---------------------
>>http://145.89.78.151/~excel | Programming Archives
>>http://www.xs4all.nl/~excel | antU, Humour, Sci-Fi
>
>
>Could you help me. I am making a game when i run it for a while it
>tells me that it is out of stack space. When I use clear it freezes the
>program.
>what should i do.
>
>
If you want to add a message, please don't reply to an unrelated post.
Even if you do, at least snip it down! I didn't need to download yet
another copy of the Doom/Wolf3d thing. Maybe I'll try sometime...
Here is a new version (I merely added my keyboard ISR to the last). Don't be afraid to
hold down multiple keys! :)
Oh yeah--and I got rid of that wrap around (I use a small font--you'll have to scroll to
read this I think).
--------------------------------------------------------------
DECLARE SUB screensetup ()
DECLARE SUB makeworld ()
DECLARE SUB maketables ()
DECLARE SUB SETVECT (S AS INTEGER, O AS INTEGER, I AS INTEGER)
DECLARE SUB GETVECT (S AS INTEGER, O AS INTEGER, I AS INTEGER)
DECLARE SUB KEYBOARD.IN (OLDSEG AS INTEGER, OLDOFF AS INTEGER)
DECLARE SUB KEYBOARD.OUT (OLDSEG AS INTEGER, OLDOFF AS INTEGER)
'$STATIC
CONST NUM.KEYS = 10
CONST INDEX.UP = 0
CONST INDEX.DOWN = 1
CONST INDEX.LEFT = 2
CONST INDEX.RIGHT = 3
CONST INDEX.CTRL = 4
CONST INDEX.ALT = 5
CONST INDEX.SPACE = 6
CONST INDEX.ESC = 7
CONST INDEX.ENTER = 8
CONST INDEX.RSHIFT = 9
DIM SHARED KEY.TABLE(0 TO (NUM.KEYS - 1)) AS INTEGER
DIM SHARED RAWKEY AS INTEGER
DIM SHARED OLD.ISR.SEG AS INTEGER, OLD.ISR.OFF AS INTEGER
CALL KEYBOARD.IN(OLD.ISR.SEG, OLD.ISR.OFF)
' 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
DIM SHARED st%(0 TO 360)
RAWKEY = 0: WHILE RAWKEY = 0: WEND
IF KEY.TABLE(INDEX.RIGHT) THEN ' [LEFT]
sa% = sa% + 3
m% = 1
END IF
IF KEY.TABLE(INDEX.LEFT) THEN ' [RIGHT]
sa% = (sa% + 357) MOD 360
m% = 1
END IF
IF KEY.TABLE(INDEX.ESC) THEN ' [ESC]
quit = 1
END IF
IF KEY.TABLE(INDEX.UP) THEN ' [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
END IF
IF KEY.TABLE(INDEX.DOWN) THEN '[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 IF
LOOP UNTIL quit > 0
SCREEN 0
WIDTH 80, 25
CALL KEYBOARD.OUT(OLD.ISR.SEG, OLD.ISR.OFF)
SYSTEM
SUB GETVECT (S AS INTEGER, O AS INTEGER, I AS INTEGER)
'GETVECT RETURNS THE ADDRESS OF A FUNCTION POINTED TO IN THE
'INTERRUPT VECTOR TABLE (STARTS AT 0000:0000H)
STATIC ASM AS STRING 'THE CODE FOR GETVECT
STATIC INI AS INTEGER 'USED TO DETECT WHETHER GETVECT HAS PREVIOUSLY
'BEEN CALLED
IF INI = 0 THEN
'CREATE ML FUNCTION IF NOT ALREADY CREATED
ASM = ASM + CHR$(&H55) 'PUSH BP
ASM = ASM + CHR$(&H89) + CHR$(&HE5) 'MOV BP,SP
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6) 'MOV BX,[BP+06]
ASM = ASM + CHR$(&H8A) + CHR$(&H7) 'MOV AL,[BX]
ASM = ASM + CHR$(&HB4) + CHR$(&H35) 'MOV AH,35
ASM = ASM + CHR$(&HCD) + CHR$(&H21) 'INT 21
ASM = ASM + CHR$(&H53) 'PUSH BX
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA) 'MOV BX,[BP+0A]
ASM = ASM + CHR$(&H8C) + CHR$(&H7) 'MOV [BX],ES
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8) 'MOV BX,[BP+08]
ASM = ASM + CHR$(&H58) 'POP AX
ASM = ASM + CHR$(&H89) + CHR$(&H7) 'MOV [BX],AX
ASM = ASM + CHR$(&H5D) 'POP BP
ASM = ASM + CHR$(&HCA) + CHR$(&H6) + CHR$(&H0) 'RETF 0006
INI = 1 'FLAG CREATION
END IF
DEF SEG = VARSEG(ASM)
CALL ABSOLUTE(S, O, I, SADD(ASM)) 'RUN FUNCTION
END SUB
SUB KEYBOARD.IN (OLDSEG AS INTEGER, OLDOFF AS INTEGER)
DIM RSGL AS INTEGER, RSGH AS INTEGER 'SEGMENT OF RAWKEY
DIM ROFL AS INTEGER, ROFH AS INTEGER 'OFFSET OF RAWKEY
DIM KSGL AS INTEGER, KSGH AS INTEGER 'SEGMENT OF KEY.TABLE
DIM KOFL AS INTEGER, KOFH AS INTEGER 'OFFSET OF KEY.TABLE
DIM BYTE AS STRING * 1 'USED TO ACTIVATE IRQ 1 IN PIC
STATIC ASM AS STRING 'HOLDS ISR
RSGL = VARSEG(RAWKEY) AND &HFF 'LOAD LOW "BYTE" SEGMENT
RSGH = INT(VARSEG(RAWKEY) / 256) AND &HFF 'LOAD HIGH "BYTE" SEGMENT
ROFL = VARPTR(RAWKEY) AND &HFF 'LOAD LOW "BYTE" OFFSET
ROFH = INT(VARPTR(RAWKEY) / 256) AND &HFF 'LOAD HIGH "BYTE" OFFSET
KSGL = VARSEG(KEY.TABLE(0)) AND &HFF 'LOAD LOW "BYTE" SEGMENT
KSGH = INT(VARSEG(KEY.TABLE(0)) / 256) AND &HFF 'LOAD HIGH "BYTE" SEGMENT
KOFL = VARPTR(KEY.TABLE(0)) AND &HFF 'LOAD LOW "BYTE" OFFSET
KOFH = INT(VARPTR(KEY.TABLE(0)) / 256) AND &HFF 'LOAD HIGH "BYTE" OFFSET
'THIS IS THE ISR. IT READS A SCANCODE FROM THE KEYBOARD BUFFER
'AND RESETS IT. THE BEST PART IS, BIOS CAN'T TOUCH IT!
ASM = ""
ASM = ASM + CHR$(&H52) 'PUSH DX
ASM = ASM + CHR$(&H51) 'PUSH CX
ASM = ASM + CHR$(&H53) 'PUSH BX
ASM = ASM + CHR$(&H50) 'PUSH AX
ASM = ASM + CHR$(&H6) 'PUSH ES
ASM = ASM + CHR$(&H57) 'PUSH DI
ASM = ASM + CHR$(&H1E) 'PUSH DS
ASM = ASM + CHR$(&H56) 'PUSH SI
ASM = ASM + CHR$(&HFB) 'STI
ASM = ASM + CHR$(&HBA) + CHR$(&H60) + CHR$(&H0) 'MOV DX,0060
ASM = ASM + CHR$(&HEC) 'IN AL,DX
ASM = ASM + CHR$(&H30) + CHR$(&HE4) 'XOR AH,AH
ASM = ASM + CHR$(&HBA) + CHR$(RSGL) + CHR$(RSGH)'MOV DX,SEG RAWKEY
ASM = ASM + CHR$(&H8E) + CHR$(&HDA) 'MOV DS,DX
ASM = ASM + CHR$(&HBE) + CHR$(ROFL) + CHR$(ROFH)'MOV SI,OFFSET RAWKEY
ASM = ASM + CHR$(&H88) + CHR$(&H4) 'MOV [SI],AL
ASM = ASM + CHR$(&H50) 'PUSH AX
ASM = ASM + CHR$(&HBA) + CHR$(&H61) + CHR$(&H0) 'MOV DX,0061
ASM = ASM + CHR$(&HEC) 'IN AL,DX
ASM = ASM + CHR$(&HC) + CHR$(&H82) 'OR AL,82
ASM = ASM + CHR$(&HEE) 'OUT DX,AL
ASM = ASM + CHR$(&H24) + CHR$(&H7F) 'AND AL,7F
ASM = ASM + CHR$(&HEE) 'OUT DX,AL
ASM = ASM + CHR$(&HB0) + CHR$(&H20) 'MOV AL,20
ASM = ASM + CHR$(&HBA) + CHR$(&H20) + CHR$(&H0) 'MOV DX,0020
ASM = ASM + CHR$(&HEE) 'OUT DX,AL
ASM = ASM + CHR$(&HBA) + CHR$(KSGL) + CHR$(KSGH)'MOV DX,SEG KEY.TABLE
ASM = ASM + CHR$(&H8E) + CHR$(&HDA) 'MOV DS,DX
ASM = ASM + CHR$(&HBE) + CHR$(KOFL) + CHR$(KOFH)'MOV SI,OFFSET KEY.TABLE
ASM = ASM + CHR$(&H58) 'POP AX
ASM = ASM + CHR$(&HBB) + CHR$(&H1) + CHR$(&H0) 'MOV BX,0001--MAKE
ASM = ASM + CHR$(&HB4) + CHR$(&H48) 'MOV AH,48--UP
ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,AL
ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZ
ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H0) 'MOV [SI+00],BX
ASM = ASM + CHR$(&HB4) + CHR$(&H50) 'MOV AH,50--DOWN
ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,AL
ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZ
ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H2) 'MOV [SI+02],BX
ASM = ASM + CHR$(&HB4) + CHR$(&H4B) 'MOV AH,4B--LEFT
ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,AL
ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZ
ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H4) 'MOV [SI+04],BX
ASM = ASM + CHR$(&HB4) + CHR$(&H4D) 'MOV AH,4D--RIGHT
ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,AL
ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZ
ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H6) 'MOV [SI+06],BX
ASM = ASM + CHR$(&HB4) + CHR$(&H1D) 'MOV AH,1D--CTRL
ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,AL
ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZ
ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H8) 'MOV [SI+08],BX
ASM = ASM + CHR$(&HB4) + CHR$(&H38) 'MOV AH,38--ALT
ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,AL
ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZ
ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&HA) 'MOV [SI+0A],BX
ASM = ASM + CHR$(&HB4) + CHR$(&H39) 'MOV AH,39--SPACE
ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,AL
ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZ
ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&HC) 'MOV [SI+0C],BX
ASM = ASM + CHR$(&HB4) + CHR$(&H1) 'MOV AH,01--ESC
ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,AL
ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZ
ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&HE) 'MOV [SI+0E],BX
ASM = ASM + CHR$(&HB4) + CHR$(&H1C) 'MOV AH,1C--ENTER
ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,AL
ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZ
ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H10)'MOV [SI+10],BX
ASM = ASM + CHR$(&HB4) + CHR$(&H36) 'MOV AH,36--RSHIFT
ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,AL
ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZ
ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H12)'MOV [SI+12],BX
ASM = ASM + CHR$(&HBB) + CHR$(&H0) + CHR$(&H0) 'MOV BX,0000--BREAK
ASM = ASM + CHR$(&HB4) + CHR$(&HC8) 'MOV AH,C8--UP
ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,AL
ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZ
ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H0) 'MOV [SI+00],BX
ASM = ASM + CHR$(&HB4) + CHR$(&HD0) 'MOV AH,D0--DOWN
ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,AL
ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZ
ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H2) 'MOV [SI+02],BX
ASM = ASM + CHR$(&HB4) + CHR$(&HCB) 'MOV AH,CB--LEFT
ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,AL
ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZ
ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H4) 'MOV [SI+04],BX
ASM = ASM + CHR$(&HB4) + CHR$(&HCD) 'MOV AH,CD--RIGHT
ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,AL
ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZ
ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H6) 'MOV [SI+06],BX
ASM = ASM + CHR$(&HB4) + CHR$(&H9D) 'MOV AH,9D--CTRL
ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,AL
ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZ
ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H8) 'MOV [SI+08],BX
ASM = ASM + CHR$(&HB4) + CHR$(&HB8) 'MOV AH,B8--ALT
ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,AL
ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZ
ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&HA) 'MOV [SI+0A],BX
ASM = ASM + CHR$(&HB4) + CHR$(&HB9) 'MOV AH,B9--SPACE
ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,AL
ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZ
ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&HC) 'MOV [SI+0C],BX
ASM = ASM + CHR$(&HB4) + CHR$(&H81) 'MOV AH,81--ESC
ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,AL
ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZ
ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&HE) 'MOV [SI+0E],BX
ASM = ASM + CHR$(&HB4) + CHR$(&H9C) 'MOV AH,9C--ENTER
ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,AL
ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZ
ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H10)'MOV [SI+10],BX
ASM = ASM + CHR$(&HB4) + CHR$(&HB6) 'MOV AH,B6--RSHIFT
ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,AL
ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZ
ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H12)'MOV [SI+12],BX
ASM = ASM + CHR$(&HFA) 'CLI
ASM = ASM + CHR$(&H5E) 'POP SI
ASM = ASM + CHR$(&H1F) 'POP DS
ASM = ASM + CHR$(&H5F) 'POP DI
ASM = ASM + CHR$(&H7) 'POP ES
ASM = ASM + CHR$(&H58) 'POP AX
ASM = ASM + CHR$(&H5B) 'POP BX
ASM = ASM + CHR$(&H59) 'POP CX
ASM = ASM + CHR$(&H5A) 'POP DX
ASM = ASM + CHR$(&HCF) 'IRET
BYTE = CHR$(INP(&H21)) 'LOAD IRQ ENABLE REGISTER IN PIC
OUT &H21, (ASC(BYTE) AND (255 XOR 2)) 'CLEAR BIT 2 (IRQ 1)
CALL GETVECT(OLDSEG, OLDOFF, &H9) 'LOAD OLD ISR
CALL SETVECT(VARSEG(ASM), SADD(ASM), &H9) 'STORE NEW ISR
END SUB
SUB KEYBOARD.OUT (OLDSEG AS INTEGER, OLDOFF AS INTEGER)
CALL SETVECT(OLDSEG, OLDOFF, &H9) 'RESTORE OLD ISR
END SUB
SUB maketables
END SUB
SUB makeworld
END SUB
SUB screensetup
PCOPY 2, 3
END SUB
SUB SETVECT (S AS INTEGER, O AS INTEGER, I AS INTEGER)
'SETVECT CHANGES THE ADDRESSES IN THE INTERRUPT VECTOR TABLE
'TO POINT TO NEW FUNCTIONS
STATIC ASM AS STRING 'HOLDS THE SETVECT FUNCTION
STATIC INI AS INTEGER 'USED TO TEST WHETHER OR NOT FUNCTION HAS PREVOUSLY
'BEEN CALLED
IF INI = 0 THEN
'CREATE FUNCTION IF NOT ALREADY CREATED
ASM = ""
ASM = ASM + CHR$(&H55) 'PUSH BP
ASM = ASM + CHR$(&H89) + CHR$(&HE5) 'MOV BP,SP
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8) 'MOV BX,[BP+08]
ASM = ASM + CHR$(&H8B) + CHR$(&H17) 'MOV DX,[BX]
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6) 'MOV BX,[BP+06]
ASM = ASM + CHR$(&H8A) + CHR$(&H7) 'MOV AL,[BX]
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA) 'MOV BX,[BP+0A]
ASM = ASM + CHR$(&H1E) 'PUSH DS
ASM = ASM + CHR$(&H8E) + CHR$(&H1F) 'MOV DS,[BX]
ASM = ASM + CHR$(&HB4) + CHR$(&H25) 'MOV AH,25
ASM = ASM + CHR$(&HCD) + CHR$(&H21) 'INT 21
ASM = ASM + CHR$(&H1F) 'POP DS
ASM = ASM + CHR$(&H5D) 'POP BP
ASM = ASM + CHR$(&HCA) + CHR$(&H6) + CHR$(&H0) 'RETF 0006
INI = 1 'FLAG CREATION
END IF
DEF SEG = VARSEG(ASM)
CALL ABSOLUTE(S, O, I, SADD(ASM)) 'RUN SETVECT
END SUB
------------------------------------------------------
--
______________________________
Steven Sensarn
E-Mail - txs5...@bayou.uh.edu
______________________________
...Okay. Back to the question. Are you using any machine language routines in your
code (run a SEARCH on CALL ABSOLUTE)? If you are, check to see if variables are being
passed to them. If they are, check if the return statement is removing the variables
from the stack.
If you just got a stack overflow due to rigorous programming, I beleive there is a
statement to set the stack size...
Well here goes, let me explain, I've written up a little doc on it:
Note: unlike the method used in previous QBasic raycaster, these methods
are Ž copyright Peter Cooper, but you are free to use them as long as
credit is given where due and I am informed.
Reverse Ray Tracing (RRT)
~~~~~~~~~~~~~~~~~~~~~~~~~
Written by Peter Cooper
pe...@trenham.demon.co.uk
I would like to think I 'coined' the Reverse Ray Tracing system
but I expect it has been thought of and used somewhere before (like when
I invented mathetical graphics systems and then discovered vector
graphics 2 years later..) :)
In standard raytracing 'rays' are sent out from the players
position on a 2D (or 3D) grid. When these beams hit something then the
appropriate action is taken. This is the method used by the current
versions of the Wolf3D style QBasic raycasting engine. After looking at
different variations based upon this method I decided to change tact and
think of another way around it. I thought, well we know the players
coords and we know the walls coords but we have to send out beams from
the player because otherwise we dont know _which_ walls to place.. So if
we knew which walls to place then it would be simple, we could just use
a trigonometrical function to work out the distance from the wall. That
would be simple.. So what if instead of sending beams out from the
player, we sent them out from the wall....
It's simple, we just go through the map grid and take each
position and work out how far it is to the player from that position.
Then we work out it's depth (whether it should be displayed or not) and
then it's angle (so we know where and if to put it on screen). Thats the
theory anyway.
So I'm coding that now, should be ready in an hour or so. I will
probably extend this document... I havnt explained that we'll need a
depth buffer and the such like but I'm working on it.. if you can code
this up before me or make it better please do.
Cheers {:o)