12-19-2022, 12:16 AM
Now that I have an idea how to do it, here's a 3D room. No attached images needed, everything is in the code.
The mouse is used to look around. You can move with the mouse buttons or by using the W and S keys.
Thanks again, MasterGy!
The mouse is used to look around. You can move with the mouse buttons or by using the W and S keys.
Thanks again, MasterGy!
Code: (Select All)
'3d Room - james2464 - Dec 18 2022
'Credit to 3D program and tutorial by MasterGy
Randomize Timer
Screen _NewImage(1000, 600, 32)
Dim Shared c(100) As Long
bgspace = _NewImage(1000, 600, 32)
Line (1, 1)-(1000, 600), _RGB(180, 180, 180), BF
_PutImage (1, 1)-(1000, 600), 0, bgspace, (1, 1)-(1000, 600)
Cls
floatingtiles = _NewImage(100, 100, 32)
Line (1, 1)-(100, 100), _RGB(250, 250, 250), BF
_PutImage (1, 1)-(100, 100), 0, floatingtiles, (1, 1)-(100, 100)
colour1
Dim Shared floor1, wall1
'create floor image
floor1 = _NewImage(500, 500, 32)
makefloor
'create wall image
wall1 = _NewImage(500, 100, 32)
makewall
bgspace2 = _CopyImage(bgspace, 33)
tile = _CopyImage(floatingtiles, 33)
floor2 = _CopyImage(floor1, 33)
wall2 = _CopyImage(wall1, 33)
'create spectator
Dim Shared sp(6)
sp(0) = 250
sp(1) = 250
sp(2) = 450
sp(3) = 0 'looking in the direction of the observer XZ
sp(4) = 0 'looking in the direction of the observer YZ
sp(5) = 1 'multiplier X-Y see
sp(6) = 1 'multiplier Z see
'create screen
scr = _NewImage(1000, 1000 / _DesktopWidth * _DesktopHeight, 32)
Screen scr
_MouseHide
_FullScreen
_Dest scr
_DisplayOrder _Hardware , _Software
'=============================================================================================================
'=============================================================================================================
'=============================================================================================================
'=============================================================================================================
Do
_Limit 40
_PutImage (1, 1), bgspace2 'background
'draw floating tiles
For ctx = 1 To 500 Step 20
For cty = 1 To 500 Step 20
ps = 1
x = 0 + ps * ctx
y = 0 + ps * cty
z = 400
rotate_to_maptriangle x, y, z
_MapTriangle (0, 0)-(100, 0)-(0, 100), tile To(x - ps, y - ps, z)-(x + ps, y - ps, z)-(x - ps, y + ps, z)
_MapTriangle (100, 100)-(100, 0)-(0, 100), tile To(x + ps, y + ps, z)-(x + ps, y - ps, z)-(x - ps, y + ps, z)
Next cty
Next ctx
'floor
x1 = 0
y1 = 0
z1 = 500
rotate_to_maptriangle x1, y1, z1 'floor
x2 = 500
y2 = 0
z2 = 500
rotate_to_maptriangle x2, y2, z2 'floor
x3 = 0
y3 = 500
z3 = 500
rotate_to_maptriangle x3, y3, z3 'floor
x4 = 500
y4 = 500
z4 = 500
rotate_to_maptriangle x4, y4, z4 'floor
_MapTriangle (0, 0)-(500, 0)-(0, 500), floor2 To(x1, y1, z1)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
_MapTriangle (500, 500)-(500, 0)-(0, 500), floor2 To(x4, y4, z4)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
x1 = 0
y1 = 0
z1 = 400
rotate_to_maptriangle x1, y1, z1 'wall
x2 = 500
y2 = 0
z2 = 400
rotate_to_maptriangle x2, y2, z2 'wall
x3 = 0
y3 = 0
z3 = 500
rotate_to_maptriangle x3, y3, z3 'wall
x4 = 500
y4 = 0
z4 = 500
rotate_to_maptriangle x4, y4, z4 'wall
_MapTriangle (0, 0)-(500, 0)-(0, 100), wall2 To(x1, y1, z1)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
_MapTriangle (500, 100)-(500, 0)-(0, 100), wall2 To(x4, y4, z4)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
'brick wall 2
x1 = 500
y1 = 500
z1 = 400
rotate_to_maptriangle x1, y1, z1 'wall
x2 = 0
y2 = 500
z2 = 400
rotate_to_maptriangle x2, y2, z2 'wall
x3 = 500
y3 = 500
z3 = 500
rotate_to_maptriangle x3, y3, z3 'wall
x4 = 0
y4 = 500
z4 = 500
rotate_to_maptriangle x4, y4, z4 'wall
_MapTriangle (0, 0)-(500, 0)-(0, 100), wall2 To(x1, y1, z1)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
_MapTriangle (500, 100)-(500, 0)-(0, 100), wall2 To(x4, y4, z4)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
'brick wall 3
x1 = 0
y1 = 500
z1 = 400
rotate_to_maptriangle x1, y1, z1 'wall
x2 = 0
y2 = 0
z2 = 400
rotate_to_maptriangle x2, y2, z2 'wall
x3 = 0
y3 = 500
z3 = 500
rotate_to_maptriangle x3, y3, z3 'wall
x4 = 0
y4 = 0
z4 = 500
rotate_to_maptriangle x4, y4, z4 'wall
_MapTriangle (0, 0)-(500, 0)-(0, 100), wall2 To(x1, y1, z1)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
_MapTriangle (500, 100)-(500, 0)-(0, 100), wall2 To(x4, y4, z4)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
'brick wall 4
x1 = 500
y1 = 0
z1 = 400
rotate_to_maptriangle x1, y1, z1 'wall
x2 = 500
y2 = 500
z2 = 400
rotate_to_maptriangle x2, y2, z2 'wall
x3 = 500
y3 = 0
z3 = 500
rotate_to_maptriangle x3, y3, z3 'wall
x4 = 500
y4 = 500
z4 = 500
rotate_to_maptriangle x4, y4, z4 'wall
_MapTriangle (0, 0)-(500, 0)-(0, 100), wall2 To(x1, y1, z1)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
_MapTriangle (500, 100)-(500, 0)-(0, 100), wall2 To(x4, y4, z4)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
_Display
'mouse input axis movement and mousewheel
mousex = mousex * .6
mousey = mousey * .6
mw = 0
While _MouseInput: mousex = mousex + _MouseMovementX: mousey = mousey + _MouseMovementY: mw = mw + _MouseWheel: Wend 'movement data read
'control spectator
mouse_sens = .001 'mouse rotating sensitive
sp(3) = sp(3) - mousex * mouse_sens
sp(4) = sp(4) + mousey * mouse_sens
If Abs(sp(4)) > _Pi / 2 Then sp(4) = _Pi / 2 * Sgn(sp(4))
vec_x = (Sin(sp(3)) * (Cos(sp(4) + _Pi)))
vec_y = (Cos(sp(3)) * (Cos(sp(4) + _Pi)))
vec_z = -Sin(sp(4) + _Pi)
speed = .9 'moving speed
moving = Abs(_MouseButton(1) Or _KeyDown(Asc("w"))) * speed - Abs(_MouseButton(2) Or _KeyDown(Asc("s"))) * speed
sp(0) = sp(0) + vec_x * moving
sp(1) = sp(1) + vec_y * moving
sp(2) = sp(2) + vec_z * moving
Loop Until _KeyDown(27)
'=============================================================================================================
'=============================================================================================================
'=============================================================================================================
'=============================================================================================================
Sub rotate_to_maptriangle (x, y, z)
x2 = x - sp(0)
y2 = y - sp(1)
z2 = z - sp(2)
rotate_2d x2, y2, sp(3)
rotate_2d y2, z2, sp(4) + _Pi / 2
x = x2 * sp(5)
y = y2 * sp(5)
z = z2 * sp(6)
End Sub
Sub rotate_2d (x, y, ang)
x1 = x * Cos(ang) - y * Sin(ang)
y1 = x * Sin(ang) + y * Cos(ang)
x = x1: y = y1
End Sub
Sub colour1
c(0) = _RGB(0, 0, 0)
c(1) = _RGB(255, 255, 255)
c(2) = _RGB(85, 45, 0)
c(3) = _RGB(0, 45, 85)
c(4) = _RGB(40, 60, 0)
c(5) = _RGB(0, 25, 75)
c(6) = _RGB(75, 25, 0)
c(7) = _RGB(150, 130, 0)
c(8) = _RGB(150, 150, 250)
c(9) = _RGB(250, 150, 150)
c(10) = _RGB(150, 250, 150)
c(11) = _RGB(150, 150, 255)
c(12) = _RGB(40, 30, 0)
c(13) = _RGB(255, 0, 0)
c(14) = _RGB(50, 150, 50)
c(15) = _RGB(155, 155, 155)
c(16) = _RGB(165, 165, 165)
c(17) = _RGB(175, 175, 175)
End Sub
Sub makefloor
Cls
Line (0, 0)-(500, 500), c(12), BF 'floor background
Line (0, 0)-(50, 50), c(4), BF
Line (450, 0)-(500, 50), c(5), BF
Line (450, 450)-(500, 500), c(6), BF
Line (0, 450)-(50, 500), c(7), BF
For t = 1 To 6000
x1 = Int(Rnd * 500)
y1 = Int(Rnd * 500)
PSet (x1, y1), c(0)
x1 = Int(Rnd * 500)
y1 = Int(Rnd * 500)
PSet (x1, y1), c(2)
x1 = Int(Rnd * 500)
y1 = Int(Rnd * 500)
PSet (x1, y1), c(3)
Next t
_Display
_PutImage (1, 1)-(500, 500), 0, floor1, (1, 1)-(500, 500)
'Sleep
End Sub
Sub makewall
Cls
Line (0, 0)-(500, 100), c(15), BF 'wall background
Line (0, 0)-(20, 20), c(4), BF
Line (480, 0)-(500, 20), c(5), BF
Line (480, 80)-(500, 100), c(6), BF
Line (0, 80)-(20, 100), c(7), BF
For t = 1 To 6000
x1 = Int(Rnd * 500)
y1 = Int(Rnd * 100)
PSet (x1, y1), c(16)
x1 = Int(Rnd * 500)
y1 = Int(Rnd * 100)
PSet (x1, y1), c(17)
Next t
Locate 4, 28
Color c(4), c(0)
Print "QB64PE"
_Display
_PutImage (1, 1)-(500, 100), 0, wall1, (1, 1)-(500, 100)
_ClearColor c(0), wall1
'Sleep
End Sub