Yesterday, 06:40 AM
This is a Public Domain post from the old newsgroup comp.lang.basic.misc that I remember from back in the 1990's. It's NOT my code, but many people have modified it, etc. I will post the URL I got it from below. The original programmer (Peter Cooper) says in the comments that is is public domain for anyone to modify, which is why I wanted to show you guys. The incredible thing is that it's so short and does so much. Maybe some of you can learn from it or add-on to it, or whatever. I might do the same someday.
To turn, use the right and left arrow keys, to move, press the Space Bar. Since this is from QBasic, the screen is very small, but I'm sure it can be changed to larger. The map is made using DATA statements which is really cool and easy for editing I'm sure. There's no enemies or shooting in this, it's just a small 3D walls and backdrop example.
Here is where it is posted online, someone that modified it put a description on this page with the code:
https://groups.google.com/g/comp.lang.ba...w3_y2WOSYJ
Here is the code, enjoy!
To turn, use the right and left arrow keys, to move, press the Space Bar. Since this is from QBasic, the screen is very small, but I'm sure it can be changed to larger. The map is made using DATA statements which is really cool and easy for editing I'm sure. There's no enemies or shooting in this, it's just a small 3D walls and backdrop example.
Here is where it is posted online, someone that modified it put a description on this page with the code:
https://groups.google.com/g/comp.lang.ba...w3_y2WOSYJ
Here is the code, enjoy!
Code: (Select All)
'=======================================================================
' 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)
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%(t% Mod 360) / 50)
py% = py% + (ct%(t% Mod 360) / 50)
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%
Next X%
Next Y%
Screen 7, , 0, 1
End Sub
