VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cS2DSceneManager"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'clsSceneManager v0.3
'Autor: MasterK (Matthias Kermas)
'email: masterk@r-pg.net
'SceneManager, Klasse zum Verwalten beliebig vieler Scenes
'Vorteil:   jede Textur wird nur einmal geladen, auch wenn sie von beliebig
'           vielen Scenes verwendet wird
'Verwaltung der Pictures ist intern noch etwas kompliziert, wird evtl noch vereinfach
'veranschaulichendes Bild kommt noch
'erstes Element ist immer 1 !!!!!!
Option Explicit
Public Enum eSpriteProperty
    lXPos = 1
    lYPos = 2
    lImage = 3
    iAngle = 4
    bAlpha = 5
    lColor = 6
    bolEnabled = 7
End Enum
#If False Then 'Trick preserves Case of Enums when typing in IDE
Private lXPos, lYPos, lImage, iAngle, bAlpha, lColor, bolEnabled
#End If
Private Type TFileHeader
    FileID                                As String * 2
    Version1                              As Byte
    Version2                              As Byte
End Type
Private Type TRaniHeader
    Framedelay                            As Integer 'wieviele Frames zwischen 2 gezeigten Anmationsframes Delay
    Width                                 As Integer 'Höhe und Breite einer Scene, zur Zeit weniger von Interesse
    Height                                As Integer 'beides später nur Intern wichtig
End Type
Private Type TPictureProperty 'zum Laden der PicturePropertys
    FileName                              As String    'der Dateiname des Pictures
    Width                                 As Long
    Height                                As Long
End Type
Private Type TImageProperty
    Left                                  As Long
    Top                                   As Long
    bottom                                As Long
    Right                                 As Long
    ImagePictureID                        As Long
End Type
Private Type TSpriteFrame 'speichert die Eigenschaften eines Sprite für einen Frame
    XPos                                  As Long
    YPos                                  As Long
    Image                                 As Long
    Angle                                 As Integer
    Alpha                                 As Byte
    Color                                 As Long
    Enabled                               As Boolean
End Type
Private Type TSprite
    SpriteName                            As String
End Type
Private Type TScene 'speichert eine Scene/Animation
    SceneSize                             As Point
    DelayCount                            As Integer
    Framedelay                            As Integer
    PictureIDList()                       As Integer 'speichert den Verweis auf eine TPictureProperty
    ImageList()                           As TImageProperty
    ImageCount                            As Long
    SpriteList()                          As TSprite
    FrameList()                           As TSpriteFrame
    SpriteCount                           As Integer
    FrameCount                            As Integer
    PictureCount                          As Integer
    AktlFrame                             As Long
End Type
'werden nur zum Laden benötigt
Private FileHeader                      As TFileHeader
Private RaniHeader                      As TRaniHeader
'speichert die Eigenschaften für Picture für ALLE Scenes, um doppelte Picture zu vermeiden
Private AllPictureList()                As TPictureProperty
Private AllPictureTextureIDList()       As Long
Private AllPicturecount                 As Long
'hier werden sämtliche Scenerelevanten Daten gespeichert
Private SceneList()                     As TScene
Private SceneCount                      As Integer
Private PicturePath                     As String 'der Pfad, in dem die Pictures für
'die Animationen gespeichert werden, evtl erweitern
'in ein Array (mehrere Pfade)
Private Q                               As Long    'ein paat Hilfsvariablen
Private p                               As Long
Private TexturID                        As Integer
Private SpriteFarbe                     As Long
Private SpriteAlpha                     As Integer
Private SpriteHeight                    As Double
Private SpriteWidth                     As Double
Private DestX                           As Double
Private DestY                           As Double
Private SrcX                            As Double
Private SrcY                            As Double
Private SrcWidth                        As Double
Private SrcHeight                       As Double
Private SpriteAngle                     As Double
Private engine                          As cS2D

Public Function AddScene(ByVal strSceneFile As String) As Boolean

  'fügt eine Scene der Scenenauflistung hinzu
  'bei Erfolg Rückgabe = TRUE, sonst FALSE
  
  Dim TempPicList()                                       As TPictureProperty                                       'temporäre Picturelist
  Dim NewPic                                              As Boolean                                       'wenn ein noch nicht in der AllListe vorhandenes
  Dim FileNr                                              As Long

    On Error GoTo errorhandler
    'Bild geladen wird
    AddScene = False
    If LenB(Dir(strSceneFile)) = 0 Then
        Exit Function
    End If
    SceneCount = SceneCount + 1
    ReDim Preserve SceneList(1 To SceneCount) As TScene
    FileNr = FreeFile
    With SceneList(SceneCount)
        Open strSceneFile For Binary As #FileNr
        'die DateiID checken
        Get #FileNr, , FileHeader
        If FileHeader.FileID <> "RA" Then
            AddScene = False
            Close #FileNr
            Exit Function
        End If
        If FileHeader.Version1 = 0 Then
            If FileHeader.Version2 < 2 Then
                AddScene = False
                Close #FileNr
                Debug.Print "RaniFile        -        Version zu niedrig!"
                Exit Function
            End If
        End If
        Get #FileNr, , RaniHeader
        .Framedelay = RaniHeader.Framedelay
        .SceneSize.X = RaniHeader.Width
        .SceneSize.Y = RaniHeader.Height
        'die Pictures laden
        Get #FileNr, , .PictureCount
        If .PictureCount > 0 Then
            ReDim .PictureIDList(1 To .PictureCount) As Integer
            ReDim TempPicList(1 To .PictureCount) As TPictureProperty
            For Q = 1 To .PictureCount
                Get #FileNr, , TempPicList(Q)
            Next Q
        End If
        'alle Picture werden jetzt in Liste für alle Scenes geschrieben
        'doppelte Picture werden so vermieden
        If AllPicturecount = 0 Then
            AllPicturecount = .PictureCount
            ReDim AllPictureList(1 To .PictureCount) As TPictureProperty
            ReDim AllPictureTextureIDList(1 To .PictureCount) As Long
            For Q = 1 To .PictureCount
                AllPictureList(Q) = TempPicList(Q)
                .PictureIDList(Q) = Q
                If GetInputState() <> 0 Then
                    DoEvents
                End If
            Next Q
         Else 'NOT ALLPICTURECOUNT...
            'die schon vorhanden Picture durchsuchen
            For Q = 1 To .PictureCount
                NewPic = False
                For p = 1 To AllPicturecount
                    If TempPicList(Q).FileName = AllPictureList(p).FileName Then
                        'das Picture Q der Scene ist schon geladen
                        .PictureIDList(Q) = p
                        NewPic = True
                    End If
                    If GetInputState() <> 0 Then
                        DoEvents
                    End If
                Next p
                If Not NewPic Then
                    'Picture ist noch nicht geladen, jetzt hinzufügen
                    ReDim AllPictureList(1 To AllPicturecount + 1) As TPictureProperty
                    ReDim AllPictureTextureIDList(1 To AllPicturecount + 1) As Long
                    AllPicturecount = AllPicturecount + 1
                    AllPictureList(AllPicturecount) = TempPicList(Q)
                End If
            Next Q
        End If
        'Images laden
        Get #FileNr, , .ImageCount
        If .ImageCount > 0 Then
            ReDim .ImageList(1 To .ImageCount) As TImageProperty
            For Q = 1 To .ImageCount
                Get #FileNr, , .ImageList(Q)
            Next Q
        End If
        'Sprites laden
        Get #FileNr, , .SpriteCount
        If .SpriteCount > 0 Then
            ReDim .SpriteList(1 To .SpriteCount) As TSprite
            For Q = 1 To .SpriteCount
                Get #FileNr, , .SpriteList(Q)
            Next Q
        End If
        'Frames laden
        Get #FileNr, , .FrameCount
        If .FrameCount > 0 Then
            If .SpriteCount > 0 Then
                ReDim .FrameList(1 To .FrameCount, 1 To .SpriteCount) As TSpriteFrame
                For Q = 1 To .FrameCount
                    For p = 1 To .SpriteCount
                        Get #FileNr, , .FrameList(Q, p)
                    Next p
                Next Q
            End If
        End If
        Close #FileNr
        'Scenefile erfolgreich geladen, Framezähler wird auf 1 gesetzt
        AddScene = True
        .AktlFrame = 1
    End With 'SCENELIST(SCENECOUNT)

Exit Function

errorhandler:
    Debug.Print "Fehler in LoadScene"
    Debug.Print "Fehlercode: " & Err.Number
    Debug.Print Err.Description
    AddScene = False
    Close #FileNr

End Function

Public Function GetFrameCount(ByVal lSceneID As Long) As Long

  'liefert die Anzahl der Frames in Scene lSceneID
  '***************************************************************************
  '*                      Funktionen zur Frameverwaltung
  '***************************************************************************

    GetFrameCount = SceneList(lSceneID).FrameCount

End Function

Public Function GetPictureCount() As Long

    GetPictureCount = AllPicturecount
    '***************************************************************************
    '*                      Funktionen zur Pictureverwaltung
    '***************************************************************************

End Function

Public Function GetPictureFile(ByVal lPictureIndex As Long) As String

  'liefert den Dateinamen für ein Picture zurück

    GetPictureFile = AllPictureList(lPictureIndex).FileName

End Function

Public Function GetPictureTextureID(ByVal lIndex As Long) As Long

  'liefert die externe TextureID eines Pictures, eigentlich unnötig, wird
  'schon über GetSpriteTextureID geregelt
  'evtl sinnvoll für späteres Entladen von Scenes

    GetPictureTextureID = AllPictureTextureIDList(lIndex)

End Function

Public Function GetSceneCount() As Long

  'liefert die Anzahl der geladenen Scenes/Anmationen

    GetSceneCount = SceneCount

End Function

Public Function GetSpriteCount(ByVal lSceneID As Long) As Long

    GetSpriteCount = SceneList(lSceneID).SpriteCount
    '***************************************************************************
    '*                      Funktionen zum Verwalten der Sprites
    '***************************************************************************

End Function

Public Function GetSpriteImageRect(ByVal lSceneID As Long, _
                                   ByVal lSpriteID As Long) As RECT

  'liefert die Koordinaten des Sprites im aktuellen Frame in der Textur

    With GetSpriteImageRect
        .Left = SceneList(lSceneID).ImageList(Me.GetSpriteProperty(lSpriteID, lSceneID, lImage)).Left
        .Top = SceneList(lSceneID).ImageList(Me.GetSpriteProperty(lSpriteID, lSceneID, lImage)).Top
        .Right = SceneList(lSceneID).ImageList(Me.GetSpriteProperty(lSpriteID, lSceneID, lImage)).Right
        .bottom = SceneList(lSceneID).ImageList(Me.GetSpriteProperty(lSpriteID, lSceneID, lImage)).bottom
    End With 'GetSpriteImageRect

End Function

Public Function GetSpriteProperty(ByVal lSpriteID As Long, _
                                  ByVal lSceneID As Long, _
                                  ByVal SpriteProperty As eSpriteProperty) As Variant

  'liefert die Eigenschaften des Spsrites lSpriteID in der Scene lSceneID
  '#####################################################################################
  'evtl für späteres Scripting sinnvoll
  'Public Function GetSpriteName(ByVal lSceneID As Long, ByVal lIndex As Long) As String
  '    If lIndex > 0 And lIndex <= SpriteCount Then
  '        GetSpriteName = SceneList(lSceneID).SpriteList(lIndex).SpriteName
  '    Else
  '        GetSpriteName = ""
  '    End If
  'End Function
  'Public Function GetSpriteID(ByVal strSpriteName As String) As Long
  '    GetSpriteID = -1
  '    Debug.Print "spritecount: " & SpriteCount
  '    For Q = 1 To SpriteCount
  'Debug.Print "ok"
  'Debug.Print SpriteList(Q)
  '        If SpriteList(Q).SpriteName = strSpriteName Then GetSpriteID = Q
  '    Next Q
  'End Function
  'Public Function SetSpriteProperty(ByVal lFrame As Long, ByVal lSprite As Long,
  ' '    ByVal SpriteProperty As eSpriteProperty, ByVal vValue As Variant) As Boolean
  '    SetSpriteProperty = True
  '    Select Case SpriteProperty
  '        Case Is = 1
  '            FrameList(lFrame, lSprite).XPos = vValue
  '        Case Is = 2
  '            FrameList(lFrame, lSprite).YPos = vValue
  '        Case Is = 3
  '            FrameList(lFrame, lSprite).Image = vValue
  '        Case Is = 4
  '            FrameList(lFrame, lSprite).Angle = vValue
  '        Case Is = 5
  '            FrameList(lFrame, lSprite).Alpha = vValue
  '        Case Is = 6
  '            FrameList(lFrame, lSprite).Color = vValue
  '        Case Is = 7
  '            If FrameList(lFrame, lSprite).Image = 0 Then
  '                SetSpriteProperty = False
  '            Else
  '                FrameList(lFrame, lSprite).Enabled = vValue
  '                SetSpriteProperty = True
  '            End If
  '    End Select
  'End Function
  '#####################################################################################

    With SceneList(lSceneID)
        Select Case SpriteProperty
         Case Is = 1
            GetSpriteProperty = .FrameList(.AktlFrame, lSpriteID).XPos
         Case Is = 2
            GetSpriteProperty = .FrameList(.AktlFrame, lSpriteID).YPos
         Case Is = 3
            GetSpriteProperty = .FrameList(.AktlFrame, lSpriteID).Image
         Case Is = 4
            GetSpriteProperty = .FrameList(.AktlFrame, lSpriteID).Angle
         Case Is = 5
            GetSpriteProperty = .FrameList(.AktlFrame, lSpriteID).Alpha
         Case Is = 6
            GetSpriteProperty = .FrameList(.AktlFrame, lSpriteID).Color
         Case Is = 7
            GetSpriteProperty = .FrameList(.AktlFrame, lSpriteID).Enabled
        End Select
    End With 'SCENELIST(LSCENEID)

End Function

Public Function GetSpriteTextureID(ByVal lSceneID As Long, _
                                   ByVal lSpriteID As Long) As Long

  'liefert die externe TextureID des Sprites lSpriteID der Scene lSceneID
  'im aktuellen Frame

    With SceneList(lSceneID)
        If .FrameList(.AktlFrame, lSpriteID).Image > 0 Then
            GetSpriteTextureID = AllPictureTextureIDList(.PictureIDList(.ImageList(.FrameList(.AktlFrame, lSpriteID).Image).ImagePictureID))
        End If
    End With 'SCENELIST(LSCENEID)

End Function

Public Function Init(ByVal strPicturePath As String) As Boolean

    PicturePath = strPicturePath
    SceneCount = 0

End Function

Public Function NextFrame(ByVal lSceneID As Long) As Boolean

  'setzt für die Animation lScene das nächste Frame
  'falls die Scene im Delay ist, wird der Delaycount erhöht
  'falls Scene beim letzten Frame ist, wird auf Frame 1 gesetzt

    With SceneList(lSceneID)
        If .Framedelay < .DelayCount Then
            .AktlFrame = .AktlFrame + 1
            .DelayCount = 0
            If .AktlFrame > .FrameCount Then
                .AktlFrame = 1
            End If
         Else 'NOT .FRAMEDELAY...
            .DelayCount = .DelayCount + 1
        End If
    End With 'SCENELIST(LSCENEID)

End Function

Public Function SetPictureTextureID(ByVal lPictureIndex As Long, _
                                    ByVal lTextureID As Long) As Boolean

  'setzt die externe TexturID für ein internes Picture

    AllPictureTextureIDList(lPictureIndex) = lTextureID

End Function


Public Sub LoadAnimation(File As String, EngineObj As cS2D)
Dim i As Integer
Set engine = EngineObj
Init RootDir & "\data\sprites\"
If AddScene(RootDir & "\data\animations\" & File) Then
'Datei erfolgreich geladen
For i = 1 To GetPictureCount
'soll der colorkey für jedes Picture der Animation auch gespeichert werden?
SetPictureTextureID i, engine.TexturePool.AddTexture(RootDir & "\data\sprites\" & GetPictureFile(i), RGB(255, 0, 255))
Next i
End If
End Sub
Public Sub RenderAnimation(j As Integer, Optional X As Integer = 0, Optional Y As Integer = 0)

Dim i As Integer
'''***************************************************************************
'''*                      allgemeine Funktionen
'''***************************************************************************
NextFrame j
For i = 1 To GetSpriteCount(j)
'Debug.Print Scene.GetSpriteProperty(i, bolEnabled)
If GetSpriteProperty(i, j, bolEnabled) Then
'Debug.Print "rendern"
TexturID = GetSpriteTextureID(j, i)
SpriteFarbe = GetSpriteProperty(i, j, lColor)
SpriteAlpha = GetSpriteProperty(i, j, bAlpha)
DestX = GetSpriteProperty(i, j, lXPos)
DestY = GetSpriteProperty(i, j, lYPos)
SpriteHeight = GetSpriteImageRect(j, i).bottom - GetSpriteImageRect(j, i).Top
SpriteWidth = GetSpriteImageRect(j, i).Right - GetSpriteImageRect(j, i).Left
SpriteAngle = GetSpriteProperty(i, j, iAngle)
'das CSng(SpriteFarbe) is nich meine schuld ;)
engine.TexturePool.RenderTexture CSng(TexturID), CSng(DestX) + X, CSng(DestY) + Y, CSng(SpriteWidth), CSng(SpriteHeight), CSng(SpriteWidth), CSng(SpriteHeight), CSng(GetSpriteImageRect(j, i).Left), CSng(GetSpriteImageRect(j, i).Top), CSng(SpriteAlpha), , CSng(SpriteFarbe), CSng(SpriteFarbe), CSng(SpriteFarbe), CSng(SpriteFarbe), CSng(SpriteAngle)
End If
Next i
End Sub


Public Sub RenderAnimations()
Dim j As Integer

Dim i As Integer

For j = 1 To GetSceneCount
NextFrame j
For i = 1 To GetSpriteCount(j)
'Debug.Print Scene.GetSpriteProperty(i, bolEnabled)
If GetSpriteProperty(i, j, bolEnabled) Then
'Debug.Print "rendern"
TexturID = GetSpriteTextureID(j, i)
SpriteFarbe = GetSpriteProperty(i, j, lColor)
SpriteAlpha = GetSpriteProperty(i, j, bAlpha)
DestX = GetSpriteProperty(i, j, lXPos)
DestY = GetSpriteProperty(i, j, lYPos)
SpriteHeight = GetSpriteImageRect(j, i).bottom - GetSpriteImageRect(j, i).Top
SpriteWidth = GetSpriteImageRect(j, i).Right - GetSpriteImageRect(j, i).Left
SpriteAngle = GetSpriteProperty(i, j, iAngle)
'das CSng(SpriteFarbe) is nich meine schuld ;)
engine.TexturePool.RenderTexture CSng(TexturID), CSng(DestX), CSng(DestY), CSng(SpriteWidth), CSng(SpriteHeight), CSng(SpriteWidth), CSng(SpriteHeight), CSng(GetSpriteImageRect(j, i).Left), CSng(GetSpriteImageRect(j, i).Top), CSng(SpriteAlpha), , CSng(SpriteFarbe), CSng(SpriteFarbe), CSng(SpriteFarbe), CSng(SpriteFarbe), CSng(SpriteAngle)
End If
Next i
Next j
End Sub

