+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Help Me! (https://qb64phoenix.com/forum/forumdisplay.php?fid=10)
+---- Thread: 3d surface images (/showthread.php?tid=1156)
RE: 3d surface images - james2464 - 12-20-2022
(12-20-2022, 01:52 PM)MasterGy Wrote: I've just made a joke of you and myself! I didn't understand either, I found it after about half an hour...sorry!I told you to review the variables because I just scrapped and quickly rewrote them for this program's rotation routine.
![[Image: jamesnak-kuld.gif]](https://i.ibb.co/W21rjbh/jamesnak-kuld.gif)
Thank you! I removed the 's' from 'actual_points' and it works fine!
Now I can experiment with the sky!
RE: 3d surface images - james2464 - 12-20-2022
[url=https://qb64phoenix.com/forum/member.php?action=profile&uid=74][/url]
Quote:SMcNeill
Honestly, I'd love for us to have a whole series of 3D related tutorials, where one new concept is added at a time, without it all overwhelming the users all at once, but I also realize others might not have the time to devote to such a number of posts. A post for 2D to 3D. A post for adding rotation on the cubes after that. A post for static cube, but the "player" moving around the cube/grid itself. A post for adding textures via maptriangle so we don't just have plain line walls, ceilings and floors. And finally, a post for detecting collision in that 3D plane...
It's probably more than anyone would want to sit and work up, one after the other, but a fellow can dream can't he? Especially around Christmas time?
This would be amazing! Sign me up.
RE: 3d surface images - james2464 - 12-20-2022
After making some adjustments, here's a flat earth with a sky globe around it. With a slanted roof office building inside.
I put grid lines on the sky just as a test. They get weird at the poles for some reason. (Edit: the sphere resolution is low at lines 81&82. Increase to 72 for smoother globe)
Code: (Select All)
'3d globe with office - james2464 - Dec 20 2022
'Credit to 3D program and tutorial by MasterGy
Option _Explicit
Randomize Timer
Screen _NewImage(1000, 1000, 32)
Const pip180 = 3.141592 / 180
Dim Shared c(100) As Long
Dim floor1b, wall1b, wall2b, ceiling1b, ground1b, sky1b
Dim scr, da, db, da2, dega, db2, degb, ss, ap, sqa, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4
Dim sky_points, sky_image
Dim actual_point, asq
Dim wx0, wy0, wz0, wx1, wy1, wz1, wx2, wy2, wz2, wx3, wy3, wz3, sx0, sy0, sx1, sy1, sx2, sy2, sx3, sy3
Dim mousex, mousey, mw, mouse_sens, vec_x, vec_y, vec_z, speed, moving
Cls
colour1
Dim Shared floor1, wall1, wall2, ceiling1, ground1, sky1
'create floor image
floor1 = _NewImage(500, 500, 32)
makefloor
'create wall1 image
wall1 = _NewImage(500, 100, 32)
makewall
'create wall2 image
wall2 = _NewImage(500, 100, 32)
makewall2
'create ceiling image
ceiling1 = _NewImage(500, 500, 32)
makeceiling
'create ground image
ground1 = _NewImage(500, 500, 32)
makeground
'create sky image
sky1 = _NewImage(750, 750, 32)
makesky
floor1b = _CopyImage(floor1, 33)
wall1b = _CopyImage(wall1, 33)
wall2b = _CopyImage(wall2, 33)
ceiling1b = _CopyImage(ceiling1, 33)
ground1b = _CopyImage(ground1, 33)
sky1b = _CopyImage(sky1, 33)
'create spectator
Dim Shared sp(6)
sp(0) = 0 'X position
sp(1) = 0 'Y
sp(2) = 450 'Z
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
'sky install *********************************************************************************
da = 16 'resolution sphere X
db = 16 'resolution sphere Y
sky_points = da * db
Dim sky_points(sky_points - 1, 9), sq(sky_points - 1, 7)
'sky_image = _LoadImage("sky.jpg", 33)
sky_image = _CopyImage(sky1, 33)
For da2 = 0 To da - 1
dega = 360 / (da - 1) * da2 * pip180
For db2 = 0 To db - 1
degb = 180 / (db - 1) * db2 * pip180
ss = 1500
ap = da2 * db + db2
sky_points(ap, 0) = Sin(degb) * Cos(dega) * ss
sky_points(ap, 1) = Sin(degb) * Sin(dega) * ss
sky_points(ap, 2) = Cos(degb) * ss
Next db2
Next da2
For da2 = 0 To da - 2
For db2 = 0 To db - 2
sqa = da2 * db + db2
sq(sqa, 0) = sqa
sq(sqa, 1) = sq(sqa, 0) + 1
sq(sqa, 2) = sq(sqa, 0) + db
sq(sqa, 3) = sq(sqa, 2) + 1
sq(sqa, 4) = _Width(sky_image) - (_Width(sky_image) / (da - 1) * da2) - 1
sq(sqa, 5) = _Width(sky_image) - (_Width(sky_image) / (da - 1) * (da2 + 1)) - 1
sq(sqa, 6) = Int(_Height(sky_image) / (db - 1) * db2)
sq(sqa, 7) = Int(_Height(sky_image) / (db - 1) * (db2 + 1))
Next db2
Next da2
'*********************************************************************************************
'=============================================================================================================
'=============================================================================================================
'=============================================================================================================
'=============================================================================================================
Do
_Limit 40
'_PutImage (1, 1), sky_image 'background
'floor
x1 = -250: y1 = -250: z1 = 500: r2m x1, y1, z1: x2 = 250: y2 = -250: z2 = 500: r2m x2, y2, z2
x3 = -250: y3 = 250: z3 = 500: r2m x3, y3, z3: x4 = 250: y4 = 250: z4 = 500: r2m x4, y4, z4
maptexture floor1b, 500, 500, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4
'wall 1
x1 = -250: y1 = -250: z1 = 400: r2m x1, y1, z1: x2 = 250: y2 = -250: z2 = 400: r2m x2, y2, z2
x3 = -250: y3 = -250: z3 = 500: r2m x3, y3, z3: x4 = 250: y4 = -250: z4 = 500: r2m x4, y4, z4
maptexture wall2b, 500, 100, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4
'wall 2
x1 = 250: y1 = 250: z1 = 400: r2m x1, y1, z1: x2 = -250: y2 = 250: z2 = 400: r2m x2, y2, z2
x3 = 250: y3 = 250: z3 = 500: r2m x3, y3, z3: x4 = -250: y4 = 250: z4 = 500: r2m x4, y4, z4
maptexture wall2b, 500, 100, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4
'wall 3
x1 = 250: y1 = -250: z1 = 300: r2m x1, y1, z1: x2 = 250: y2 = 250: z2 = 400: r2m x2, y2, z2
x3 = 250: y3 = -250: z3 = 500: r2m x3, y3, z3: x4 = 250: y4 = 250: z4 = 500: r2m x4, y4, z4
maptexture wall1b, 500, 100, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4
'wall 4
x1 = -250: y1 = 250: z1 = 400: r2m x1, y1, z1: x2 = -250: y2 = -250: z2 = 300: r2m x2, y2, z2
x3 = -250: y3 = 250: z3 = 500: r2m x3, y3, z3: x4 = -250: y4 = -250: z4 = 500: r2m x4, y4, z4
maptexture wall1b, 500, 100, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4
'ceiling
x1 = -250: y1 = -250: z1 = 300: r2m x1, y1, z1: x2 = 250: y2 = -250: z2 = 300: r2m x2, y2, z2
x3 = -250: y3 = 250: z3 = 400: r2m x3, y3, z3: x4 = 250: y4 = 250: z4 = 400: r2m x4, y4, z4
maptexture ceiling1b, 500, 500, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4
'ground
x1 = -1500: y1 = -1500: z1 = 502: r2m x1, y1, z1: x2 = 1500: y2 = -1500: z2 = 502: r2m x2, y2, z2
x3 = -1500: y3 = 1500: z3 = 502: r2m x3, y3, z3: x4 = 1500: y4 = 1500: z4 = 502: r2m x4, y4, z4
maptexture ground1b, 500, 500, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4
'wall 5 - above wall 1
x1 = -250: y1 = -250: z1 = 300: r2m x1, y1, z1: x2 = 250: y2 = -250: z2 = 300: r2m x2, y2, z2
x3 = -250: y3 = -250: z3 = 400: r2m x3, y3, z3: x4 = 250: y4 = -250: z4 = 400: r2m x4, y4, z4
maptexture wall1b, 500, 100, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4
'draw sky *********************************************************************************
'rotating
For actual_point = 0 To sky_points - 1
sky_points(actual_point, 4) = sky_points(actual_point, 0)
sky_points(actual_point, 5) = sky_points(actual_point, 1)
sky_points(actual_point, 6) = sky_points(actual_point, 2)
r2m sky_points(actual_point, 4), sky_points(actual_point, 5), sky_points(actual_point, 6)
Next actual_point
For asq = 0 To sky_points - 1
wx0 = sky_points(sq(asq, 0), 4) + 0: wy0 = sky_points(sq(asq, 0), 5) + 0: wz0 = sky_points(sq(asq, 0), 6)
wx1 = sky_points(sq(asq, 1), 4) + 0: wy1 = sky_points(sq(asq, 1), 5) + 0: wz1 = sky_points(sq(asq, 1), 6)
wx2 = sky_points(sq(asq, 2), 4) + 0: wy2 = sky_points(sq(asq, 2), 5) + 0: wz2 = sky_points(sq(asq, 2), 6)
wx3 = sky_points(sq(asq, 3), 4) + 0: wy3 = sky_points(sq(asq, 3), 5) + 0: wz3 = sky_points(sq(asq, 3), 6)
sy0 = sq(asq, 6): sx0 = sq(asq, 4): sy1 = sq(asq, 7): sx1 = sq(asq, 4): sy2 = sq(asq, 6): sx2 = sq(asq, 5): sy3 = sq(asq, 7): sx3 = sq(asq, 5)
_MapTriangle (sx0, sy0)-(sx1, sy1)-(sx2, sy2), sky_image To(wx0, wy0, wz0)-(wx1, wy1, wz1)-(wx2, wy2, wz2), , _Smooth
_MapTriangle (sx3, sy3)-(sx1, sy1)-(sx2, sy2), sky_image To(wx3, wy3, wz3)-(wx1, wy1, wz1)-(wx2, wy2, wz2), , _Smooth
Next asq
' ****************************************************************************************************
'_MapTriangle (0, 0)-(x, 0)-(0, y), image1 To(x1, y1, z1)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
'_MapTriangle (x, y)-(x, 0)-(0, y), image1 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 = .0007 '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 = 6 '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
'If sp(0) > 465 Then sp(0) = 465
'If sp(1) > 465 Then sp(1) = 465
'If sp(0) < 35 Then sp(0) = 35
'If sp(1) < 35 Then sp(1) = 35
Loop Until _KeyDown(27)
'=============================================================================================================
'=============================================================================================================
'=============================================================================================================
'=============================================================================================================
Sub rot2 (x, y, ang)
Dim x1, y1
x1 = x * Cos(ang) - y * Sin(ang)
y1 = x * Sin(ang) + y * Cos(ang)
x = x1: y = y1
End Sub
Sub r2m (x, y, z)
Dim x2, y2, z2
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)
Dim x1, y1
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)
c(18) = _RGB(100, 100, 100)
c(20) = _RGB(40, 40, 10)
End Sub
Sub makefloor
Dim t, x1, y1
Cls
Line (0, 0)-(500, 500), c(18), BF 'floor background
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 (0, 0)-(500, 500), 0, floor1, (0, 0)-(500, 500)
'Sleep
End Sub
Sub makewall
Dim t, x1, y1
Cls
Line (0, 0)-(500, 100), c(15), BF 'wall background
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
_Display
_PutImage (0, 0)-(500, 100), 0, wall1, (0, 0)-(500, 100)
_ClearColor c(0), wall1
'Sleep
End Sub
Sub makewall2
Dim t, x1, y1
Cls
Line (0, 0)-(500, 100), c(15), BF 'wall2 background
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
Line (70, 25)-(150, 75), c(0), BF
Line (210, 25)-(290, 75), c(0), BF
Line (350, 25)-(430, 75), c(0), BF
_Display
_PutImage (0, 0)-(500, 100), 0, wall2, (0, 0)-(500, 100)
_ClearColor c(0), wall2
'Sleep
End Sub
Sub makeceiling
Dim t, t2
Cls
Line (0, 0)-(500, 500), c(18), BF 'ceiling background
Line (2, 2)-(498, 498), c(17), BF 'ceiling light background
For t = 26 To 540 Step 32
Line (t - 1, 0)-(t, 500), c(18), BF
Line (0, t - 1)-(500, t), c(18), BF
Next t
For t = 32 To 470 Step 128
For t2 = 32 To 470 Step 128
Paint (t, t2), c(1), c(18)
Next t2
Next t
_Display
_PutImage (0, 0)-(500, 500), 0, ceiling1, (0, 0)-(500, 500)
_ClearColor c(0), ceiling1
'Sleep
End Sub
Sub makeground
Dim t, x1, y1
Cls
Line (0, 0)-(500, 500), c(20), BF 'ground background
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 (0, 0)-(500, 500), 0, ground1, (0, 0)-(500, 500)
'Sleep
End Sub
Sub makesky
Dim t, x1, y, m, r
Cls
y = 750
For t = 1 To y
m = 255 * ((750 - t * .95) / 750)
c(99) = _RGBA(180, 180, 255, m)
Line (0, t)-(750, t), c(99)
Next t
For t = 0 To 750 Step 25 'longituge lines
Line (t, 0)-(t, 750), c(1)
Next t
For t = 0 To 750 Step 25 'latitude lines
Line (0, t)-(750, t), c(1)
Next t
_Display
_PutImage (0, 0)-(750, 750), 0, sky1, (0, 0)-(750, 750)
'Sleep
End Sub
Sub maptexture (image1, x, y, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4)
_MapTriangle (0, 0)-(x, 0)-(0, y), image1 To(x1, y1, z1)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
_MapTriangle (x, y)-(x, 0)-(0, y), image1 To(x4, y4, z4)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
End SubRE: 3d surface images - MasterGy - 12-20-2022
very good !
If you put this in place of 'spectator control', you control it not only with WS, but with WASD. That's better.
Code: (Select All)
'control spectator
mouse_sens = .0007 '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))
sp3 = sp(3) + (_KeyDown(Asc("d")) - _KeyDown(Asc("a"))) * 90 * pip180
vec_x = (Sin(sp3) * (Cos(sp(4) + _Pi)))
vec_y = (Cos(sp3) * (Cos(sp(4) + _Pi)))
vec_z = -Sin(sp(4) + _Pi)
If _KeyDown(Asc("a")) Or _KeyDown(Asc("d")) Then vec_z = 0
speed = 6 'moving speed
moving = Abs(_MouseButton(1) Or _KeyDown(Asc("w")) Or _KeyDown(Asc("a")) Or _KeyDown(Asc("d"))) * 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
'If sp(0) > 465 Then sp(0) = 465
'If sp(1) > 465 Then sp(1) = 465
'If sp(0) < 35 Then sp(0) = 35
'If sp(1) < 35 Then sp(1) = 35RE: 3d surface images - MasterGy - 12-20-2022
(12-20-2022, 03:37 PM)SMcNeill Wrote: @MasterGy Hey MasterGy, how about you do us the world's simplest tutorial in 3d graphics. Let's say we have a 2d graphic of a 3x3 grid, which would produce the floor layout to a square room. Can you show us how you'd turn that 2D "map" into a series of cubes which would be placed across the screen in various points?
The Square starting at (0,0) (top,left) would be placed independently to the top, left of the screen, so we could see how that (0,0)-(1,0)-(1,1)-(0,1) series of 4 coordinates would turn into the X/Y/Z of 3 dimensional space. Let the user hit the space bar, and then do the same thing for the to the square next to it, which would be from (1,0)-(2,0)-(2,1)-(1,1), and how that translates to 3D space.
Personally, I think something as simple as that would make a GREAT breakthrough point for a lot of folks with 3D graphics. Once people understand how to get those 3D coordinates, then rotation and such can be added, but going from the 4 2-D points to the 8 3-D points, (I think it's 8 of them, isn't it, for a cube?) is probably the hardest point for people to get sorted out.
Honestly, I'd love for us to have a whole series of 3D related tutorials, where one new concept is added at a time, without it all overwhelming the users all at once, but I also realize others might not have the time to devote to such a number of posts. A post for 2D to 3D. A post for adding rotation on the cubes after that. A post for static cube, but the "player" moving around the cube/grid itself. A post for adding textures via maptriangle so we don't just have plain line walls, ceilings and floors. And finally, a post for detecting collision in that 3D plane...
It's probably more than anyone would want to sit and work up, one after the other, but a fellow can dream can't he? Especially around Christmas time?
I have already tried many times how to make the 3D thing as understandable as possible.
That's why I made this:
https://qb64phoenix.com/forum/showthread.php?tid=896
I didn't overcomplicate it on purpose, I just included the essentials.
Indeed, good documentation would be useful.
3d is not very complicated, it's just very hard to explain. you are right, it should be made visually understandable. I'm happy to help. Unfortunately, I don't understand what you meant by the 3x3 cubes, even though I've read it many times. Please write it again.
RE: 3d surface images - james2464 - 12-20-2022
(12-20-2022, 07:18 PM)MasterGy Wrote: very good !
If you put this in place of 'spectator control', you control it not only with WS, but with WASD. That's better.
Code: (Select All)'control spectator
mouse_sens = .0007 '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))
sp3 = sp(3) + (_KeyDown(Asc("d")) - _KeyDown(Asc("a"))) * 90 * pip180
vec_x = (Sin(sp3) * (Cos(sp(4) + _Pi)))
vec_y = (Cos(sp3) * (Cos(sp(4) + _Pi)))
vec_z = -Sin(sp(4) + _Pi)
If _KeyDown(Asc("a")) Or _KeyDown(Asc("d")) Then vec_z = 0
speed = 6 'moving speed
moving = Abs(_MouseButton(1) Or _KeyDown(Asc("w")) Or _KeyDown(Asc("a")) Or _KeyDown(Asc("d"))) * 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
'If sp(0) > 465 Then sp(0) = 465
'If sp(1) > 465 Then sp(1) = 465
'If sp(0) < 35 Then sp(0) = 35
'If sp(1) < 35 Then sp(1) = 35
This is definitely better - thank you. It improves the viewing experience.
RE: 3d surface images - mnrvovrfc - 12-20-2022
(12-20-2022, 07:33 PM)MasterGy Wrote: 3d is not very complicated, it's just very hard to explain. you are right, it should be made visually understandable. I'm happy to help. Unfortunately, I don't understand what you meant by the 3x3 cubes, even though I've read it many times. Please write it again.
I think what SMcNeill means is: at first, there is the view of inside the bedroom, only with the bed. So this should be two squares holding the width, height and length of the bed. But in 2D space we just see a thing that is like a table, at one end is a pillow, and the other end is not very exciting... somewhere to rest the feet I suppose.
This assumes someone is looking at the room right in front of him/her, and there's only this bedroom, that is empty except for the bed.
Now try adding a small desk. That would also require two squares, but cannot overlap with the bed. It might be placed in front of the bed, or behind the bed. At all times the user is looking at the room in two-dimensional space, at two objects which give a very small detail of the depth. The width and height of the bed could be distinguished easily, if it's in front of the desk. If the desk is what is at the front then all of it could be seen easily, but the depth is more difficult to judge only with two dimensions. That's why now you need the other dimension -- the two squares that define the depth.
The two squares of depth of the bed have to be different from the two squares of depth of the desk if they're going to have X coordinates (in 2D space) which are within range of each other. Might change the Y coordinates but it would elevate one of the objects off the floor and toward the ceiling, in 2D space. Then in three dimensions only, Z is the depth in this explanation.
I don't know, I missed physics in high school because I had to take chemistry for two consecutive high-school grades, got left back on the first one LOL because I wasn't that interested in school.
Not a good diagram, but it's worth a try:
Code: (Select All)
The desk is in front of the bed. Both have the same Y coordinate which is the floor. Z is the depth of the room.
What is revealed here (poorly) is that the bed and desk require at least two squares in 3D space for depth, for the outer limits.
Of course, more squares would be needed for detail.
| ^
| +============+ |
|----! !----o |
|----!============!----| Y
| ! ! | |
|
---------> X ---------->
|----------| ^
+========+ | | |
! ! o----------o Y
!========! |__________| |
! ! | | |
|
---------> Z ---------->But you're right, 3D is difficult to explain. Some people are just able to get it as a flash of lightning. Then one is asked to write a tutorial about it which is as hard for him/her as for the one trying to get that flash of lightning. :/
RE: 3d surface images - SMcNeill - 12-20-2022
(12-20-2022, 07:33 PM)MasterGy Wrote:(12-20-2022, 03:37 PM)SMcNeill Wrote: @MasterGy Hey MasterGy, how about you do us the world's simplest tutorial in 3d graphics. Let's say we have a 2d graphic of a 3x3 grid, which would produce the floor layout to a square room. Can you show us how you'd turn that 2D "map" into a series of cubes which would be placed across the screen in various points?
The Square starting at (0,0) (top,left) would be placed independently to the top, left of the screen, so we could see how that (0,0)-(1,0)-(1,1)-(0,1) series of 4 coordinates would turn into the X/Y/Z of 3 dimensional space. Let the user hit the space bar, and then do the same thing for the to the square next to it, which would be from (1,0)-(2,0)-(2,1)-(1,1), and how that translates to 3D space.
Personally, I think something as simple as that would make a GREAT breakthrough point for a lot of folks with 3D graphics. Once people understand how to get those 3D coordinates, then rotation and such can be added, but going from the 4 2-D points to the 8 3-D points, (I think it's 8 of them, isn't it, for a cube?) is probably the hardest point for people to get sorted out.
Honestly, I'd love for us to have a whole series of 3D related tutorials, where one new concept is added at a time, without it all overwhelming the users all at once, but I also realize others might not have the time to devote to such a number of posts. A post for 2D to 3D. A post for adding rotation on the cubes after that. A post for static cube, but the "player" moving around the cube/grid itself. A post for adding textures via maptriangle so we don't just have plain line walls, ceilings and floors. And finally, a post for detecting collision in that 3D plane...
It's probably more than anyone would want to sit and work up, one after the other, but a fellow can dream can't he? Especially around Christmas time?
I have already tried many times how to make the 3D thing as understandable as possible.
That's why I made this:
https://qb64phoenix.com/forum/showthread.php?tid=896
I didn't overcomplicate it on purpose, I just included the essentials.
Indeed, good documentation would be useful.
3d is not very complicated, it's just very hard to explain. you are right, it should be made visually understandable. I'm happy to help. Unfortunately, I don't understand what you meant by the 3x3 cubes, even though I've read it many times. Please write it again.
Let's see if this helps to explain the 3x3 grid type concept:
Code: (Select All)
Dim Grid(1 To 3, 1 To 3) 'a 2d grid to hold a map
'This would be the basic grid layout for the outer walls. (Think of just a box around the 3x3 area.)
' _ _ _ '
'| |'
'| |'
'|_ _ _|'
'Start with the outerwall itself, as above. (Ignore those spaced gaps above, as they're just placeholders for my inner lines, as below.)
'Then showcase how to draw one cube inside that 3x3 grid at a time.
'Top Left:
' _ _ _ '
'|_| |'
'| |'
'|_ _ _|'
'Top Middle:
' _ _ _ '
'| |_| |'
'| |'
'|_ _ _|'
'Top Right:
' _ _ _ '
'| |_|'
'| |'
'|_ _ _|'
'And so on for the middle row and then the bottom row.
DefLng A-Z
Screen _NewImage(800, 600, 32)
$Color:32
For y = 0 To 2
For x = 0 To 2
DrawCube x, y, x + 1, y + 1
Sleep
Cls
Next
Next
Sub DrawCube (px1, py1, px2, py2) 'passed x1, passed y1, passed x2, passed y2
X_Left_Limit = 100 'Our drawing area here is from 100,100 to 500,500 **FOR THE FLOOR**
X_Right_Limit = 500 'Walls are 100 pixels tall, so we're actually drawing from 100,0 to 500,500.
Y_Top_Limit = 100
Y_Bottom_Limit = 500
X_Size = X_Right_Limit - X_Left_Limit '400 wide draw area
Y_Size = Y_Bottom_Limit - Y_Top_Limit '400 tall draw area
GridWidth = 3: GridHeight = 3 'how much of the grid that we're displaying at a time -- a 3x3 grid
X_Line_Size = X_Size / GridWidth
Y_Line_Size = Y_Size / GridHeight
Z_Line_Size = 100 'The height of our "walls".
'The front side is easy:
x1 = px1 * X_Line_Size + X_Left_Limit
x2 = px2 * X_Line_Size + X_Left_Limit
y1 = py1 * Y_Line_Size + Y_Top_Limit
y2 = py2 * Y_Line_Size + Y_Top_Limit
'Line (x1, y1)-(x2, y1), Red 'top line of floor
'Line (x2, y1)-(x2, y2), Red 'right side of floor
'Line (x2, y2)-(x1, y2), Red 'bottom side of floor
'Line (x1, y2)-(x1, y1), Red 'left side of floor
Line (x1, y1)-(x2, y2), Red, BF 'the whole floor at once. :P
'The top would just be:
z = Z_Line_Size
'Line (x1, y1 - z)-(x2, y1 - z), Blue 'top line of floor
'Line (x2, y1 - z)-(x2, y2 - z), Blue 'right side of floor
'Line (x2, y2 - z)-(x1, y2 - z), Blue 'bottom side of floor
'Line (x1, y2 - z)-(x1, y1 - z), Blue 'left side of floor
Line (x1, y1 - z)-(x2, y2 - z), Blue, BF 'The whole top at once. :P
End SubNow, this is just looking directly onto the "cube", so all we can see from our perspective here is the front side and the top. <-- This, I think, would be the place to start a series of tutorials for 3D graphics. Get folks used to the concept of "Well, you know where the floor is going to be, the top is just -z pixels above that!" Once you have your floor and your top, it's rather easy to take those 8 coordinates and imagine where each "face" or side of the cube is going to be after that.
The next part here would be to introduce rotation of the whole area, by say 45 degrees. Then you can show 3 sides of the cube at a time -- top, front, and left/right side, depending on direction of rotation. Start with just that static value of 45 degree rotation, introduce it into the code by itself, and pinpoint where it'd go and what it'd look like in relation to everything.
The next tutorial after that would be to actually introduce a variable for the rotation. Let the user use the left/right arrow keys to rotate the angle from -60degrees to +60degrees or so, just to showcase how the front side turns from left to right.
If you can kind of see what I'm thinking here, for a series of slow introductions to 3D? Just one building block at a time, until folks can finally build a whole 3d house which they could walk through with the keyboard and admire.
RE: 3d surface images - james2464 - 12-21-2022
I was curious if I could make a movable cube, and I've managed to do it. Initially I had this in a long form, sort of fixed position. But then I decided that in order to be able to move the cube around, I should put everything into a 2 dimensional array. bx(8,3) Each point (cube corner) has an x,y, and z value.
Anyway here's a floating cube in the same map from earlier.
Code: (Select All)
'3d globe with office - james2464 - Dec 20 2022
'Credit to 3D program and tutorial by MasterGy
Option _Explicit
Randomize Timer
Screen _NewImage(1000, 1000, 32)
Const pip180 = 3.141592 / 180
Dim Shared c(100) As Long
Dim floor1b, wall1b, wall2b, ceiling1b, ground1b, sky1b, box1b
Dim scr, da, db, da2, dega, db2, degb, ss, ap, sqa, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4
Dim sky_points, sky_image
Dim actual_point, asq
Dim wx0, wy0, wz0, wx1, wy1, wz1, wx2, wy2, wz2, wx3, wy3, wz3, sx0, sy0, sx1, sy1, sx2, sy2, sx3, sy3
Dim mousex, mousey, mw, mouse_sens, vec_x, vec_y, vec_z, speed, moving
Dim sp3
Dim Shared bx(8, 3), fx, fy, fz
fx = 0: fy = 0: fz = 0
Cls
colour1
Dim Shared floor1, wall1, wall2, ceiling1, ground1, sky1, box1
'create floor image
floor1 = _NewImage(500, 500, 32)
makefloor
'create wall1 image
wall1 = _NewImage(500, 100, 32)
makewall
'create wall2 image
wall2 = _NewImage(500, 100, 32)
makewall2
'create ceiling image
ceiling1 = _NewImage(500, 500, 32)
makeceiling
'create ground image
ground1 = _NewImage(500, 500, 32)
makeground
'create sky image
sky1 = _NewImage(750, 750, 32)
makesky
'create box image
box1 = _NewImage(500, 500, 32)
makebox
'box points
bx(1, 1) = -5: bx(1, 2) = -120: bx(1, 3) = 460
bx(2, 1) = -5: bx(2, 2) = -120: bx(2, 3) = 450
bx(3, 1) = 5: bx(3, 2) = -120: bx(3, 3) = 460
bx(4, 1) = 5: bx(4, 2) = -120: bx(4, 3) = 450
bx(5, 1) = -5: bx(5, 2) = -110: bx(5, 3) = 450
bx(6, 1) = 5: bx(6, 2) = -110: bx(6, 3) = 450
bx(7, 1) = -5: bx(7, 2) = -110: bx(7, 3) = 460
bx(8, 1) = 5: bx(8, 2) = -110: bx(8, 3) = 460
floor1b = _CopyImage(floor1, 33)
wall1b = _CopyImage(wall1, 33)
wall2b = _CopyImage(wall2, 33)
ceiling1b = _CopyImage(ceiling1, 33)
ground1b = _CopyImage(ground1, 33)
sky1b = _CopyImage(sky1, 33)
box1b = _CopyImage(box1, 33)
'create spectator
Dim Shared sp(6)
sp(0) = 0 'X position
sp(1) = 0 'Y
sp(2) = 450 'Z
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
'sky install *********************************************************************************
da = 60 'resolution sphere X
db = 60 'resolution sphere Y
sky_points = da * db
Dim sky_points(sky_points - 1, 9), sq(sky_points - 1, 7)
'sky_image = _LoadImage("sky.jpg", 33)
sky_image = _CopyImage(sky1, 33)
For da2 = 0 To da - 1
dega = 360 / (da - 1) * da2 * pip180
For db2 = 0 To db - 1
degb = 180 / (db - 1) * db2 * pip180
ss = 1500
ap = da2 * db + db2
sky_points(ap, 0) = Sin(degb) * Cos(dega) * ss
sky_points(ap, 1) = Sin(degb) * Sin(dega) * ss
sky_points(ap, 2) = Cos(degb) * ss
Next db2
Next da2
For da2 = 0 To da - 2
For db2 = 0 To db - 2
sqa = da2 * db + db2
sq(sqa, 0) = sqa
sq(sqa, 1) = sq(sqa, 0) + 1
sq(sqa, 2) = sq(sqa, 0) + db
sq(sqa, 3) = sq(sqa, 2) + 1
sq(sqa, 4) = _Width(sky_image) - (_Width(sky_image) / (da - 1) * da2) - 1
sq(sqa, 5) = _Width(sky_image) - (_Width(sky_image) / (da - 1) * (da2 + 1)) - 1
sq(sqa, 6) = Int(_Height(sky_image) / (db - 1) * db2)
sq(sqa, 7) = Int(_Height(sky_image) / (db - 1) * (db2 + 1))
Next db2
Next da2
'*********************************************************************************************
'=============================================================================================================
'=============================================================================================================
'=============================================================================================================
'=============================================================================================================
Do
_Limit 40
boxmove
'floor
x1 = -250: y1 = -250: z1 = 500: r2m x1, y1, z1: x2 = 250: y2 = -250: z2 = 500: r2m x2, y2, z2
x3 = -250: y3 = 250: z3 = 500: r2m x3, y3, z3: x4 = 250: y4 = 250: z4 = 500: r2m x4, y4, z4
maptexture floor1b, 500, 500, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4
'wall 1
x1 = -250: y1 = -250: z1 = 400: r2m x1, y1, z1: x2 = 250: y2 = -250: z2 = 400: r2m x2, y2, z2
x3 = -250: y3 = -250: z3 = 500: r2m x3, y3, z3: x4 = 250: y4 = -250: z4 = 500: r2m x4, y4, z4
maptexture wall2b, 500, 100, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4
'wall 2
x1 = 250: y1 = 250: z1 = 400: r2m x1, y1, z1: x2 = -250: y2 = 250: z2 = 400: r2m x2, y2, z2
x3 = 250: y3 = 250: z3 = 500: r2m x3, y3, z3: x4 = -250: y4 = 250: z4 = 500: r2m x4, y4, z4
maptexture wall2b, 500, 100, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4
'wall 3
x1 = 250: y1 = -250: z1 = 300: r2m x1, y1, z1: x2 = 250: y2 = 250: z2 = 400: r2m x2, y2, z2
x3 = 250: y3 = -250: z3 = 500: r2m x3, y3, z3: x4 = 250: y4 = 250: z4 = 500: r2m x4, y4, z4
maptexture wall1b, 500, 100, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4
'wall 4
x1 = -250: y1 = 250: z1 = 400: r2m x1, y1, z1: x2 = -250: y2 = -250: z2 = 300: r2m x2, y2, z2
x3 = -250: y3 = 250: z3 = 500: r2m x3, y3, z3: x4 = -250: y4 = -250: z4 = 500: r2m x4, y4, z4
maptexture wall1b, 500, 100, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4
'wall 5 - above wall 1
x1 = -250: y1 = -250: z1 = 300: r2m x1, y1, z1: x2 = 250: y2 = -250: z2 = 300: r2m x2, y2, z2
x3 = -250: y3 = -250: z3 = 400: r2m x3, y3, z3: x4 = 250: y4 = -250: z4 = 400: r2m x4, y4, z4
maptexture wall1b, 500, 100, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4
'ceiling
x1 = -250: y1 = -250: z1 = 300: r2m x1, y1, z1: x2 = 250: y2 = -250: z2 = 300: r2m x2, y2, z2
x3 = -250: y3 = 250: z3 = 400: r2m x3, y3, z3: x4 = 250: y4 = 250: z4 = 400: r2m x4, y4, z4
maptexture ceiling1b, 500, 500, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4
'ground
x1 = -1500: y1 = -1500: z1 = 502: r2m x1, y1, z1: x2 = 1500: y2 = -1500: z2 = 502: r2m x2, y2, z2
x3 = -1500: y3 = 1500: z3 = 502: r2m x3, y3, z3: x4 = 1500: y4 = 1500: z4 = 502: r2m x4, y4, z4
maptexture ground1b, 500, 500, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4
'box side1
x1 = bx(1, 1): y1 = bx(1, 2): z1 = bx(1, 3): r2m x1, y1, z1: x2 = bx(2, 1): y2 = bx(2, 2): z2 = bx(2, 3): r2m x2, y2, z2
x3 = bx(3, 1): y3 = bx(3, 2): z3 = bx(3, 3): r2m x3, y3, z3: x4 = bx(4, 1): y4 = bx(4, 2): z4 = bx(4, 3): r2m x4, y4, z4
_MapTriangle (0, 0)-(150, 0)-(0, 150), box1b To(x1, y1, z1)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
_MapTriangle (150, 150)-(150, 0)-(0, 150), box1b To(x4, y4, z4)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
'box side2
x1 = bx(2, 1): y1 = bx(2, 2): z1 = bx(2, 3): r2m x1, y1, z1: x2 = bx(5, 1): y2 = bx(5, 2): z2 = bx(5, 3): r2m x2, y2, z2
x3 = bx(4, 1): y3 = bx(4, 2): z3 = bx(4, 3): r2m x3, y3, z3: x4 = bx(6, 1): y4 = bx(6, 2): z4 = bx(6, 3): r2m x4, y4, z4
_MapTriangle (150, 0)-(300, 0)-(150, 150), box1b To(x1, y1, z1)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
_MapTriangle (300, 150)-(300, 0)-(150, 150), box1b To(x4, y4, z4)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
'box side3
x1 = bx(1, 1): y1 = bx(1, 2): z1 = bx(1, 3): r2m x1, y1, z1: x2 = bx(2, 1): y2 = bx(2, 2): z2 = bx(2, 3): r2m x2, y2, z2
x3 = bx(7, 1): y3 = bx(7, 2): z3 = bx(7, 3): r2m x3, y3, z3: x4 = bx(5, 1): y4 = bx(5, 2): z4 = bx(5, 3): r2m x4, y4, z4
_MapTriangle (300, 0)-(450, 0)-(300, 150), box1b To(x1, y1, z1)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
_MapTriangle (450, 150)-(450, 0)-(300, 150), box1b To(x4, y4, z4)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
'box side4
x1 = bx(3, 1): y1 = bx(3, 2): z1 = bx(3, 3): r2m x1, y1, z1: x2 = bx(4, 1): y2 = bx(4, 2): z2 = bx(4, 3): r2m x2, y2, z2
x3 = bx(8, 1): y3 = bx(8, 2): z3 = bx(8, 3): r2m x3, y3, z3: x4 = bx(6, 1): y4 = bx(6, 2): z4 = bx(6, 3): r2m x4, y4, z4
_MapTriangle (0, 150)-(150, 150)-(0, 300), box1b To(x1, y1, z1)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
_MapTriangle (150, 300)-(150, 150)-(0, 300), box1b To(x4, y4, z4)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
'box side5
x1 = bx(1, 1): y1 = bx(1, 2): z1 = bx(1, 3): r2m x1, y1, z1: x2 = bx(7, 1): y2 = bx(7, 2): z2 = bx(7, 3): r2m x2, y2, z2
x3 = bx(3, 1): y3 = bx(3, 2): z3 = bx(3, 3): r2m x3, y3, z3: x4 = bx(8, 1): y4 = bx(8, 2): z4 = bx(8, 3): r2m x4, y4, z4
_MapTriangle (150, 150)-(300, 150)-(150, 300), box1b To(x1, y1, z1)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
_MapTriangle (300, 300)-(300, 150)-(150, 300), box1b To(x4, y4, z4)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
'box side6
x1 = bx(7, 1): y1 = bx(7, 2): z1 = bx(7, 3): r2m x1, y1, z1: x2 = bx(5, 1): y2 = bx(5, 2): z2 = bx(5, 3): r2m x2, y2, z2
x3 = bx(8, 1): y3 = bx(8, 2): z3 = bx(8, 3): r2m x3, y3, z3: x4 = bx(6, 1): y4 = bx(6, 2): z4 = bx(6, 3): r2m x4, y4, z4
_MapTriangle (300, 150)-(450, 150)-(300, 300), box1b To(x1, y1, z1)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
_MapTriangle (450, 300)-(450, 150)-(300, 300), box1b To(x4, y4, z4)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
'_MapTriangle (0, 0)-(x, 0)-(0, y), image1 To(x1, y1, z1)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
'_MapTriangle (x, y)-(x, 0)-(0, y), image1 To(x4, y4, z4)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
'draw sky *********************************************************************************
'rotating
For actual_point = 0 To sky_points - 1
sky_points(actual_point, 4) = sky_points(actual_point, 0)
sky_points(actual_point, 5) = sky_points(actual_point, 1)
sky_points(actual_point, 6) = sky_points(actual_point, 2)
r2m sky_points(actual_point, 4), sky_points(actual_point, 5), sky_points(actual_point, 6)
Next actual_point
For asq = 0 To sky_points - 1
wx0 = sky_points(sq(asq, 0), 4) + 0: wy0 = sky_points(sq(asq, 0), 5) + 0: wz0 = sky_points(sq(asq, 0), 6)
wx1 = sky_points(sq(asq, 1), 4) + 0: wy1 = sky_points(sq(asq, 1), 5) + 0: wz1 = sky_points(sq(asq, 1), 6)
wx2 = sky_points(sq(asq, 2), 4) + 0: wy2 = sky_points(sq(asq, 2), 5) + 0: wz2 = sky_points(sq(asq, 2), 6)
wx3 = sky_points(sq(asq, 3), 4) + 0: wy3 = sky_points(sq(asq, 3), 5) + 0: wz3 = sky_points(sq(asq, 3), 6)
sy0 = sq(asq, 6): sx0 = sq(asq, 4): sy1 = sq(asq, 7): sx1 = sq(asq, 4): sy2 = sq(asq, 6): sx2 = sq(asq, 5): sy3 = sq(asq, 7): sx3 = sq(asq, 5)
_MapTriangle (sx0, sy0)-(sx1, sy1)-(sx2, sy2), sky_image To(wx0, wy0, wz0)-(wx1, wy1, wz1)-(wx2, wy2, wz2), , _Smooth
_MapTriangle (sx3, sy3)-(sx1, sy1)-(sx2, sy2), sky_image To(wx3, wy3, wz3)-(wx1, wy1, wz1)-(wx2, wy2, wz2), , _Smooth
Next asq
' ****************************************************************************************************
'_MapTriangle (0, 0)-(x, 0)-(0, y), image1 To(x1, y1, z1)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
'_MapTriangle (x, y)-(x, 0)-(0, y), image1 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 = .0007 '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))
sp3 = sp(3) + (_KeyDown(Asc("d")) - _KeyDown(Asc("a"))) * 90 * pip180
vec_x = (Sin(sp3) * (Cos(sp(4) + _Pi)))
vec_y = (Cos(sp3) * (Cos(sp(4) + _Pi)))
vec_z = -Sin(sp(4) + _Pi)
If _KeyDown(Asc("a")) Or _KeyDown(Asc("d")) Then vec_z = 0
speed = 1.1 'moving speed
moving = Abs(_MouseButton(1) Or _KeyDown(Asc("w")) Or _KeyDown(Asc("a")) Or _KeyDown(Asc("d"))) * 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
'If sp(0) > 465 Then sp(0) = 465
'If sp(1) > 465 Then sp(1) = 465
'If sp(0) < 35 Then sp(0) = 35
'If sp(1) < 35 Then sp(1) = 35
Loop Until _KeyDown(27)
'=============================================================================================================
'=============================================================================================================
'=============================================================================================================
'=============================================================================================================
Sub rot2 (x, y, ang)
Dim x1, y1
x1 = x * Cos(ang) - y * Sin(ang)
y1 = x * Sin(ang) + y * Cos(ang)
x = x1: y = y1
End Sub
Sub r2m (x, y, z)
Dim x2, y2, z2
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)
Dim x1, y1
x1 = x * Cos(ang) - y * Sin(ang)
y1 = x * Sin(ang) + y * Cos(ang)
x = x1: y = y1
End Sub
Sub makefloor
Dim t, x1, y1
Cls
Line (0, 0)-(500, 500), c(18), BF 'floor background
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 (0, 0)-(500, 500), 0, floor1, (0, 0)-(500, 500)
'Sleep
End Sub
Sub makewall
Dim t, x1, y1
Cls
Line (0, 0)-(500, 100), c(15), BF 'wall background
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
_Display
_PutImage (0, 0)-(500, 100), 0, wall1, (0, 0)-(500, 100)
_ClearColor c(0), wall1
'Sleep
End Sub
Sub makewall2
Dim t, x1, y1
Cls
Line (0, 0)-(500, 100), c(15), BF 'wall2 background
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
Line (70, 25)-(150, 75), c(0), BF
Line (210, 25)-(290, 75), c(0), BF
Line (350, 25)-(430, 75), c(0), BF
_Display
_PutImage (0, 0)-(500, 100), 0, wall2, (0, 0)-(500, 100)
_ClearColor c(0), wall2
'Sleep
End Sub
Sub makeceiling
Dim t, t2
Cls
Line (0, 0)-(500, 500), c(18), BF 'ceiling background
Line (2, 2)-(498, 498), c(17), BF 'ceiling light background
For t = 26 To 540 Step 32
Line (t - 1, 0)-(t, 500), c(18), BF
Line (0, t - 1)-(500, t), c(18), BF
Next t
For t = 32 To 470 Step 128
For t2 = 32 To 470 Step 128
Paint (t, t2), c(1), c(18)
Next t2
Next t
_Display
_PutImage (0, 0)-(500, 500), 0, ceiling1, (0, 0)-(500, 500)
_ClearColor c(0), ceiling1
'Sleep
End Sub
Sub makeground
Dim t, x1, y1
Cls
Line (0, 0)-(500, 500), c(20), BF 'ground background
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 (0, 0)-(500, 500), 0, ground1, (0, 0)-(500, 500)
'Sleep
End Sub
Sub makesky
Dim t, x1, y, m, r
Cls
y = 750
For t = 1 To y
m = 255 * ((750 - t * .95) / 750)
c(99) = _RGBA(180, 180, 255, m)
Line (0, t)-(750, t), c(99)
Next t
'For t = 0 To 750 Step 25 'longituge lines
'Line (t, 0)-(t, 750), c(1)
'Next t
'For t = 0 To 750 Step 25 'latitude lines
'Line (0, t)-(750, t), c(1)
'Next t
_Display
_PutImage (0, 0)-(750, 750), 0, sky1, (0, 0)-(750, 750)
'Sleep
End Sub
Sub makebox
Dim t, x1, y1
Cls
Line (0, 0)-(450, 300), c(1), BF
Line (0, 150)-(450, 150), c(0): Line (0, 300)-(450, 300), c(0)
Line (150, 0)-(150, 300), c(0): Line (300, 0)-(300, 300), c(0)
'Paint (10, 10), c(4), c(0)
Paint (160, 10), c(4), c(0)
Paint (310, 10), c(5), c(0)
Paint (10, 160), c(6), c(0)
Paint (160, 160), c(7), c(0)
Paint (310, 160), c(8), c(0)
_Display
_PutImage (0, 0)-(500, 500), 0, box1, (0, 0)-(500, 500)
'Sleep
End Sub
Sub boxmove
Dim t
If fx = 0 Then
For t = 1 To 8
bx(t, 1) = bx(t, 1) + 1
If bx(t, 1) > 140 Then
fx = 1
End If
Next t
End If
If fx = 1 Then
For t = 1 To 8
bx(t, 2) = bx(t, 2) - 1
If bx(t, 2) < -300 Then
fx = 2
End If
Next t
End If
If fx = 2 Then
For t = 1 To 8
bx(t, 1) = bx(t, 1) - 1
If bx(t, 1) < -140 Then
fx = 3
End If
Next t
End If
If fx = 3 Then
For t = 1 To 8
bx(t, 2) = bx(t, 2) + 1
If bx(t, 2) > 300 Then
fx = 0
End If
Next t
End If
End Sub
Sub maptexture (image1, x, y, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4)
_MapTriangle (0, 0)-(x, 0)-(0, y), image1 To(x1, y1, z1)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
_MapTriangle (x, y)-(x, 0)-(0, y), image1 To(x4, y4, z4)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
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)
c(18) = _RGB(100, 100, 100)
c(20) = _RGB(40, 40, 10)
End SubRE: 3d surface images - james2464 - 12-21-2022
Now the cube rotates while it's floating.
Code: (Select All)
'3d globe with office - james2464 - Dec 20 2022
'Credit to 3D program and tutorial by MasterGy
Option _Explicit
Randomize Timer
Screen _NewImage(1000, 1000, 32)
Const pip180 = 3.141592 / 180
Dim Shared c(100) As Long
Dim floor1b, wall1b, wall2b, ceiling1b, ground1b, sky1b, box1b
Dim scr, da, db, da2, dega, db2, degb, ss, ap, sqa, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4
Dim sky_points, sky_image
Dim actual_point, asq
Dim wx0, wy0, wz0, wx1, wy1, wz1, wx2, wy2, wz2, wx3, wy3, wz3, sx0, sy0, sx1, sy1, sx2, sy2, sx3, sy3
Dim mousex, mousey, mw, mouse_sens, vec_x, vec_y, vec_z, speed, moving
Dim sp3
Dim Shared bx(8, 3), fx, fy, fz
fx = 0: fy = 0: fz = 0
Cls
colour1
Dim Shared floor1, wall1, wall2, ceiling1, ground1, sky1, box1
'create floor image
floor1 = _NewImage(500, 500, 32)
makefloor
'create wall1 image
wall1 = _NewImage(500, 100, 32)
makewall
'create wall2 image
wall2 = _NewImage(500, 100, 32)
makewall2
'create ceiling image
ceiling1 = _NewImage(500, 500, 32)
makeceiling
'create ground image
ground1 = _NewImage(500, 500, 32)
makeground
'create sky image
sky1 = _NewImage(750, 750, 32)
makesky
'create box image
box1 = _NewImage(500, 500, 32)
makebox
'starting box points
bx(1, 1) = -5: bx(1, 2) = -120: bx(1, 3) = 460
bx(2, 1) = -5: bx(2, 2) = -120: bx(2, 3) = 450
bx(3, 1) = 5: bx(3, 2) = -120: bx(3, 3) = 460
bx(4, 1) = 5: bx(4, 2) = -120: bx(4, 3) = 450
bx(5, 1) = -5: bx(5, 2) = -110: bx(5, 3) = 450
bx(6, 1) = 5: bx(6, 2) = -110: bx(6, 3) = 450
bx(7, 1) = -5: bx(7, 2) = -110: bx(7, 3) = 460
bx(8, 1) = 5: bx(8, 2) = -110: bx(8, 3) = 460
floor1b = _CopyImage(floor1, 33)
wall1b = _CopyImage(wall1, 33)
wall2b = _CopyImage(wall2, 33)
ceiling1b = _CopyImage(ceiling1, 33)
ground1b = _CopyImage(ground1, 33)
sky1b = _CopyImage(sky1, 33)
box1b = _CopyImage(box1, 33)
'create spectator
Dim Shared sp(6)
sp(0) = 0 'X position
sp(1) = 0 'Y
sp(2) = 450 'Z
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
'sky install *********************************************************************************
da = 60 'resolution sphere X
db = 60 'resolution sphere Y
sky_points = da * db
Dim sky_points(sky_points - 1, 9), sq(sky_points - 1, 7)
'sky_image = _LoadImage("sky.jpg", 33)
sky_image = _CopyImage(sky1, 33)
For da2 = 0 To da - 1
dega = 360 / (da - 1) * da2 * pip180
For db2 = 0 To db - 1
degb = 180 / (db - 1) * db2 * pip180
ss = 1500
ap = da2 * db + db2
sky_points(ap, 0) = Sin(degb) * Cos(dega) * ss
sky_points(ap, 1) = Sin(degb) * Sin(dega) * ss
sky_points(ap, 2) = Cos(degb) * ss
Next db2
Next da2
For da2 = 0 To da - 2
For db2 = 0 To db - 2
sqa = da2 * db + db2
sq(sqa, 0) = sqa
sq(sqa, 1) = sq(sqa, 0) + 1
sq(sqa, 2) = sq(sqa, 0) + db
sq(sqa, 3) = sq(sqa, 2) + 1
sq(sqa, 4) = _Width(sky_image) - (_Width(sky_image) / (da - 1) * da2) - 1
sq(sqa, 5) = _Width(sky_image) - (_Width(sky_image) / (da - 1) * (da2 + 1)) - 1
sq(sqa, 6) = Int(_Height(sky_image) / (db - 1) * db2)
sq(sqa, 7) = Int(_Height(sky_image) / (db - 1) * (db2 + 1))
Next db2
Next da2
'*********************************************************************************************
'=============================================================================================================
'=============================================================================================================
'=============================================================================================================
'=============================================================================================================
Do
_Limit 40
boxrotate
boxmove
'floor
x1 = -250: y1 = -250: z1 = 500: r2m x1, y1, z1: x2 = 250: y2 = -250: z2 = 500: r2m x2, y2, z2
x3 = -250: y3 = 250: z3 = 500: r2m x3, y3, z3: x4 = 250: y4 = 250: z4 = 500: r2m x4, y4, z4
maptexture floor1b, 500, 500, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4
'wall 1
x1 = -250: y1 = -250: z1 = 400: r2m x1, y1, z1: x2 = 250: y2 = -250: z2 = 400: r2m x2, y2, z2
x3 = -250: y3 = -250: z3 = 500: r2m x3, y3, z3: x4 = 250: y4 = -250: z4 = 500: r2m x4, y4, z4
maptexture wall2b, 500, 100, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4
'wall 2
x1 = 250: y1 = 250: z1 = 400: r2m x1, y1, z1: x2 = -250: y2 = 250: z2 = 400: r2m x2, y2, z2
x3 = 250: y3 = 250: z3 = 500: r2m x3, y3, z3: x4 = -250: y4 = 250: z4 = 500: r2m x4, y4, z4
maptexture wall2b, 500, 100, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4
'wall 3
x1 = 250: y1 = -250: z1 = 300: r2m x1, y1, z1: x2 = 250: y2 = 250: z2 = 400: r2m x2, y2, z2
x3 = 250: y3 = -250: z3 = 500: r2m x3, y3, z3: x4 = 250: y4 = 250: z4 = 500: r2m x4, y4, z4
maptexture wall1b, 500, 100, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4
'wall 4
x1 = -250: y1 = 250: z1 = 400: r2m x1, y1, z1: x2 = -250: y2 = -250: z2 = 300: r2m x2, y2, z2
x3 = -250: y3 = 250: z3 = 500: r2m x3, y3, z3: x4 = -250: y4 = -250: z4 = 500: r2m x4, y4, z4
maptexture wall1b, 500, 100, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4
'wall 5 - above wall 1
x1 = -250: y1 = -250: z1 = 300: r2m x1, y1, z1: x2 = 250: y2 = -250: z2 = 300: r2m x2, y2, z2
x3 = -250: y3 = -250: z3 = 400: r2m x3, y3, z3: x4 = 250: y4 = -250: z4 = 400: r2m x4, y4, z4
maptexture wall1b, 500, 100, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4
'ceiling
x1 = -250: y1 = -250: z1 = 300: r2m x1, y1, z1: x2 = 250: y2 = -250: z2 = 300: r2m x2, y2, z2
x3 = -250: y3 = 250: z3 = 400: r2m x3, y3, z3: x4 = 250: y4 = 250: z4 = 400: r2m x4, y4, z4
maptexture ceiling1b, 500, 500, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4
'ground
x1 = -1500: y1 = -1500: z1 = 502: r2m x1, y1, z1: x2 = 1500: y2 = -1500: z2 = 502: r2m x2, y2, z2
x3 = -1500: y3 = 1500: z3 = 502: r2m x3, y3, z3: x4 = 1500: y4 = 1500: z4 = 502: r2m x4, y4, z4
maptexture ground1b, 500, 500, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4
'box side1
x1 = bx(1, 1): y1 = bx(1, 2): z1 = bx(1, 3): r2m x1, y1, z1: x2 = bx(2, 1): y2 = bx(2, 2): z2 = bx(2, 3): r2m x2, y2, z2
x3 = bx(3, 1): y3 = bx(3, 2): z3 = bx(3, 3): r2m x3, y3, z3: x4 = bx(4, 1): y4 = bx(4, 2): z4 = bx(4, 3): r2m x4, y4, z4
_MapTriangle (0, 0)-(150, 0)-(0, 150), box1b To(x1, y1, z1)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
_MapTriangle (150, 150)-(150, 0)-(0, 150), box1b To(x4, y4, z4)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
'box side2
x1 = bx(2, 1): y1 = bx(2, 2): z1 = bx(2, 3): r2m x1, y1, z1: x2 = bx(5, 1): y2 = bx(5, 2): z2 = bx(5, 3): r2m x2, y2, z2
x3 = bx(4, 1): y3 = bx(4, 2): z3 = bx(4, 3): r2m x3, y3, z3: x4 = bx(6, 1): y4 = bx(6, 2): z4 = bx(6, 3): r2m x4, y4, z4
_MapTriangle (150, 0)-(300, 0)-(150, 150), box1b To(x1, y1, z1)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
_MapTriangle (300, 150)-(300, 0)-(150, 150), box1b To(x4, y4, z4)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
'box side3
x1 = bx(1, 1): y1 = bx(1, 2): z1 = bx(1, 3): r2m x1, y1, z1: x2 = bx(2, 1): y2 = bx(2, 2): z2 = bx(2, 3): r2m x2, y2, z2
x3 = bx(7, 1): y3 = bx(7, 2): z3 = bx(7, 3): r2m x3, y3, z3: x4 = bx(5, 1): y4 = bx(5, 2): z4 = bx(5, 3): r2m x4, y4, z4
_MapTriangle (300, 0)-(450, 0)-(300, 150), box1b To(x1, y1, z1)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
_MapTriangle (450, 150)-(450, 0)-(300, 150), box1b To(x4, y4, z4)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
'box side4
x1 = bx(3, 1): y1 = bx(3, 2): z1 = bx(3, 3): r2m x1, y1, z1: x2 = bx(4, 1): y2 = bx(4, 2): z2 = bx(4, 3): r2m x2, y2, z2
x3 = bx(8, 1): y3 = bx(8, 2): z3 = bx(8, 3): r2m x3, y3, z3: x4 = bx(6, 1): y4 = bx(6, 2): z4 = bx(6, 3): r2m x4, y4, z4
_MapTriangle (0, 150)-(150, 150)-(0, 300), box1b To(x1, y1, z1)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
_MapTriangle (150, 300)-(150, 150)-(0, 300), box1b To(x4, y4, z4)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
'box side5
x1 = bx(1, 1): y1 = bx(1, 2): z1 = bx(1, 3): r2m x1, y1, z1: x2 = bx(7, 1): y2 = bx(7, 2): z2 = bx(7, 3): r2m x2, y2, z2
x3 = bx(3, 1): y3 = bx(3, 2): z3 = bx(3, 3): r2m x3, y3, z3: x4 = bx(8, 1): y4 = bx(8, 2): z4 = bx(8, 3): r2m x4, y4, z4
_MapTriangle (150, 150)-(300, 150)-(150, 300), box1b To(x1, y1, z1)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
_MapTriangle (300, 300)-(300, 150)-(150, 300), box1b To(x4, y4, z4)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
'box side6
x1 = bx(7, 1): y1 = bx(7, 2): z1 = bx(7, 3): r2m x1, y1, z1: x2 = bx(5, 1): y2 = bx(5, 2): z2 = bx(5, 3): r2m x2, y2, z2
x3 = bx(8, 1): y3 = bx(8, 2): z3 = bx(8, 3): r2m x3, y3, z3: x4 = bx(6, 1): y4 = bx(6, 2): z4 = bx(6, 3): r2m x4, y4, z4
_MapTriangle (300, 150)-(450, 150)-(300, 300), box1b To(x1, y1, z1)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
_MapTriangle (450, 300)-(450, 150)-(300, 300), box1b To(x4, y4, z4)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
'_MapTriangle (0, 0)-(x, 0)-(0, y), image1 To(x1, y1, z1)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
'_MapTriangle (x, y)-(x, 0)-(0, y), image1 To(x4, y4, z4)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
'draw sky *********************************************************************************
'rotating
For actual_point = 0 To sky_points - 1
sky_points(actual_point, 4) = sky_points(actual_point, 0)
sky_points(actual_point, 5) = sky_points(actual_point, 1)
sky_points(actual_point, 6) = sky_points(actual_point, 2)
r2m sky_points(actual_point, 4), sky_points(actual_point, 5), sky_points(actual_point, 6)
Next actual_point
For asq = 0 To sky_points - 1
wx0 = sky_points(sq(asq, 0), 4) + 0: wy0 = sky_points(sq(asq, 0), 5) + 0: wz0 = sky_points(sq(asq, 0), 6)
wx1 = sky_points(sq(asq, 1), 4) + 0: wy1 = sky_points(sq(asq, 1), 5) + 0: wz1 = sky_points(sq(asq, 1), 6)
wx2 = sky_points(sq(asq, 2), 4) + 0: wy2 = sky_points(sq(asq, 2), 5) + 0: wz2 = sky_points(sq(asq, 2), 6)
wx3 = sky_points(sq(asq, 3), 4) + 0: wy3 = sky_points(sq(asq, 3), 5) + 0: wz3 = sky_points(sq(asq, 3), 6)
sy0 = sq(asq, 6): sx0 = sq(asq, 4): sy1 = sq(asq, 7): sx1 = sq(asq, 4): sy2 = sq(asq, 6): sx2 = sq(asq, 5): sy3 = sq(asq, 7): sx3 = sq(asq, 5)
_MapTriangle (sx0, sy0)-(sx1, sy1)-(sx2, sy2), sky_image To(wx0, wy0, wz0)-(wx1, wy1, wz1)-(wx2, wy2, wz2), , _Smooth
_MapTriangle (sx3, sy3)-(sx1, sy1)-(sx2, sy2), sky_image To(wx3, wy3, wz3)-(wx1, wy1, wz1)-(wx2, wy2, wz2), , _Smooth
Next asq
' ****************************************************************************************************
'_MapTriangle (0, 0)-(x, 0)-(0, y), image1 To(x1, y1, z1)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
'_MapTriangle (x, y)-(x, 0)-(0, y), image1 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 = .0007 '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))
sp3 = sp(3) + (_KeyDown(Asc("d")) - _KeyDown(Asc("a"))) * 90 * pip180
vec_x = (Sin(sp3) * (Cos(sp(4) + _Pi)))
vec_y = (Cos(sp3) * (Cos(sp(4) + _Pi)))
vec_z = -Sin(sp(4) + _Pi)
If _KeyDown(Asc("a")) Or _KeyDown(Asc("d")) Then vec_z = 0
speed = 1.1 'moving speed
moving = Abs(_MouseButton(1) Or _KeyDown(Asc("w")) Or _KeyDown(Asc("a")) Or _KeyDown(Asc("d"))) * 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
'If sp(0) > 465 Then sp(0) = 465
'If sp(1) > 465 Then sp(1) = 465
'If sp(0) < 35 Then sp(0) = 35
'If sp(1) < 35 Then sp(1) = 35
Loop Until _KeyDown(27)
'=============================================================================================================
'=============================================================================================================
'=============================================================================================================
'=============================================================================================================
Sub rot2 (x, y, ang)
Dim x1, y1
x1 = x * Cos(ang) - y * Sin(ang)
y1 = x * Sin(ang) + y * Cos(ang)
x = x1: y = y1
End Sub
Sub r2m (x, y, z)
Dim x2, y2, z2
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)
Dim x1, y1
x1 = x * Cos(ang) - y * Sin(ang)
y1 = x * Sin(ang) + y * Cos(ang)
x = x1: y = y1
End Sub
Sub makefloor
Dim t, x1, y1
Cls
Line (0, 0)-(500, 500), c(18), BF 'floor background
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 (0, 0)-(500, 500), 0, floor1, (0, 0)-(500, 500)
'Sleep
End Sub
Sub makewall
Dim t, x1, y1
Cls
Line (0, 0)-(500, 100), c(15), BF 'wall background
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
_Display
_PutImage (0, 0)-(500, 100), 0, wall1, (0, 0)-(500, 100)
_ClearColor c(0), wall1
'Sleep
End Sub
Sub makewall2
Dim t, x1, y1
Cls
Line (0, 0)-(500, 100), c(15), BF 'wall2 background
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
Line (70, 25)-(150, 75), c(0), BF
Line (210, 25)-(290, 75), c(0), BF
Line (350, 25)-(430, 75), c(0), BF
_Display
_PutImage (0, 0)-(500, 100), 0, wall2, (0, 0)-(500, 100)
_ClearColor c(0), wall2
'Sleep
End Sub
Sub makeceiling
Dim t, t2
Cls
Line (0, 0)-(500, 500), c(18), BF 'ceiling background
Line (2, 2)-(498, 498), c(17), BF 'ceiling light background
For t = 26 To 540 Step 32
Line (t - 1, 0)-(t, 500), c(18), BF
Line (0, t - 1)-(500, t), c(18), BF
Next t
For t = 32 To 470 Step 128
For t2 = 32 To 470 Step 128
Paint (t, t2), c(1), c(18)
Next t2
Next t
_Display
_PutImage (0, 0)-(500, 500), 0, ceiling1, (0, 0)-(500, 500)
_ClearColor c(0), ceiling1
'Sleep
End Sub
Sub makeground
Dim t, x1, y1
Cls
Line (0, 0)-(500, 500), c(20), BF 'ground background
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 (0, 0)-(500, 500), 0, ground1, (0, 0)-(500, 500)
'Sleep
End Sub
Sub makesky
Dim t, x1, y, m, r
Cls
y = 750
For t = 1 To y
m = 255 * ((750 - t * .95) / 750)
c(99) = _RGBA(180, 180, 255, m)
Line (0, t)-(750, t), c(99)
Next t
'For t = 0 To 750 Step 25 'longituge lines
'Line (t, 0)-(t, 750), c(1)
'Next t
'For t = 0 To 750 Step 25 'latitude lines
'Line (0, t)-(750, t), c(1)
'Next t
_Display
_PutImage (0, 0)-(750, 750), 0, sky1, (0, 0)-(750, 750)
'Sleep
End Sub
Sub makebox
Dim t, x1, y1
Cls
Line (0, 0)-(450, 300), c(1), BF
Line (0, 150)-(450, 150), c(0): Line (0, 300)-(450, 300), c(0)
Line (150, 0)-(150, 300), c(0): Line (300, 0)-(300, 300), c(0)
'Paint (10, 10), c(4), c(0)
Paint (160, 10), c(4), c(0)
Paint (310, 10), c(5), c(0)
Paint (10, 160), c(6), c(0)
Paint (160, 160), c(7), c(0)
Paint (310, 160), c(8), c(0)
_Display
_PutImage (0, 0)-(500, 500), 0, box1, (0, 0)-(500, 500)
'Sleep
End Sub
Sub boxrotate
Dim t, xt, yt, xc, yc, h1, h2, h, xt2, yt2
h = 7.07107 'based on cube size 10
'find XY center of cube using points 2 and 6
xc = Abs(bx(2, 1) - bx(6, 1))
If bx(6, 1) > bx(2, 1) Then
xc = bx(6, 1) - xc / 2
Else
xc = bx(2, 1) - xc / 2
End If
yc = Abs(bx(2, 2) - bx(6, 2))
If bx(6, 2) > bx(2, 2) Then
yc = bx(6, 2) - yc / 2
Else
yc = bx(2, 2) - yc / 2
End If
'XY rotation
For t = 1 To 8 'calculate rotation amount (radians) and update each point
xt = bx(t, 1)
yt = bx(t, 2)
h1 = _Atan2(xt - xc, yt - yc)
h2 = h1 + .05
xt2 = Sin(h2) * h
yt2 = Cos(h2) * h
bx(t, 1) = xc + xt2
bx(t, 2) = yc + yt2
Next t
End Sub
Sub boxmove
Dim t
If fx = 0 Then
For t = 1 To 8
bx(t, 1) = bx(t, 1) + 1
If bx(t, 1) > 140 Then
fx = 1
End If
Next t
End If
If fx = 1 Then
For t = 1 To 8
bx(t, 2) = bx(t, 2) - 1
If bx(t, 2) < -300 Then
fx = 2
End If
Next t
End If
If fx = 2 Then
For t = 1 To 8
bx(t, 1) = bx(t, 1) - 1
If bx(t, 1) < -140 Then
fx = 3
End If
Next t
End If
If fx = 3 Then
For t = 1 To 8
bx(t, 2) = bx(t, 2) + 1
If bx(t, 2) > 300 Then
fx = 0
End If
Next t
End If
End Sub
Sub maptexture (image1, x, y, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4)
_MapTriangle (0, 0)-(x, 0)-(0, y), image1 To(x1, y1, z1)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
_MapTriangle (x, y)-(x, 0)-(0, y), image1 To(x4, y4, z4)-(x2, y2, z2)-(x3, y3, z3), , _Smooth
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)
c(18) = _RGB(100, 100, 100)
c(20) = _RGB(40, 40, 10)
End Sub