12-21-2022, 07:45 PM
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