Imports Microsoft.DirectX
Imports Microsoft.DirectX.Direct3D
Imports System.Drawing

Public class DRend
    Dim Dev as Device
    Public TextureDirPath As String
    dim Mdl as AMesh
    dim Camera as Matrix
    Dim sh As IntPtr
    Dim pp As PresentParameters = New PresentParameters

    Public Class PresentOptions
        Public Fullscreen As Boolean
        Public SWidth As Integer
        Public SHeight As Integer
        Public FrameLimit As Boolean

        Public Sub New()
            Fullscreen = True
            SWidth = Screen.AllScreens(0).Bounds.Width
            SHeight = Screen.AllScreens(0).Bounds.Height
            FrameLimit = False
        End Sub
    End Class

    Public sub LoadModel(FileName as String)
        Mdl = New AMesh(FileName, dev, pp, TextureDirPath, Me)
    End sub

    Public Sub _3D_Init(ByRef Handle As IntPtr, ByVal Args As PresentOptions)
        sh = Handle
        pp.SwapEffect = SwapEffect.Discard
        If Args.FrameLimit Then pp.PresentationInterval = PresentInterval.Default Else pp.PresentationInterval = PresentInterval.Immediate
        Dim current As Format = Manager.Adapters(0).CurrentDisplayMode.Format
        If Manager.CheckDeviceType(0, DeviceType.Hardware, current, current, False) Then
            pp.BackBufferWidth = Args.SWidth
            pp.BackBufferHeight = Args.SHeight
            If Args.Fullscreen Then
                pp.Windowed = False
                pp.BackBufferFormat = current
                pp.BackBufferCount = 1
            Else
                pp.Windowed = True
            End If
            pp.AutoDepthStencilFormat = DepthFormat.D24S8
            pp.EnableAutoDepthStencil = True
        Else
            pp.Windowed = True
        End If
        Dim hardware As Caps = Manager.GetDeviceCaps(0, DeviceType.Hardware)
        If hardware.MaxVertexBlendMatrices >= 4 Then
            Dim fl As CreateFlags = CreateFlags.SoftwareVertexProcessing
            If hardware.DeviceCaps.SupportsHardwareTransformAndLight Then fl = CreateFlags.HardwareVertexProcessing
            If hardware.DeviceCaps.SupportsPureDevice Then fl = fl Or CreateFlags.PureDevice            
            dev = New Device(0, DeviceType.Hardware, sh, fl, pp)
        Else
            dev = New Device(0, DeviceType.Reference, sh, CreateFlags.SoftwareVertexProcessing, pp)
        End If
        dev.RenderState.CullMode = Cull.CounterClockwise
        dev.RenderState.Ambient = Color.White
        dev.RenderState.Lighting = False
        If pp.Windowed Then AddHandler dev.DeviceResizing, AddressOf DevResize
        AddHandler dev.DeviceReset, AddressOf DevReset
        Utils.Timer(DirectXTimer.Start)
        dev.Transform.Projection = Matrix.PerspectiveFovLH(Math.Pi/4, dev.DisplayMode.Width / dev.DisplayMode.Height, 0.1, 10000)
        dev.Transform.View = Matrix.Identity
    End Sub

    Public sub Represent
        TimeEnd = Utils.Timer(DirectXTimer.GetElapsedTime)
        dev.Transform.World = Matrix.Identity
        dev.Transform.View = Camera
        dev.Clear(ClearFlags.Target Or ClearFlags.ZBuffer, Color.Black, 1.0F, 1.0F)
        dev.BeginScene()
        Mdl.ProcessNextFrame(dev,TimeEnd,0,0,0,0,0,0)
        Mdl.DrawFrame(Mdl.rootFrame.FrameHierarchy, dev)
        dev.EndScene()
        dev.Present()
    End sub

    Private Sub DevReset(ByVal sender As Object, ByVal e As EventArgs)
        '
        ' дЕИЯРБХЪ ОПХ ЯАПНЯЕ СЯРПНИЯРБЮ
        '
    End Sub

    Private Sub DevResize(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs)
        e.Cancel = True
    End Sub

Class AMesh
        Dim R As Single
        Dim modPath As String
        Public PD As Double
        Dim MDevice As Device
        Public app As DRend

        Public ReadOnly Property Radius() As Single
            Get
                Return R
            End Get
        End Property

        Public Sub New(ByVal File As String, ByRef MyDevice As Device, ByVal presentParams As PresentParameters, ByVal texPath As String, ByRef par As DRend)
            modPath = texPath
            app = par
            MDevice = MyDevice
            CreateAnimation(File, presentParams, MyDevice)
            PD = rootFrame.AnimationController.GetTrackAnimationSet(0).Period
        End Sub

        Public Sub ProcessNextFrame(ByRef dev As Device, ByVal ETime As Single, ByVal XAng As Single, ByVal YAng As Single, ByVal ZAng As Single, ByVal XLoc As Single, ByVal YLoc As Single, ByVal ZLoc As Single)
            dev.Transform.World = Matrix.Multiply(Matrix.RotationYawPitchRoll(XAng, YAng, ZAng), Matrix.Translation(New Vector3(XLoc, YLoc, ZLoc)))
            If Not (rootFrame.AnimationController Is Nothing) Then
                rootFrame.AnimationController.AdvanceTime(ETime, Nothing)
                UpdateFrameMatrices(rootFrame.FrameHierarchy, dev.Transform.World)
            End If
        End Sub

        Public Sub ProcessUpdate(ByRef dev As Device, ByVal XAng As Single, ByVal YAng As Single, ByVal ZAng As Single, ByVal XLoc As Single, ByVal YLoc As Single, ByVal ZLoc As Single)
            dev.Transform.World = Matrix.Multiply(Matrix.RotationYawPitchRoll(XAng, YAng, ZAng), Matrix.Translation(New Vector3(XLoc, YLoc, ZLoc)))
            UpdateFrameMatrices(rootFrame.FrameHierarchy, dev.Transform.World)
        End Sub

        Public Function GetPosition() As Double
            Return rootFrame.AnimationController.GetTrackDescription(0).Position
        End Function

        Public Sub ProcessZeroFrame()
            rootFrame.AnimationController.SetTrackPosition(0, 0)
        End Sub

        Public Sub ProcessUserFrame(ByVal ATime As Double)
            rootFrame.AnimationController.SetTrackPosition(0, PD * ATime)
        End Sub

        Public Sub ProcessAbsoluteFrame(ByVal ATime As Double)
            rootFrame.AnimationController.SetTrackPosition(0, ATime)
        End Sub

        Public Sub DrawFrame(ByVal frame As FrameDerived, ByRef dev As Device)
            Dim mesh As MeshContainerDerived = frame.MeshContainer
            While Not (mesh Is Nothing)
                rawMeshContainer(mesh, frame, dev)
                mesh = mesh.NextContainer
            End While
            If Not (frame.FrameSibling Is Nothing) Then
                rawFrame(frame.FrameSibling, dev)
            End If
            If Not (frame.FrameFirstChild Is Nothing) Then
                rawFrame(frame.FrameFirstChild, dev)
            End If
        End Sub

        Private Sub DrawMeshContainer(ByVal mesh As MeshContainerDerived, ByVal frame As FrameDerived, ByRef dev As Device)
            If Not (mesh.SkinInformation Is Nothing) Then
                If mesh.NumberInfluences = 1 Then
                    dev.RenderState.VertexBlend = VertexBlend.ZeroWeights
                Else
                    dev.RenderState.VertexBlend = CType(mesh.NumberInfluences - 1, VertexBlend)
                End If
                If mesh.NumberInfluences > 0 Then
                    dev.RenderState.IndexedVertexBlendEnable = True
                End If
                Dim bones As BoneCombination() = mesh.GetBones()
                Dim iAttrib As Integer
                Dim t As Integer
                For iAttrib = 0 To mesh.NumberAttributes - 1
                    Dim iPaletteEntry As Integer
                    For iPaletteEntry = 0 To mesh.NumberPaletteEntries - 1
                        Dim iMatrixIndex As Integer = bones(iAttrib).BoneId(iPaletteEntry)
                        If iMatrixIndex <> -1 Then
                            dev.Transform.SetWorldMatrixByIndex(iPaletteEntry, objectMatrix)
                        End If
                    Next iPaletteEntry
                    For t = 0 To numPasses - 1
                        dev.Material = mesh.GetMaterials()(bones(iAttrib).AttribId).Material3D
                        dev.SetTexture(0, mesh.GetTextures()(bones(iAttrib).AttribId))
                        mesh.MeshData.Mesh.DrawSubset(iAttrib)
                    Next
                Next iAttrib
            Else
                dev.Transform.World = frame.CombinedTransformationMatrix
                Dim t As Integer
                Dim mtrl As ExtendedMaterial() = mesh.GetMaterials()
                Dim iMaterial As Integer
                    For iMaterial = 0 To mtrl.Length - 1
                        dev.Material = mtrl(iMaterial).Material3D
                        dev.SetTexture(0, mesh.GetTextures()(iMaterial))
                        mesh.MeshData.Mesh.DrawSubset(iMaterial)
                    Next iMaterial
            End If
        End Sub

        Private Sub UpdateFrameMatrices(ByVal frame As FrameDerived, ByVal parentMatrix As Matrix)
            frame.CombinedTransformationMatrix = Matrix.Multiply(frame.TransformationMatrix, parentMatrix)
            If Not (frame.FrameSibling Is Nothing) Then
                UpdateFrameMatrices(frame.FrameSibling, parentMatrix)
            End If
            If Not (frame.FrameFirstChild Is Nothing) Then
                UpdateFrameMatrices(frame.FrameFirstChild, frame.CombinedTransformationMatrix)
            End If
        End Sub

        Public rootFrame As AnimationRootFrame

        Private Overloads Sub SetupBoneMatrices(ByVal frame As FrameDerived)
            If Not (frame.MeshContainer Is Nothing) Then
                SetupBoneMatrices(CType(frame.MeshContainer, MeshContainerDerived))
            End If
            If Not (frame.FrameSibling Is Nothing) Then
                SetupBoneMatrices(CType(frame.FrameSibling, FrameDerived))
            End If
            If Not (frame.FrameFirstChild Is Nothing) Then
                SetupBoneMatrices(CType(frame.FrameFirstChild, FrameDerived))
            End If
        End Sub

        Private Overloads Sub SetupBoneMatrices(ByVal mesh As MeshContainerDerived)
            If Not (mesh.SkinInformation Is Nothing) Then
                Dim numBones As Integer = mesh.SkinInformation.NumberBones
                Dim frameMatrices(numBones) As FrameDerived
                Dim i As Integer
                For i = 0 To numBones - 1
                    Dim frame As FrameDerived = CType(frame.Find(rootFrame.FrameHierarchy, mesh.SkinInformation.GetBoneName(i)), FrameDerived)
                    If frame Is Nothing Then
                        Throw New ArgumentException
                    End If
                    frameMatrices(i) = frame
                Next i
                mesh.SetFrames(frameMatrices)
            End If
        End Sub

        Private Sub CreateAnimation(ByVal file As String, ByVal presentParams As PresentParameters, ByVal dev As Device)
            Dim alloc As New AllocateHierarchyDerived(Me, modPath)
            Dim strm As New IO.FileStream(file, IO.FileMode.Open)
            rootFrame = Mesh.LoadHierarchy(strm, strm.Length, MeshFlags.Managed, dev, alloc, Nothing)
            strm.Close()
            R = Frame.CalculateBoundingSphere(rootFrame.FrameHierarchy, New Vector3)
            SetupBoneMatrices(CType(rootFrame.FrameHierarchy, FrameDerived))
        End Sub

        Public Sub GenerateSkinnedMesh(ByVal mesh As MeshContainerDerived)
            If mesh.SkinInformation Is Nothing Then
                Throw New ArgumentException
            End If
            Dim numMaxFaceInfl As Integer
            Dim flags As MeshFlags = MeshFlags.OptimizeVertexCache
            Dim m As MeshData = mesh.MeshData
            Dim ib As IndexBuffer = m.Mesh.IndexBuffer
            Try
                numMaxFaceInfl = mesh.SkinInformation.GetMaxFaceInfluences(ib, m.Mesh.NumberFaces)
            Finally
                ib.Dispose()
            End Try
            numMaxFaceInfl = Fix(Math.Min(numMaxFaceInfl, 12))
            If MDevice.DeviceCaps.MaxVertexBlendMatrixIndex + 1 >= numMaxFaceInfl Then
                mesh.NumberPaletteEntries = Fix(Math.Min((MDevice.DeviceCaps.MaxVertexBlendMatrixIndex + 1) / 2, mesh.SkinInformation.NumberBones))
                flags = flags Or MeshFlags.Managed
            End If
            Dim bones() As BoneCombination
            Dim numInfl As Integer
            m.Mesh = mesh.SkinInformation.ConvertToIndexedBlendedMesh(m.Mesh, flags, mesh.GetAdjacencyStream(), mesh.NumberPaletteEntries, numInfl, bones)
            mesh.SetBones(bones)
            mesh.NumberInfluences = numInfl
            mesh.NumberAttributes = bones.Length
            mesh.MeshData = m
        End Sub

        '
        ' бЯОНЛНЦЮРЕКЭМШЕ ЙКЮЯЯШ ДКЪ ЛНДЕКХПНБЮМХЪ ЮМХЛЮЖХХ
        '
        Public Class FrameDerived
            Inherits Frame
            Private combined As Matrix = Matrix.Identity

            Public Property CombinedTransformationMatrix() As Matrix
                Get
                    Return combined
                End Get
                Set(ByVal Value As Matrix)
                    combined = Value
                End Set
            End Property
        End Class

        Public Class MeshContainerDerived
            Inherits MeshContainer
            Private meshTextures As Texture() = Nothing
            Private numAttr As Integer = 0
            Private numInfl As Integer = 0
            Private bones() As BoneCombination
            Private frameMatrices() As FrameDerived
            Private offsetMatrices() As Matrix
            Private numPal As Integer = 0

            Public Property NumberPaletteEntries() As Integer
                Get
                    Return numPal
                End Get
                Set(ByVal Value As Integer)
                    numPal = Value
                End Set
            End Property

            Public Function GetTextures() As Texture()
                Return meshTextures
            End Function

            Public Sub SetTextures(ByVal textures() As Texture)
                meshTextures = textures
            End Sub

            Public Function GetBones() As BoneCombination()
                Return bones
            End Function

            Public Sub SetBones(ByVal b() As BoneCombination)
                bones = b
            End Sub

            Public Function GetFrames() As FrameDerived()
                Return frameMatrices
            End Function

            Public Sub SetFrames(ByVal frames() As FrameDerived)
                frameMatrices = frames
            End Sub

            Public Function GetOffsetMatrices() As Matrix()
                Return offsetMatrices
            End Function

            Public Sub SetOffsetMatrices(ByVal matrices() As Matrix)
                offsetMatrices = matrices
            End Sub

            Public Property NumberAttributes() As Integer
                Get
                    Return numAttr
                End Get
                Set(ByVal Value As Integer)
                    numAttr = Value
                End Set
            End Property

            Public Property NumberInfluences() As Integer
                Get
                    Return numInfl
                End Get
                Set(ByVal Value As Integer)
                    numInfl = Value
                End Set
            End Property
        End Class

        Public Class AllocateHierarchyDerived
            Inherits AllocateHierarchy
            Private app As AMesh = Nothing
            Dim MP As String

            Public Sub New(ByVal parent As AMesh, ByVal mPath As String)
                MyBase.New()
                app = parent
                MP = mPath
            End Sub

            Public Overrides Function CreateFrame(ByVal name As String) As Frame
                Dim frame As New FrameDerived
                frame.Name = name
                frame.TransformationMatrix = Matrix.Identity
                frame.CombinedTransformationMatrix = Matrix.Identity
                Return frame
            End Function

            Public Overrides Function CreateMeshContainer(ByVal name As String, ByVal meshData As MeshData, ByVal materials() As ExtendedMaterial, ByVal effectInstances As EffectInstance, ByVal adjacency As GraphicsStream, ByVal skinInfo As SkinInformation) As MeshContainer
                If meshData.Mesh Is Nothing Then
                    Throw New ArgumentException
                End If
                If meshData.Mesh.VertexFormat = VertexFormats.None Then
                    Throw New ArgumentException
                End If
                Dim mesh As New MeshContainerDerived
                mesh.Name = name
                Dim numFaces As Integer = meshData.Mesh.NumberFaces
                Dim dev As Device = meshData.Mesh.Device
                If (meshData.Mesh.VertexFormat And VertexFormats.Normal) = 0 Then
                    Dim tempMesh As Mesh = meshData.Mesh.Clone(meshData.Mesh.Options.Value, meshData.Mesh.VertexFormat Or VertexFormats.Normal, dev)
                    meshData.Mesh = tempMesh
                    meshData.Mesh.ComputeNormals()
                End If
                Dim i As Integer
                mesh.SetMaterials(materials)
                mesh.SetAdjacency(adjacency)
                Dim meshTextures(materials.Length - 1) As Texture
                For i = 0 To materials.Length - 1
                    If Not (materials(i).TextureFilename Is Nothing) Then
                        meshTextures(i) = TextureLoader.FromFile(dev, MP & "\" & IO.Path.GetFileName(materials(i).TextureFilename))
                    End If
                Next i
                mesh.SetTextures(meshTextures)
                mesh.MeshData = meshData
                If Not (skinInfo Is Nothing) Then
                    mesh.SkinInformation = skinInfo
                    Dim numBones As Integer = skinInfo.NumberBones
                    Dim offsetMatrices(numBones) As Matrix
                    For i = 0 To numBones - 1
                        offsetMatrices(i) = skinInfo.GetBoneOffsetMatrix(i)
                    Next i
                    mesh.SetOffsetMatrices(offsetMatrices)
                    app.GenerateSkinnedMesh(mesh)
                End If
                Return mesh
            End Function
        End Class
    End Class
End class