3d surface images

[james2464]

In my code the image won't appear...but I checked and cannot find anything wrong with the variables.   I'm trying to understand what everything does, and it's starting to make sense.    But still a mystery why the image does not show up.


So I decided to look at your program some more.  (Terrain 39 - v25_01.bas)    I got the idea to try to make a checkered sky, by making these changes:

Code: (Select All)

da = 19: db = 19: 'was da=8: db=8

Code: (Select All)

    j = 1 'add toggle

    'draw sky
    temp1 = bc_c / (col_width - 1) * acol: temp2 = Int(temp1): temp4 = temp1 - temp2: temp3 = (temp2 + 1) Mod bc_c: temp2 = temp2 Mod bc_c
    ad = 320 - Interpolate(sky_s(temp2, 1), sky_s(temp3, 1), temp4) * 250: asi = sky_s(temp2, 0) Mod 2:
    If ad > 255 Then ad = 255
    If ad < 0 Then ad = 0

    For actual_point = 0 To skyp - 1: skyp(actual_point, 4) = skyp(actual_point, 0): skyp(actual_point, 5) = skyp(actual_point, 1): skyp(actual_point, 6) = skyp(actual_point, 2)
        rotate skyp(actual_point, 4), skyp(actual_point, 5), skyp(actual_point, 6)
    For t = 0 To 2: skyp(actual_point, 7 + t) = skyp(actual_point, 4 + t) * .96: Next t, actual_point

    For asq = 0 To skyp - 1: For t = 0 To 3: For t2 = 0 To 5: p(t, t2) = skyp(sq(asq, t), 4 + t2): Next t2, t
        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)
        If sq(asq, 8) = 1 Then sx1 = _Width(sky_text(asi)) / 2: sx3 = sx1
        If sq(asq, 8) = 2 Then sx0 = _Width(sky_text(asi)) / 2: sx2 = sx0
        j = j * -1 'switch toggle
        If j > 0 Then 'only draw half the sections
            _MapTriangle (sx0, sy0)-(sx1, sy1)-(sx2, sy2), sky_text(asi) To(p(0, 0), p(0, 1), p(0, 2))-(p(1, 0), p(1, 1), p(1, 2))-(p(2, 0), p(2, 1), p(2, 2))
            _MapTriangle (sx3, sy3)-(sx1, sy1)-(sx2, sy2), sky_text(asi) To(p(3, 0), p(3, 1), p(3, 2))-(p(1, 0), p(1, 1), p(1, 2))-(p(2, 0), p(2, 1), p(2, 2))
        End If
        '_MapTriangle (acol, ad)-(acol, ad)-(acol, ad), shdw_text To(p(0, 3), p(0, 4), p(0, 5))-(p(1, 3), p(1, 4), p(1, 5))-(p(2, 3), p(2, 4), p(2, 5))
        '_MapTriangle (acol, ad)-(acol, ad)-(acol, ad), shdw_text To(p(3, 3), p(3, 4), p(3, 5))-(p(1, 3), p(1, 4), p(1, 5))-(p(2, 3), p(2, 4), p(2, 5))
    Next asq

In other words, the sky sections are drawn vertically.   So to get a checkered pattern, first I had to change it to an odd number of sections.   Then I set a toggle to only draw every other section.   And now you can see the sky sections.  If it's an even number of sections it looks like this:




Anyway I will keep trying to figure out why no image appears in my code.   Here is the code if you want to check it.
I suspect it's the rotation sub.   I tried 2 versions of this but no luck yet.

Code: (Select All)

'3d Room - james2464 - Dec 18 2022

'Credit to 3D program and tutorial by MasterGy
Option _Explicit
Randomize Timer

Screen _NewImage(1000, 600, 32)

Const pip180 = 3.141592 / 180

Dim Shared c(100) As Long

Dim bgspace, floor1b, wall1b, wall2b, ceiling1b, ground1b
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, actual_points, 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


bgspace = _NewImage(1000, 600, 32)
Line (1, 1)-(1000, 600), _RGB(120, 120, 180), BF
_PutImage (1, 1)-(1000, 600), 0, bgspace, (1, 1)-(1000, 600)

Cls


colour1

Dim Shared floor1, wall1, wall2, ceiling1, ground1

'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




floor1b = _CopyImage(floor1, 33)
wall1b = _CopyImage(wall1, 33)
wall2b = _CopyImage(wall2, 33)
ceiling1b = _CopyImage(ceiling1, 33)
ground1b = _CopyImage(ground1, 33)

'create spectator
Dim Shared sp(6)
sp(0) = 250 'X position
sp(1) = 250 '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 = 8 'resolution sphere X
db = 8 'resolutin sphere Y


sky_points = da * db
Dim sky_points(sky_points - 1, 9), sq(sky_points - 1, 7)
sky_image = _LoadImage("sky.jpg", 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 = 1400
        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 = 0: y1 = 0: z1 = 500: r2m x1, y1, z1: x2 = 500: y2 = 0: z2 = 500: r2m x2, y2, z2
    x3 = 0: y3 = 500: z3 = 500: r2m x3, y3, z3: x4 = 500: y4 = 500: 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 = 0: y1 = 0: z1 = 400: r2m x1, y1, z1: x2 = 500: y2 = 0: z2 = 400: r2m x2, y2, z2
    x3 = 0: y3 = 0: z3 = 500: r2m x3, y3, z3: x4 = 500: y4 = 0: 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 = 500: y1 = 500: z1 = 400: r2m x1, y1, z1: x2 = 0: y2 = 500: z2 = 400: r2m x2, y2, z2
    x3 = 500: y3 = 500: z3 = 500: r2m x3, y3, z3: x4 = 0: y4 = 500: 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 = 500: y1 = 0: z1 = 300: r2m x1, y1, z1: x2 = 500: y2 = 500: z2 = 400: r2m x2, y2, z2
    x3 = 500: y3 = 0: z3 = 500: r2m x3, y3, z3: x4 = 500: y4 = 500: 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 = 0: y1 = 500: z1 = 400: r2m x1, y1, z1: x2 = 0: y2 = 0: z2 = 300: r2m x2, y2, z2
    x3 = 0: y3 = 500: z3 = 500: r2m x3, y3, z3: x4 = 0: y4 = 0: z4 = 500: r2m x4, y4, z4
    maptexture wall1b, 500, 100, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4

    'ceiling
    x1 = 0: y1 = 0: z1 = 300: r2m x1, y1, z1: x2 = 500: y2 = 0: z2 = 300: r2m x2, y2, z2
    x3 = 0: y3 = 500: z3 = 400: r2m x3, y3, z3: x4 = 500: y4 = 500: 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 = 2000: y2 = -1500: z2 = 502: r2m x2, y2, z2
    x3 = -1500: y3 = 2000: z3 = 502: r2m x3, y3, z3: x4 = 2000: y4 = 2000: 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 = 0: y1 = 0: z1 = 300: r2m x1, y1, z1: x2 = 500: y2 = 0: z2 = 300: r2m x2, y2, z2
    x3 = 0: y3 = 0: z3 = 400: r2m x3, y3, z3: x4 = 500: y4 = 0: 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_points, 0)
        sky_points(actual_point, 5) = sky_points(actual_points, 1)
        sky_points(actual_point, 6) = sky_points(actual_points, 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): wy0 = sky_points(sq(asq, 0), 5): wz0 = sky_points(sq(asq, 0), 6)
        wx1 = sky_points(sq(asq, 1), 4): wy1 = sky_points(sq(asq, 1), 5): wz1 = sky_points(sq(asq, 1), 6)
        wx2 = sky_points(sq(asq, 2), 4): wy2 = sky_points(sq(asq, 2), 5): wz2 = sky_points(sq(asq, 2), 6)
        wx3 = sky_points(sq(asq, 3), 4): wy3 = sky_points(sq(asq, 3), 5): 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 = 22 '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 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