(04-15-2023, 03:08 PM)Petr Wrote: Yesterday I wrote here about how to implant sound to one place.
Also, in one of the previous demos - the one with the stars - I wrote there that it brings a useful thing - shooting a 2D texture to the user. So I just had to write it.

I am attaching another attachment of the 3D world. What was there stays there, a new piece has been added - behind the camera, so after starting, turn 180 degrees and go look there. Also, turn your sound on before you go there. No detonations await you, but... you will hear it yourself. I changed the fog to Martian sand so now the blackout is red. I have to say it's a great move. One can have a lot of fun writing the coordinates of an object that isn't there after launch... and look... it's flying pretty over my head... like yeah. Such relief is simply great.

I haven't tried display sheets yet, their time is yet to come. I also used a different texture for each part of the quadrics to show how to go about it.

To the program. The changes took place in the LOADTEXTURE function - it is written there in the form of a comment. In OpenGL, transparency is turned off by default, so if you take a textured image, first set it to a transparent background color, and then make it a texture, you shouldn't be surprised that the background doesn't disappear after you texture it to surface. In order to make it disappear, you have to use blending, and how to do it with and practical example is in this program.

Code: (Select All)

Declare CustomType Library
    Sub gluBuild2DMipmaps (ByVal Target As _Unsigned Long, Byval iFormat As Long, Byval Wdth As Long, Byval Hght As Long, Byval format As _Unsigned Long, Byval typ As _Unsigned Long, Byval dat As _Offset)
End Declare


Declare Library "help3"
    Sub initQuadric ()
    Sub drawCylinder (ByVal Baze As Double, Byval top As Double, Byval height As Double, Byval slices As Integer, Byval stacks As Integer)
    Sub drawDisk (ByVal inner As Double, Byval outer As Double, Byval slices As Integer, Byval loops As Integer)
    Sub drawSphere (ByVal radius As Double, Byval slices As Integer, Byval stacks As Integer)
    Sub drawCone (ByVal baze As Double, Byval height As Double, Byval slices As Integer, Byval stacks As Integer)
    Sub drawPartialDisk (ByVal inner As Double, Byval outter As Double, Byval slices As Integer, Byval loops As Integer, Byval start As Double, Byval sweep As Double) 'pokud nedas slovo BYVAL, predavas offsety!
End Declare


Type GL_Loader '                  array for loading textures
    PointerGL As Long
    TextureName As String
    Filtering As _Unsigned _Byte
End Type
ReDim Shared GLL(0) As GL_Loader, t As Long
Dim Shared GL_InitInfo As _Byte '  is need for OpenGL init
Dim Shared ExitSignal As _Byte '   is need for correct OpenGL exit when program end

Dim Shared As Long QuadricTexture, Silver, Tree, BirdSnd
Dim Shared As Single BirdVol

BirdVol = 1

'World3D coordinates array
Type Triangle
    TextureX As Single
    TextureY As Single
    VertexX As Single
    VertexY As Single
    VertexZ As Single
End Type

'World3D texture array
Type Texture_T
    FileName As String '                 texture file name
    Filter As _Byte '                    used texture filtering
    GL_Pointer As _Unsigned Long '       GL pointer (handle) for texture
End Type

ReDim Shared Triangles(0) As Triangle
ReDim Shared TriTextures(0) As Texture_T
Dim Shared Xpos, Zpos, Yrot, LookUpDown, WalkBias, Blend

'---FOG---
Dim Shared Fog, FogQuality
Dim Shared FogColor(3)
FogColor(0) = 0.9: FogColor(1) = 0.2: FogColor(2) = 0.1: FogColor(3) = 1
'---///---


_DisplayOrder _GLRender , _Software
_Title "World 3D"
LoadWorld "world.txt", Triangles(), TriTextures() 'just read TXT file and save coordinates to array Triangles and texture file names to  array TriTextures for us
'next step then is in _GL SUB - it call Init2 and there are all textures loaded to RAM

Const piover180 = 0.0174532925F 'the same function as _D2R  or  3.14/180
Screen _NewImage(1024, 768, 32)
Print "Welcome back in 2D world :)  Press Alt + F4 to end!"

_MouseHide
Do
    i& = _KeyHit
    While _MouseInput
        LookUpDown = LookUpDown + _MouseMovementY / 5 'Look up/down with mouse, angle is not locked!
        Heading = Heading - _MouseMovementX / 5: Yrot = Heading 'rotation left/right using mouse
        _MouseMove _Width / 2, _Height / 2
    Wend

    Select Case i&
        Case 20480 'arrow up
            Xpos = Xpos + Sin(Heading * piover180) * 0.05F
            Zpos = Zpos + Cos(Heading * piover180) * 0.05F
            If WalkBiasAngle >= 359.0F Then
                WalkBiasAngle = 0.0F
            Else
                WalkBiasAngle = WalkBiasAngle + 10
            End If
            WalkBias = Sin(WalkBiasAngle * piover180) / 20.0F



        Case 18432 'arrow down
            Xpos = Xpos - Sin(Heading * piover180) * 0.05F
            Zpos = Zpos - Cos(Heading * piover180) * 0.05F
            If WalkBiasAngle <= 1.0F Then
                WalkBiasAngle = 359.0F
            Else
                WalkBiasAngle = WalkBiasAngle - 10
            End If
            WalkBias = Sin(WalkBiasAngle * piover180) / 20.0F



        Case 19200 'arrow left
            Heading = Heading + 1
            Yrot = Heading
        Case 19712 'arrow right
            Heading = Heading - 1
            Yrot = Heading
        Case 81, 113 'Q - look up
            LookUpDown = LookUpDown - 1
        Case 65, 97 'A - look down
            LookUpDown = LookUpDown + 1
        Case 66, 98 'B
            Blend = Not Blend

    End Select '

    If ExitSignal Then
        _SndStop BirdSnd
        _SndClose BirdSnd
        System
    End If
    _Limit 50
Loop



Sub _GL ()

    Init2
    GL_Init


    '----- fog -----
    '                             X  Z   radius
    TestFog = IsOnPos(Xpos, Zpos, 0, -6, 7)
    If TestFog Then
        _glFogf _GL_FOG_DENSITY, TestFog / 2 '      fog density - Maximal TestFog Value is 1, so maximal FOG level is 1/2 = 50 percent.
        _glHint _GL_FOG_HINT, _GL_NICEST '          fog Quality
        _glFogf _GL_FOG_START, -6.0F '               fog begin in depth - axis z  'both this values are calculated for CAMERA
        _glFogf _GL_FOG_END, 6.0F '                 fog end in depth - axis z
    End If
    '-----------------------


    _glClear _GL_COLOR_BUFFER_BIT And _GL_DEPTH_BUFFER_BIT 'Clear screen and depth buffer


    _glMatrixMode _GL_PROJECTION '                          Set projection matrix  - TRY comment this five rows and then run it. Black screen occur. For view just something then must be depth set to -1 (Z parameter in _glTranslateF)
    _glLoadIdentity ' Reset matrix
    _gluPerspective 45.0F, _Width / _Height, 0.1F, 100.0F ' Perspective calculation
    _glMatrixMode _GL_MODELVIEW '                           set modelview matrix

    texture = TriTextures(0).GL_Pointer

    '-------------------------------
    Locate 1: Print Xpos, Zpos, BirdSnd
    '-------------------------------

    Xtrans = -Xpos 'for walking in X axis
    Ztrans = -Zpos 'for walking in Z axis
    Ytrans = -WalkBias - 0.25F 'simulation steps
    SceneRotY = 360.0F - Yrot 'angle direction of view

    _glRotatef LookUpDown, 1.0F, 0.0F, 0.0F 'rotation i X axis - view up and down
    _glRotatef SceneRotY, 0.0F, 1.0F, 0.0F 'rotation in Y axis - rotation to left / right
    _glTranslatef Xtrans, Ytrans, Ztrans ' move to position (shift) in scene

    Triangles = UBound(Triangles) - 3 'total triangles used in txt file
    TriTextures_i = -1

    For l = 0 To Triangles Step 3 'step 3 - because triangle = 3 vertexes

        If l Mod 6 = 0 Then ' 6 is 6 vertexes for 2 triangle (1 quad)
            If TriTextures_i + 1 < UBound(TriTextures) Then 'if in texture array index is not UBOUND
                If TriTextures(TriTextures_i + 1).GL_Pointer > 0 Then 'if tritexture array  contains next valid texture
                    TriTextures_i = TriTextures_i + 1 '                increase index
                    texture = TriTextures(TriTextures_i).GL_Pointer ' insert next texture
                End If
            End If
        End If

        _glBindTexture _GL_TEXTURE_2D, texture 'tohle bude ve smycce vzdy po sesti bodech (6 bodu = 2 trojuhelniky)
        _glBegin _GL_TRIANGLES
        _glNormal3f 0.0F, 0.0F, 1.0F 'for light

        X_m = Triangles(l).VertexX
        Y_m = Triangles(l).VertexY
        Z_m = Triangles(l).VertexZ
        U_m = Triangles(l).TextureX
        V_m = Triangles(l).TextureY
        _glTexCoord2f U_m, V_m '     place texture first vertex
        _glVertex3f X_m, Y_m, Z_m '  place triangle first vertex

        X_m = Triangles(l + 1).VertexX
        Y_m = Triangles(l + 1).VertexY
        Z_m = Triangles(l + 1).VertexZ
        U_m = Triangles(l + 1).TextureX
        V_m = Triangles(l + 1).TextureY
        _glTexCoord2f U_m, V_m '     place texture second vertex
        _glVertex3f X_m, Y_m, Z_m '  place triangle second vertex

        X_m = Triangles(l + 2).VertexX
        Y_m = Triangles(l + 2).VertexY
        Z_m = Triangles(l + 2).VertexZ
        U_m = Triangles(l + 2).TextureX
        V_m = Triangles(l + 2).TextureY
        _glTexCoord2f U_m, V_m '     place texture third vertex
        _glVertex3f X_m, Y_m, Z_m '  place triangle third vertex
        _glEnd
    Next
    '---------------------------------------------------------------------
    'for quadrics:
    _glBindTexture _GL_TEXTURE_2D, QuadricTexture&
    'shift in scene to sphere position
    _glTranslatef 2, 0, -7 ' move to position (shift) in scene
    _glRotatef 180, 0, -1, -1
    drawCylinder 0.15, 0.1, 0.7, 20, 20
    _glTranslatef 0, 0, .8
    _glBindTexture _GL_TEXTURE_2D, Silver&
    drawSphere .3, 40, 40



    ' ------------------------ TREE ADD ONS ---------------------

    _glRotatef 180, 0, 1, 1 'We need to turn in the right direction, because now we are rotated after previously setting the direction of painting the cylinder
    '                        - then we could easily have the Z axis become the X axis and so on... Yeah, the tree flew over my head too. That was news... :)

    'next addons: make 2D quad textured as tree and rotate it to user
    _glTranslatef -3, .05, 12.5 'shift to tree position

    _glRotatef -SceneRotY, 0, 1, 0 'rotate this 2D texture - The textured rectangle with transparency rotates against the direction of the camera, making the tree appear to be truly 3D.
    _glBindTexture _GL_TEXTURE_2D, Tree&

    _glEnable _GL_BLEND 'Please be aware of the change. In order to set the transparent white background of the PHOTO of the tree,
    _glBlendFunc _GL_SRC_ALPHA, _GL_ONE_MINUS_SRC_ALPHA '                 blending type for transparency
    'https://learn.microsoft.com/en-us/windows/win32/opengl/glblendfunc   microsoft help really helped me a lot this time

    '                    an adjustment was also made in the LOADTEXTURE function, check it out!
    _glBegin _GL_QUADS
    _glNormal3f 0.0F, 0.0F, 1.0F 'for light

    _glTexCoord2f 0.0F, 0.0F: _glVertex3f -1.0F, -1.0F, 0.0F
    _glTexCoord2f 1.0F, 0.0F: _glVertex3f 1.0F, -1.0F, 0.0F
    _glTexCoord2f 1.0F, 1.0F: _glVertex3f 1.0F, 1.0F, 0.0F
    _glTexCoord2f 0.0F, 1.0F: _glVertex3f -1.0F, 1.0F, 0.0F

    _glEnd
    _glDisable _GL_BLEND


    'birds voice!
    BirdVol = IsOnPos(Xpos, Zpos, -.9, 5.4, 3)
    _SndVol BirdSnd&, BirdVol
    '----------------------- TREE END -----------------------------------



    'shift and rotate back

    _glRotatef SceneRotY, 0.0F, 1.0F, 0.0F 'rotation in Y axis - rotation to left / right
    _glTranslatef Xtrans, Ytrans, Ztrans ' move to position (shift) in scene


    If _Exit Then
        '  DeleteTexture t 'if program end, first free texture from memory, then exit from GL and return to main loop
        KillAllTextures
        _glClear _GL_COLOR_BUFFER_BIT
        ExitSignal = Not 0
        Exit Sub
    End If

End Sub

Sub GL_Init
    If GL_InitInfo = 0 Then
        _glViewport 0, 0, _Width, _Height
        GL_InitInfo = 1
    End If
End Sub

Sub Init2

    _glEnable _GL_TEXTURE_2D 'allow texture maping
    _glBlendFunc _GL_SRC_ALPHA, _GL_ONE 'blending type for transparency
    _glClearColor 0.0, 0.0, 0.0, 0.5 'Black background
    _glClearDepth 1.0F '       depth buffer settings
    _glDepthFunc _GL_LESS '    depth testing type
    _glEnable _GL_DEPTH_TEST ' enable depth testing
    _glShadeModel _GL_SMOOTH 'allow smooth shading
    _glHint _GL_PERSPECTIVE_CORRECTION_HINT, _GL_NICEST ' best perspective projection

    If Blend Then
        _glEnable _GL_BLEND
    Else
        _glDisable _GL_BLEND
    End If


    If GL_InitInfo = 0 Then
        For l = 0 To UBound(TriTextures)
            If Len(TriTextures(l).FileName) Then t = LoadTexture(TriTextures(l).FileName, 1)
            TriTextures(l).GL_Pointer = t
            TriTextures(l).Filter = 1
        Next l

        '---- fog ----
        _glFogfv _GL_FOG_COLOR, _Offset(FogColor()) 'fog color
        '   _glFogf _GL_FOG_DENSITY, FogLevel 'fog density
        _glHint _GL_FOG_HINT, _GL_DONT_CARE 'middle fog quality
        _glEnable _GL_FOG
        '---- ---- ----
        initQuadric
        QuadricTexture = LoadTexture("0.png", 1)
        Silver = LoadTexture("silver.png", 1)
        Tree = LoadTexture("tree.png", 1)

        BirdSnd& = _SndOpen("bird-voices-7716.mp3")
        _SndLoop BirdSnd&

        Exit Sub
    End If
End Sub

Sub DeleteTexture (nr As Long)
    For P = LBound(GLL) To UBound(GLL)
        If GLL(P).PointerGL = nr Then
            Dim DEL As Long
            DEL = GLL(P).PointerGL
            _glDeleteTextures 1, _Offset(DEL)
            Exit Sub
        End If
    Next
End Sub

Sub KillAllTextures
    For P = LBound(GLL) To UBound(GLL)
        If GLL(P).PointerGL > 0 Then
            DeleteTexture P
            GLL(P).PointerGL = 0
        End If
    Next P
End Sub

Function LoadTexture (image As String, Filter As _Unsigned _Byte)
    If GL_InitInfo = 0 Then GL_Init
    If _FileExists(image) Then
        TT = 0
        Do Until TT = UBound(GLL)
            If GLL(TT).TextureName = image$ And GLL(TT).Filtering = Filter Then
                LoadTexture = GLL(TT).PointerGL 'prevent memory leak loading next and next texture again and angain...
                Exit Function
            End If
            TT = TT + 1
        Loop

        tex& = _LoadImage(image$, 32)
        '
        texinv& = _NewImage(_Width(tex&), _Height(tex&), 32)

        _PutImage (0, _Height(tex&))-(_Width(tex&), 0), tex&, texinv&

        If LCase$(image$) = "tree.png" Then _SetAlpha 0, _RGB32(200, 200, 200) To _RGB32(255, 255, 255), texinv& 'set white colors as transparent for BLENDING
        '                                                                                                         look also to row 381!


        ni& = _CopyImage(texinv&, 32) '_NewImage(32, 32, 32)

        Dim Texture As _Unsigned Long
        _glGenTextures 1, _Offset(Texture) 'generate our texture handle    (reserve place in memory for new texture)
        _glBindTexture _GL_TEXTURE_2D, Texture 'select our texture handle  (set this texture for use)

        Dim m As _MEM
        m = _MemImage(texinv&)

        Dim n As _MEM
        n = _MemImage(ni&)

        Select Case Filter
            Case -1
                'set our texture wrapping
                _glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_WRAP_S, _GL_REPEAT
                _glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_WRAP_T, _GL_REPEAT
            Case 0
                'set out texture filtering
                _glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_NEAREST 'for scaling up
                _glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_NEAREST 'for scaling down
            Case 1
                _glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_LINEAR 'for scaling up
                _glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_LINEAR 'for scaling down
            Case 2 'works....not sure, if this output is correct

                'gluBuild2DMipmaps(GL_TEXTURE_2D, pic->bpp/8, pic->width, pic->height, textureType, GL_UNSIGNED_BYTE, pic->data);


                gluBuild2DMipmaps _GL_TEXTURE_2D, 4, _Width(ni&), _Height(ni&), _GL_RGB, _GL_UNSIGNED_BYTE, _Offset(Texture)
                _glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_LINEAR_MIPMAP_NEAREST 'for scaling up
                _glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_LINEAR '  IF IS USED _GL_LINEAR_MIMAP_NEAREST here, program crash. Is it correct?    -?-
                '


                _glTexImage2D _GL_TEXTURE_2D, 0, _GL_RGBA, _Width(ni&), _Height(ni&), 0, _GL_BGRA_EXT, _GL_UNSIGNED_BYTE, n.OFFSET
                '                    NEW IS HERE _GL_RGBA and not _GL_RGB  as in previous case!
                _FreeImage tex&
                _MemFree n
                '_FreeImage ni&
                GoTo saveit

                'gluBuild2DMipmaps(GL_TEXTURE_2D, 3, TextureImage[0]->sizeX, TextureImage[0]->sizeY, GL_RGB, GL_UNSIGNED_BYTE, TextureImage[0]->data);

        End Select

        _FreeImage tex&
        _glTexImage2D _GL_TEXTURE_2D, 0, _GL_RGBA, _Width(texinv&), _Height(texinv&), 0, _GL_BGRA_EXT, _GL_UNSIGNED_BYTE, m.OFFSET

        saveit:
        U = UBound(GLL)
        GLL(U).PointerGL = Texture
        GLL(U).TextureName = image
        GLL(U).Filtering = Filter
        ReDim _Preserve GLL(U + 1) As GL_Loader

        _MemFree m

    Else
        Print "LoadTexture Error: "; image$; " - file not found."
    End If
    LoadTexture = Texture
End Function

Sub LoadWorld (txtFile As String, Triangles() As Triangle, TriTextures() As Texture_T)
    file$ = "world.txt"
    If _FileExists(file$) Then
        ReDim Num(4) As Single
        ff = FreeFile
        Open file$ For Input As ff
        While Not EOF(ff)
            radek = radek + 1
            Line Input #ff, t$
            t$ = t$ + " " '      add space to end line for right detection all numbers in the row
            i = InStr(1, t$, "NUMPOLLIES")
            If i Then
                Print "id: NUMPOLLIES  found"
                separator = InStr(i + 1, t$, " ")
                NumOfTriangles = Val(Mid$(t$, separator, Len(t$) - separator))
                Print "Triangles:"; NumOfTriangles
                ReDim Triangles(NumOfTriangles * 3) As Triangle
                ReDim TriTextures(NumOfTriangles) As Texture_T

                i = 0
                GoTo NextRow
            End If
            If InStr(1, t$, "/") = 0 Then 'row contains none C comment
                If Len(_Trim$(t$)) Then '  row is not empty
                    n$ = ""
                    For r = 1 To Len(t$)
                        ch = Asc(t$, r) '34 jsou uvozovky
                        Select Case ch
                            Case 48 To 57, 45, 46 '0 to 9 . -
                                num$ = num$ + Chr$(ch)
                            Case 32
                                If Len(num$) Then 'kdyz num$ obsahuje ciselnou hodnotu a dalsi znak je mezera
                                    '  Print num$
                                    ' Sleep
                                    Num(num_i) = Val(num$)
                                    num$ = ""
                                    If num_i = 4 Then
                                        num_i = 0 '0 to 4 for 5 number on 1 row
                                    Else
                                        num_i = num_i + 1
                                    End If
                                End If

                            Case 34 'narazil na uvozovky
                                next34 = InStr(r + 1, t$, Chr$(34))
                                ' Print r, next34
                                TextureName$ = Mid$(t$, r + 1, next34 - r - 1) 'vraci jmeno textury bez uvozovek
                                Exit For
                        End Select
                    Next r 'loop for 1 row

                    Triangles(Tri_i).TextureX = Num(3) 'records in text file:  Xvertex, Yvertex, Zvertex, TextureX, TextureY, "texturefilename" (if is changed)
                    Triangles(Tri_i).TextureY = Num(4)
                    Triangles(Tri_i).VertexX = Num(0)
                    Triangles(Tri_i).VertexY = Num(1)
                    Triangles(Tri_i).VertexZ = Num(2)
                    Tri_i = Tri_i + 1
                    'Print radek, Tri_i
                    'Sleep
                    If Len(TextureName$) Then
                        ' Print TextureName$
                        TriTextures(TriTex_i).FileName = TextureName$
                        TriTex_i = TriTex_i + 1
                        TextureName$ = ""
                    End If
                    ReDim Num(4) As Single 'clear array for read next values
                Else
                    GoTo NextRow 'if row is empty, read next row from file
                End If
            Else
                GoTo NextRow ' if row contains C comment separated with // (or just /), read next row from file
            End If
            NextRow:
        Wend
    Else
        Print "File world.txt not found.": End
    End If
    Close ff
End Sub

Function IsOnPos (Walker_Xpos, Walker_Zpos, PointX, PointZ, radius)
    xy& = ((Walker_Xpos - PointX) ^ 2) + ((Walker_Zpos - PointZ) ^ 2) 'Pythagorean theorem
    If radius ^ 2 >= xy& Then IsOnPos = (radius ^ 2 - xy&) / radius ^ 2 Else IsOnPos = 0
End Function

ZIP file contains textures, txt file, mp3 file and bas source code.