VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cS2DTexturePool_i"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Public t_engine As cS2D_i
Public Pool1 As New cS2DTexturePool
Public Pool2 As New cS2DmdTexturePool

Private Animations() As New cS2DAniQ
Public AnimationCount As Integer

Public Function GetTextureAnimation(i As Integer) As Integer
    
    Select Case t_engine.Engine_i
    Case 1:
        'GetTextureAnimation = Pool1.GetTextureAnimation(i)
    Case 2, 3:
        'NOT NEEDED
    End Select
    
End Function

Public Function Animation(i As Integer) As cS2DAniQ
    
    Dim tID As Integer
    If i >= 1000 Then tID = i - 1000 Else tID = i
    Set Animation = Animations(tID)
    
End Function

Public Function RemoveTexture(TexID As Integer)
    
    Select Case t_engine.Engine_i
    Case 1:
        Pool1.UnloadTexture (TexID)
    Case 2, 3:
        'NOT NEEDED
    End Select
    
End Function

Public Property Get TextureCount() As Integer

    Select Case t_engine.Engine_i
    Case 1:
        TextureCount = Pool1.TextureCount
    Case 2, 3:
        'NOT NEEDED
    End Select

End Property

Public Property Let TextureCount(ByVal PropVal As Integer)

    Select Case t_engine.Engine_i
    Case 1:
        Pool1.TextureCount = PropVal
    Case 2, 3:
        'NOT NEEDED
    End Select

End Property

Public Function AddTexture(strFileNameRelative As String, colorkey As Long) As Integer

    Dim utf As Boolean
    Dim strFilename As String
    
    'If Not Mid(strFileNameRelative, 2, 1) = ":" Then
    '    strFilename = ProvideFile(strFileNameRelative, utf)
    'Else
        strFilename = strFileNameRelative
    'End If
    
    If LCase(Right(strFilename, 4)) = "aniq" Then
        
        Dim tFileName As String
        Dim i As Integer
        Dim CurrentAnimation As Integer
        
        tFileName = GetFileName(strFilename)
        For i = 0 To AnimationCount
            If Animations(i).FileName = strFileNameRelative Then
                S2DLog.Add "Animation already loaded """ & strFilename & """"
                AddTexture = i + 1000
                Exit Function
            End If
            If Animations(i).FileName = "" Then
                S2DLog.Add "Using free Animation Slot"
                CurrentAnimation = i
                GoTo SkipAllocateAnimation
            End If
        Next
        
        AnimationCount = AnimationCount + 1
        ReDim Preserve Animations(AnimationCount)
        CurrentAnimation = AnimationCount
        
SkipAllocateAnimation:
        
        With Animations(CurrentAnimation)
            Set .S2D = Me.t_engine
            .LoadAniQ strFilename
            .FileName = strFileNameRelative
            .PlayAnimation
        End With
        
        AddTexture = CurrentAnimation + 1000
        Exit Function
    End If
    
    Select Case t_engine.Engine_i
    Case 1:
        AddTexture = Pool1.LoadTexture(strFilename, colorkey)
    Case 2, 3:
        AddTexture = Pool2.LoadTextureFromFile(strFilename)
    End Select

End Function

Public Function RenderTexture(textureID As Integer, Optional DestinationX As Double = 0, Optional DestinationY As Double = 0, Optional DestinationWidth As Integer = -1, Optional DestinationHeight As Integer = -1, Optional SourceWidth As Integer = -1, Optional SourceHeight As Integer = -1, Optional SourceX As Integer = 0, Optional SourceY As Integer = 0, Optional Alpha As Integer = 255, Optional Angle As Integer = 0, Optional AngleX As Integer = -1, Optional AngleY As Integer = -1, Optional DestinationZ As Integer = 0, Optional Color As Long = vbWhite)

    If textureID >= 1000 Then
        Animations(textureID - 1000).Render DestinationX, DestinationY, , , Alpha, Angle, , , Color
        Exit Function
    End If
    
    Select Case t_engine.Engine_i
    Case 1:
        Pool1.RenderTexture textureID, DestinationX, DestinationY, DestinationWidth, DestinationHeight, SourceWidth, SourceHeight, SourceX, SourceY, Alpha, Angle, AngleX, AngleY, DestinationZ, , Color
    Case 2, 3:
        'NOT NEEDED
    End Select

End Function

Public Sub RenderTiled(textureID As Integer, Optional DestinationX As Double = 0, Optional DestinationY As Double = 0, Optional intWidth As Integer = -1, Optional intHeight As Integer = -1, Optional Alpha As Integer = 255, Optional toZ As Integer, Optional Color As Long = vbWhite)
    
    If textureID >= 1000 Then Exit Sub
    Select Case t_engine.Engine_i
    Case 1:
        Pool1.RenderTexture textureID, DestinationX, DestinationY, intWidth, intHeight, intWidth, intHeight, 0, 0, Alpha, 0, 0, , toZ, True, Color
    Case 2, 3:
        'NOT NEEDED
    End Select

End Sub

Public Property Get TextureHeight(textureID As Integer) As Integer
    
    If textureID >= 1000 Then
        TextureHeight = Animations(textureID - 1000).Height
        Exit Property
    End If
    
    Select Case t_engine.Engine_i
    Case 1:
        TextureHeight = Pool1.TextureHeight(textureID)
    Case 2, 3:
        'NOT NEEDED
    End Select
    
End Property

Public Property Get TextureWidth(textureID As Integer) As Integer
    
    If textureID >= 1000 Then
        TextureWidth = Animations(textureID - 1000).Width
        Exit Property
    End If
    
    Select Case t_engine.Engine_i
    Case 1:
        TextureWidth = Pool1.TextureWidth(textureID)
    Case 2, 3:
        'NOT NEEDED
    End Select

End Property

Public Sub Unload()

    Select Case t_engine.Engine_i
    Case 1:
        Pool1.Unload
    Case 2, 3:
        'NOT NEEDED
    End Select

End Sub

Public Function AnimationFrameCount(ID As Integer) As Integer
    On Error Resume Next
    Dim tID As Integer
    If ID >= 1000 Then tID = ID - 1000 Else tID = ID
    AnimationFrameCount = Animations(tID).AnimationFrameCount
End Function

Public Function AnimationInterval(ID As Integer, Frame As Integer) As Integer
    On Error Resume Next
    Dim tID As Integer
    If ID >= 1000 Then tID = ID - 1000 Else tID = ID
    AnimationInterval = Animations(tID).AnimationInterval(Frame)
End Function

Public Function ChangeAnimation(ID As Integer, Name As String)
    On Error Resume Next
    Dim tID As Integer
    If ID >= 1000 Then tID = ID - 1000 Else tID = ID
    Animations(tID).ChangeAnimation Name
End Function

Public Function StopAnimation(ID As Integer, Frame As Integer)
    On Error Resume Next
    Dim tID As Integer
    If ID >= 1000 Then tID = ID - 1000 Else tID = ID
    Animations(tID).StopAnimation Frame
End Function

Public Function PlayAnimation(ID As Integer, Optional Frame As Integer)
    On Error Resume Next
    Dim tID As Integer
    If ID >= 1000 Then tID = ID - 1000 Else tID = ID
    Animations(tID).PlayAnimation Frame
End Function

Private Sub Class_Initialize()
    AnimationCount = -1
End Sub
