Attribute VB_Name = "modEdGlobal"
Option Explicit

Public AppPath               As String

Public Project As cGAMProject

Public StartupTime As Date

Public SettingsEditors          As CHive

Public SEditor                  As cEdSettingsEditor

Public Debug_Collision As Boolean

Public RetSprites As Collection

Public RetMsg As Boolean, RetColorKey As Long, RetSX As Integer, RetSY As Integer, RetSW As Integer, RetSH As Integer

Public sobj_registry            As Object

Public sobj_game                As Object

Public Map                      As cGAMMap

Public engine                   As cS2D_i

Public Player                   As cS2DNPC

Public Controller               As cS2DInput

Public Menu                     As cS2DMenu

Public TranspBack            As cS2DSprite

Public ColTS              As cS2DSprite

Public ColTiles             As cS2DNPC

Public rm2k                  As cS2DSprite

Public Effects As cS2DEffects

Public tempspr As New cS2DSprite

Public CornerID As Integer

Public Eraser As cS2DSprite

Public Raster As cS2DSprite

Public SnapToGrid As Boolean

Public FlexPen As Boolean

Public Declare Function DestroyWindow _
               Lib "user32" (ByVal hwnd As Long) As Long

Public PluginHost As cEditorPlugHost

Public MapEditor                As cMapEditorPlugin

Public GFX                   As New cS2D_i

Public ScrollX               As Long

Public ScrollY               As Long

Public MouseX                As Long

Public MouseY                As Long

Public MouseXScreen          As Long

Public MouseYScreen          As Long

Public CurrentLevel          As Long

Public CurrentLayer          As Long

Public CurrentTileset        As Long

Public CurrentPackage        As Long

Public SelTileX              As Long

Public SelTileY              As Long

Public SelTileWidth          As Long

Public SelTileHeight         As Long

Public SelColTileX           As Long

Public SelColTileY           As Long

Public SelColTileWidth       As Long

Public SelColTileHeight      As Long

Public SelColInf             As Integer

Public SelNPC                As Integer

Public Mode                  As Long

Public View                  As Long

Public RenderRaster As Boolean

Public HLMode                As Integer

Public DrawModeWidth         As Long

Public DrawModeHeight        As Long

Public EdFont                As New cS2DText

Public PointDC As Long, PointBitmap As Long


Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer

Public Const VK_SHIFT = &H10

Public RTF As New cRTF

Public Particles As cS2DParticle

Public IsMapEditorOpen As Boolean

Public Sub Main()
    
    Const_TileWidth = 16
    Const_TileHeight = 16
    Initialize

End Sub

Public Sub Initialize()
    StartupTime = Now

    AppPath = App.Path
    DrawModeWidth = Const_TileWidth
    DrawModeHeight = Const_TileHeight
    
    CurrentLevel = 1
    CurrentLayer = 1
    CurrentTileset = 1
    SelTileWidth = 1
    SelTileHeight = 1
    Mode = 1
    
    Logging = True
    LogToFile = True
    LogToGUI = True
    InitLogging
    
    Log "Initializing Minerva...", ltAction
    IgnoreScripts = True
        
    Log "Initializing Registry...", ltAction
    Set SEditor = New cEdSettingsEditor
    SEditor.Initialize
    
    ChooseProject
    
    Log "Initializing Graphics Engine...", ltAction
    InitGFX
    
    Set PluginHost = New cEditorPlugHost
    PluginHost.Initialize App.Path & "\plugins", frmEdMain.ucp

    Set MapEditor = New cMapEditorPlugin
    PluginHost.AddPluginByInstance MapEditor
    
    Log "Initializing Tools...", ltAction
    Tools_Init
    
    Log "Initializing Main Form...", ltAction
    frmEdMain.Show

    Log "Populating Project List...", ltAction
    frmViewProject.Update

    Log "Populating Registry Tree...", ltAction
    frmEditorRegistry.Update
    
    Log "Init Complete!", ltSuccess
End Sub

Public Sub InitGFX()
    
    Set engine = GFX
    
    GFX.Engine_i = 1
    GFX.Initialize frmEdMap.picRender.hwnd, frmEdMap.picRender.ScaleWidth, frmEdMap.picRender.ScaleHeight
    
    frmEdMap.picTileSet.Visible = False
    frmEdMap.picColTS.Visible = False
    
    Set TranspBack = New cS2DSprite
    Set TranspBack.S2D = GFX
    TranspBack.Initialize App.Path & "\data\sprites\transpback.bmp", vbMagenta
    Set rm2k = New cS2DSprite
    Set rm2k.S2D = GFX
    rm2k.Initialize App.Path & "\data\sprites\rm2k.png", vbMagenta
    Set tempspr.S2D = GFX
    
    CornerID = GFX.TexturePool.AddTexture(App.Path & "\Data\sprites\particle2.png", rgb(255, 0, 255))
    
    Set ColTiles = New cS2DNPC
    Set ColTiles.S2D = GFX

    Set ColTS = New cS2DSprite

    With ColTS
        Set .S2D = GFX
        
        .Initialize App.Path & "\data\sprites\colmask.png", vbMagenta
        frmEdMap.picColTS.TileSet = .TexID
    End With 'ColTS

    Set Eraser = New cS2DSprite

    With Eraser
        Set .S2D = GFX
        .Initialize App.Path & "\data\sprites\eraser.png", vbMagenta
    End With
    
    Set Raster = New cS2DSprite

    With Raster
        Set .S2D = GFX
        .Initialize App.Path & "\data\sprites\raster.png", vbMagenta
    End With
    
    'Set EdFont = New cS2DText
    Set EdFont.S2D = GFX
    EdFont.InitText App.Path & "\Data\fontsets\edifont.png", App.Path & "\Data\fontsets\edifont.txt"


    frmEdMap.picTileSet.DestObj = frmEdMap.picLB(0).hwnd
    frmEdMap.picColTS.DestObj = frmEdMap.picLB(1).hwnd

    ZoomFactor = 1
    
    Set Effects = New cS2DEffects
    Set Effects.MyPool = GFX.TexturePool.Pool1

    PointDC = CreateCompatibleDC(GetDC(0))
    PointBitmap = CreateCompatibleBitmap(GetDC(0), 1, 1)
    SelectObject PointDC, PointBitmap
    SetPixel PointDC, 1, 1, vbBlack
    
End Sub

Public Sub ChooseProject()
ProjectChooser:

    Dim np As cGAMProject

    Log "Displaying Project Chooser...", ltAction
    CurProj = ""
    frmEdSelectProject.cmdCancel.Caption = "Quit"
    frmEdSelectProject.Show vbModal

    If CurProj = "" Then BenchmarkAndEnd
    
    Log "Initializing Project '" & CurProj & "'...", ltAction

    Set np = New cGAMProject

    If Not np.LoadProject(App.Path & "\projects\" & CurProj & "\" & CurProj & ".rpak", , InDevelopment) Then
        If np.ErrDescription = "Could not Load RPak file: Invalid password." Then
            If Not np.LoadProject(App.Path & "\projects\" & CurProj & "\" & CurProj & ".rpak", PasswordBox("Enter Password for '" & CurProj & ".rpak':")) Then
                MsgBox np.ErrDescription, vbCritical
                GoTo ProjectChooser:
            End If
        Else
            MsgBox np.ErrDescription, vbCritical
            GoTo ProjectChooser:
        End If
    End If
    
    Set Project = np
End Sub

Public Sub BenchmarkAndEnd()
    Dim ElapsedTime As Date
    
    ElapsedTime = Now - StartupTime
    
    Dim etsofar As Date
    etsofar = GetSetting("R-PG Minerva", "Statistics", "UsageTime", #12:00:00 AM#)
    ElapsedTime = etsofar + ElapsedTime
    
    SaveSetting "R-PG Minerva", "Statistics", "UsageTime", ElapsedTime

    End
End Sub

Public Function GetSettingsEditor(TypeName As String) As Object

    Dim frm As Object
    
    If Left(LCase(TypeName), 7) = "custom:" Then
        Set frm = SettingsEditors("custom")
    Else
        Set frm = SettingsEditors(TypeName)
    End If

    If frm Is Nothing Then Exit Function

    'Neue Instanz des Editors erstellen
    
    Set GetSettingsEditor = frm
End Function

Public Function GimmeAScriptControl() As ScriptControl

End Function

Public Sub RenderGame()

End Sub

Public Sub Render()

    If Map Is Nothing Then Exit Sub

    Dim boundsrect As Boolean

    If ScrollX > 0 Then
        ScrollX = 0
    End If
    
    If ScrollY > 0 Then
        ScrollY = 0
    End If
    
    If ScrollX - ScreenWidth < 0 - Map.MapWidth * Const_TileWidth Then
        ScrollX = 0 - Map.MapWidth * Const_TileWidth + ScreenWidth
    End If
    
    If ScrollY - ScreenHeight < 0 - Map.MapHeight * Const_TileHeight Then
        ScrollY = 0 - Map.MapHeight * Const_TileHeight + ScreenHeight
    End If

    If Map.MapHeight * Const_TileHeight < ScreenHeight Then
        boundsrect = True
        frmEdMap.vsbMap.Enabled = False
        ScrollY = ScreenHeight / 2 - (Map.MapHeight * Const_TileHeight) / 2
    Else
        frmEdMap.vsbMap.Enabled = True
    End If
    
    If Map.MapWidth * Const_TileWidth < ScreenWidth Then
        frmEdMap.hsbMap.Enabled = False
        boundsrect = True
        ScrollX = ScreenWidth / 2 - (Map.MapWidth * Const_TileWidth) / 2
    Else
        frmEdMap.hsbMap.Enabled = True
    End If
        
    With GFX
        .Resize frmEdMap.picRender.ScaleWidth, frmEdMap.picRender.ScaleHeight
        .Clear
        .BeginScene
        
'        TranspBack.RenderTiled ScrollX Mod 32 - 32, ScrollY Mod 32 - 32, ScreenWidth + 128, ScreenHeight + 128
        Effects.RenderRectangle ScrollX Mod 32 - 32, ScrollY Mod 32 - 32, ScreenWidth + 128, ScreenHeight + 128, rgb(250, 255, 245), rgb(225, 245, 250), rgb(250, 255, 230), rgb(255, 245, 250), 255, 0, True
        TranspBack.RenderTiled CDbl(ScrollX), CDbl(ScrollY), Map.MapWidth * Const_TileWidth, Map.MapHeight * Const_TileHeight
        Effects.RenderBorderRect CDbl(ScrollX), CDbl(ScrollY), Map.MapWidth * Const_TileWidth, Map.MapHeight * Const_TileHeight, vbBlack, 255, 4, 9999
    End With 'GFX

    Hilighting
    
    Map.Render ScrollX, ScrollY, 0, 9999

    If Map.CFm_MapFile = "" Then
        'TexturePool.RenderTiled GFX.TexturePool.NATex, CDbl(ScrollX), CDbl(ScrollY), MAP.MapWidth * Const_TileWidth, MAP.MapHeight * Const_TileHeight, 200, False
        'Effects.RenderRectangle CDbl(ScrollX), CDbl(ScrollY), MAP.MapWidth * Const_TileWidth, MAP.MapHeight * Const_TileHeight, &H666666, &H666666, &H666666, &H666666, 100
    End If

    If Mode = 3 Then
        If SelNPC > 0 Then
            Dim curnpc As cS2DNPC
            Set curnpc = Map.m_NPCs(SelNPC)

            If curnpc Is Nothing Then Exit Sub
            
            Effects.RenderBorderRect curnpc.x + ScrollX, curnpc.y + ScrollY - curnpc.ZPlus, curnpc.Width, curnpc.Height, vbWhite, 200, 1, 9999
        End If
    End If

    If RenderRaster Then Raster.RenderTiled ScrollX, ScrollY, Map.MapWidth * Const_TileWidth, Map.MapHeight * Const_TileHeight, 100, 9999
    
    
    Tools_Render
    RenderCol
    
    GFX.EndScene
    GFX.Flip frmEdMap.picRender

End Sub

Public Sub RenderCol()

    Dim lvl    As cGAMLevel

    'Dim Y      As Integer
    'Dim X      As Integer
    Dim StartX As Integer
    Dim StartY As Integer
    Dim EndX   As Integer
    Dim EndY   As Integer
    Dim XTo    As Double
    Dim YTo    As Double
    Dim clr    As Long

    If Mode <> 2 Then
        Exit Sub
    End If

    If CurrentLevel = 0 Then
        Exit Sub
    End If

    If Not TypeOf Map.Levels(CurrentLevel) Is cGAMLevel Then
        Exit Sub
    End If

    Set lvl = Map.Levels(CurrentLevel)
    StartX = -1 * (ScrollX / Const_TileWidth) - 1
    StartY = -1 * (ScrollY / Const_TileHeight) - 1
    EndX = StartX + (ScreenWidth / Const_TileWidth) + 2
    EndY = StartY + (ScreenHeight / Const_TileHeight) + 2

    If EndX >= Map.MapWidth Then
        EndX = Map.MapWidth - 1
    End If

    If EndY >= Map.MapHeight Then
        EndY = Map.MapHeight - 1
    End If

    If StartX < 0 Then
        StartX = 0
    End If

    If StartY < 0 Then
        StartY = 0
    End If
    
    Dim y As Integer
    Dim x As Integer
    
    
    For y = StartY To EndY
        For x = StartX To EndX
            clr = TileInfColors(lvl.ColInf(x, y))
            XTo = x * Const_TileWidth + ScrollX
            YTo = y * Const_TileHeight + ScrollY
            ColTS.Render XTo, YTo, Const_TileWidth, Const_TileHeight, lvl.ColTileX(x, y) * Const_TileWidth, lvl.ColTileY(x, y) * Const_TileHeight, Const_TileWidth, Const_TileHeight, 150, , , , 9999, clr
        Next x
    Next y

End Sub

Public Sub DoResize(Optional Where As Object, _
                    Optional sWidth As Integer, _
                    Optional sHeight As Integer)

    If Where Is Nothing Then Set Where = frmEdMap.picRender
    If sWidth = 0 Then sWidth = frmEdMap.picRender.ScaleWidth
    If sHeight = 0 Then sHeight = frmEdMap.picRender.ScaleHeight

    Dim naI As Integer

    With GFX
        'naI = .TexturePool.NATex
        '.Unload
        '.PreInit
        '.Enumerate
        '.Initialize Where, sWidth, sHeight, "", False, , naI
        '.TexturePool.ReAddTextures
        .Resize sWidth, sHeight
    End With 'GFX
    
    If Map Is Nothing Then Exit Sub
    Map.ReInit

End Sub

Public Sub Hilighting()

    If Mode = 2 Then
        'HiLightLayersZ
        DeHiLightLayers
    ElseIf HLMode = 0 Then
        DeHiLightLayers
    Else 'NOT HLMODE...
        HiLightLayers
    End If
    


End Sub

Public Sub DeHiLightLayers()

    Dim E   As Integer
    Dim A   As Integer
    Dim Lev As Object
    Dim lay As cGAMLayer

    For E = 1 To Map.Levels.Count
        Set Lev = Map.Levels(E)

        If TypeOf Lev Is cGAMLevel Then

            For A = 1 To Lev.Layers.Count
                Set lay = Lev.Layers(A)
                lay.Alpha = 255
                lay.Color = vbWhite
            Next A

        End If

    Next E

End Sub

Public Sub HiLightLayers()

    Dim E   As Integer
    Dim A   As Integer
    Dim Lev As Object
    Dim lay As cGAMLayer

    For E = 1 To Map.Levels.Count
        Set Lev = Map.Levels(E)

        If TypeOf Lev Is cGAMLevel Then

            For A = 1 To Lev.Layers.Count
                Set lay = Lev.Layers(A)

                If (E = CurrentLevel) And (A = CurrentLayer) Then
                    LayerHL lay, 255
                Else
                    LayerHL lay, 100
                End If
                

            Next A

        End If

    Next E

End Sub

Public Sub HiLightLayersZ()
    Dim E   As Integer
    Dim A   As Integer
    Dim Lev As Object
    Dim lay As cGAMLayer

    For E = 1 To Map.Levels.Count
        Set Lev = Map.Levels(E)

        If TypeOf Lev Is cGAMLevel Then

            For A = 1 To Lev.Layers.Count
                Set lay = Lev.Layers(A)

                If (E > CurrentLevel) Then
                    LayerHL lay, 100
                Else
                    LayerHL lay, 255
                End If
                

            Next A

        End If

    Next E
End Sub

Private Sub LayerHL(l As cGAMLayer, _
                    ByVal amount As Integer)

    l.Alpha = 255
    l.Color = vbWhite

    If Mode = 2 Then
        l.Color = rgb(amount, amount, amount)
        l.Alpha = amount
        l.Redraw = True
        
    ElseIf HLMode = 1 Then
        l.Alpha = amount
        l.Redraw = True
    ElseIf HLMode = 2 Then
        l.Color = rgb(amount, amount, amount)
        l.Redraw = True
    End If


End Sub

Public Function PromptForSprite(Caption As String, _
                                Directory As String, _
                                MultiSelect As Boolean) As Boolean
    RetMsg = False
    frmEdSprite.PromptDir = Directory
    frmEdSprite.MultiSel = MultiSelect
    frmEdSprite.Caption = Caption
    frmEdSprite.Show vbModal
    PromptForSprite = RetMsg
End Function

Public Function NPCAtPos(x As Long, _
                         y As Long) As Long
    Dim i As Integer, n As cS2DNPC

    For i = Map.m_NPCs.Count To 1 Step -1
        Set n = Map.m_NPCs(i)

        If n.x <= x And n.y - n.ZPlus <= y Then
            If n.x + n.Width >= x And n.y + n.Height - n.ZPlus >= y Then
    
                If CollisionDetect(x + 10000, y + 10000, 1, 1, 0, 0, PointDC, n.x + 10000, n.y + 10000 - n.ZPlus, n.SourceWidth, n.SourceHeight, n.SourceX, n.SourceY, n.MyDC) Then
                    NPCAtPos = i
                    Exit Function
                End If

            End If
        End If

    Next i

End Function

Public Sub Flatten(ParamArray lngHwnds())

    On Error GoTo Err_Handler:

    'VARIABLES:
    Dim lngStyle&, lng_cnt&

    'CODE:
    For lng_cnt = 0 To UBound(lngHwnds)
        lngStyle = GetWindowLong(lngHwnds(lng_cnt), GWL_EXSTYLE)
        lngStyle = (lngStyle And Not WS_EX_CLIENTEDGE Or WS_EX_STATICEDGE)
        SetWindowLong lngHwnds(lng_cnt), GWL_EXSTYLE, lngStyle
        SetWindowPos lngHwnds(lng_cnt), 0, 0, 0, 0, 0, &H1 Or &H2 Or &H4 Or &H20
    Next lng_cnt

    'END CODE:
    Exit Sub
Err_Handler:
    ' Err.source = Err.source & "." & VarType(Me) & ".ProcName"
    MsgBox Err.Number & vbTab & Err.source & Err.Description
    Err.Clear
    Resume Next
End Sub


Public Sub RenderTS()

    With frmEdMap
        If .picLB(0).Visible Then
            .picTileSet.TileSet = Map.TileSets(CurrentTileset).TexID
            .picTileSet.Render
         ElseIf .picLB(1).Visible Then '.PICLB(0).VISIBLE = FALSE/0
            .picColTS.TintColor = TileInfColors(SelColInf)
            .picColTS.Render
        End If
    End With 'frmEdMain

End Sub

Public Function File2Str(FileName As String) As String
'oh mann, nicht mal die wichtigsten hilfsfunktionen hat es hier :D

Dim i As Integer
i = FreeFile()

Open FileName For Binary Access Read As i
Dim s As String
s = String(LOF(i), Chr(0))
Get #i, , s
Close i

File2Str = s
End Function
