Attribute VB_Name = "modPlayer"

'###System###
Public engine As cS2D_i

Public GFX As cS2D_i

Public Map As cGAMMap
Public Msg As cS2DMessageBox
Public Particles As cS2DParticle       'dokumentieren: VIELLEICHT
Public Text As New cS2DText
Public Controller As New cS2DInput          'dokumentieren: JA
Public Menu As New cS2DMenu          'dokumentieren: JA
Public Limiter As cS2DLimiter
Public Effects As cS2DEffects

Public InitializeComplete As Boolean

'###Intro###
Private IntroAlpha As Integer
Private IntroBack As Boolean
Private IntroOver As Boolean
Private IntroWait As Boolean
Private IntroPos As Integer

Public Intro_Back As cS2DSprite
Public Intro_Fore As cS2DSprite

'###Game###
Public ScreenEffects As New cS2DScreenEffects
Public EffectRunning As Boolean

Private oldx As Double
Private oldy As Double
Private OldJump As Double

Public Player As cS2DNPC
Public ColTiles As cS2DNPC
Public colts As cGAMTileset

Public SelMap As String
Public Debug_Collision As Boolean
Public InfoOSD As Boolean
Public InfoCamera As Boolean

Public AppPath As String
Public DebugText(0 To 5) As String

Public FrameSkip As Integer
Private FrameCount As Integer

Public RealFps As cS2DFps
Public RenderFps As cS2DFps
Public NonRenderFps As cS2DFps

Private LastTimeCheckFrame As Double

'### Scripting ###
Public sobj_game As cGAMScriptAccess
Public sobj_Registry As cGAMRegistryScript

Public GlobalScripts As CHive
Public IgnorePlrControls As Boolean

Private Selected As Double

'ENGINE
Public FullScrn As Boolean
Public Scrn_w As Integer
Public Scrn_h As Integer
Public ZoomF As Integer
Public Proj As cGAMPackage
Public Running As Boolean
Public Project As cGAMProject
Public CurrentLevel As Integer
Public CurrentLayer As Integer

Dim sEd As Object
    

Public Function GimmeAScriptControl() As ScriptControl

    Load frmSupScript.sc(frmSupScript.sc.Count)
    Set GimmeAScriptControl = frmSupScript.sc(frmSupScript.sc.Count - 1)
    
End Function

Public Sub GetTileInfColors()

    ReDim TileInfColors(0 To 7)
    
    Dim crgb As ColorRGB
    Dim i As Integer
    
    For i = 1 To 6
        TileInfColors(i - 1) = QBColor(i)
        
        crgb = SplitColor(TileInfColors(i - 1))
    Next i

End Sub

Public Function GetRootPath() As String

    GetRootPath = App.Path
    GetRootPath = Left(GetRootPath, InStrRev(GetRootPath, "\") - 1)
    
End Function

Public Sub DoResize()
    
    If Not Running Then Exit Sub
    engine.Resize frmMain.ScaleWidth, frmMain.ScaleHeight

End Sub

Public Sub Main()
    
    Set engine = New cS2D_i
    Set GFX = engine
    
    Set Map = New cGAMMap
    Set Limiter = New cS2DLimiter
    Set Msg = New cS2DMessageBox
    
    Set RealFps = New cS2DFps
    Set RenderFps = New cS2DFps
    Set NonRenderFps = New cS2DFps
    Set Player = New cS2DNPC
    Set Player.MyS2D = engine
    
    Const_TileWidth = 16
    Const_TileHeight = 16
    
    
    frmMain.Show
    DoEvents
    
    Initialize
End Sub

Public Sub Initialize()
    Set sobj_game = New cGAMScriptAccess
    Set sobj_Registry = New cGAMRegistryScript
    AppPath = GetRootPath
    RootDir = AppPath
    
    If Command = "" Then
        frmSelMap.Show vbModal
    Else
    
        Dim pars As String
        pars = Command
        
        If InStr(1, LCase(pars), "/log") > 0 Then
            Logging = True
            pars = Replace(pars, "/log", "", , , vbTextCompare)
        End If
        
        If InStr(1, LCase(pars), "/logtofile") > 0 Then
            LogToFile = True
            pars = Replace(pars, "/logtofile", "", , , vbTextCompare)
        End If
        
        If InStr(1, LCase(pars), "/debugcol") > 0 Then
            Debug_Collision = True
            pars = Replace(pars, "/debugcol", "", , , vbTextCompare)
        End If
        
        Dim i As Integer
        For i = 1 To Len(pars)
            If Not (Mid(pars, i, 1) = " ") Then
                pars = Mid(pars, i)
                Exit For
            End If
        Next i
        
        SelMap = pars
        
    End If
    
    Set LoadedDependencies = New Collection
    
    Set Project = New cGAMProject
    If Not Project.LoadProject(UpOneFolder(App.Path) & "\projects\" & CurProj & "\" & CurProj & ".rpak", , True, True) Then
        MsgBox "Could not load Project: " & Project.ErrDescription & " (" & Project.ErrSource & ")", vbCritical, "Error"
        End
    End If
    
    If Not ProvideDoesExist(SelMap) Then
        MsgBox "Could not start this project because the start map file you selected was not found." & vbCrLf & vbCrLf & "a) If you used 'Start Project', Please make sure there is a start.rmap file using the Minerva editor or the Pak editor." & vbCrLf & vbCrLf & "b) If you used the 'Start from Resource Link' option, make sure your Resource Link is correct.", vbInformation, "Error"
        End
    End If
    
    frmMain.lblLoading.Visible = True
    
    InitLogging
    If Logging Then frmScriptLog.Show
    
    frmMain.SetFocus
    Log "Application started.", ltSuccess
    
    engine.Initialize frmMain.hwnd, Scrn_w, Scrn_h, IIf(FullScrn, Scrn_w, -1), IIf(FullScrn, Scrn_h, -1)
    ZoomFactor = ZoomF
    
    Log "Base init succeeded.", ltSuccess
    
    Log "Initializing particle engine...", ltAction
    Set Particles = New cS2DParticle
    Set Particles.S2D = engine
    
    Log "Loading Map file '" & SelMap & "'...", ltAction
    Set Map = New cGAMMap
    Set Map.MyS2D = engine
    
    If Not Map.LoadMap(SelMap) Then
        FinishLogging
        engine.Unload
        End
    End If
    
    Map.NoBuffer = True
    
    Log "Loading Intro...", ltAction
    Set Intro_Back = New cS2DSprite
    Set Intro_Back.S2D = engine
    Intro_Back.Initialize App.Path & "\splashback.png", vbMagenta
    
    Set Intro_Fore = New cS2DSprite
    Set Intro_Fore.S2D = engine
    Intro_Fore.Initialize App.Path & "\splash.png", vbMagenta
    
    Log "Initializing Player Character...", ltAction
    Set Player.S2D = engine
    Player.Initialize "smiley.png", rgb(255, 0, 255)
    Player.Name = "Player"
    Player.Use3dCol = True
    
    Log "Initializing support functions...", ltAction
    Set Msg.S2D = engine
    Set Msg.Text = Text
    Set Text.S2D = engine
    Text.InitText App.Path & "\System(8).PNG", App.Path & "\System(8).txt"
    
    Set Menu.S2D = engine
    Set Menu.Text = Text
    Set Controller.S2D = engine
    
    Log "Initializing collision detection...", ltAction
    Set ColTiles = New cS2DNPC
    Set ColTiles.MyS2D = engine
    Set ColTiles.S2D = engine
    ColTiles.Initialize "colmask.png", rgb(255, 0, 255)
    Set colts = New cGAMTileset
    Set colts.MyMap = Map
    colts.Initialize "images\colmask.png"
    

    
    
    Set GlobalScripts = New CHive
    If Dir(AppPath & "\projects\" & CurProj & "\scripts\main.rscr") <> "" Then
        Log "Initializing global script...", ltAction
        sobj_game.AddGlobalScript "main.rscr"
    End If
    
    Set Effects = New cS2DEffects
    Set Effects.MyPool = engine.TexturePool.Pool1
    
    Dim dep As cGAMPackage
    Dim dfn As String
    For i = 1 To LoadedDependencies.Count
        Set dep = LoadedDependencies(i)
        dfn = dep.RPAK.FileName
        dfn = Mid$(dfn, InStrRev(dfn, "\") + 1)
        If ProvideDoesExist(dfn & "://main.rscr") Then
                    Log "Initializing package " & dfn & " global script...", ltAction
                    sobj_game.AddGlobalScript dfn & "://main.rscr"
        End If
    Next i
    
    Player.x = 4 * Const_TileWidth
    Player.y = 4 * Const_TileHeight
    Player.CurrentLevel = 1
    Player.JumpDuration = 23
    Player.JumpSpeed = 6
    Player.StairHeight = 10
    Player.FocusCamera
    GeneralCameraSpeed = 0.1
    GeneralCameraSpeedFactor = 10
    GeneralCameraMaxSpeed = 1.5
    GeneralCameraMaxDistance = 50
    Gravity = -2
    
    'INTRO
    InitializeComplete = True
    Log "Initialize Complete.", ltSuccess
    Log "Intro Time!", ltAction
    frmMain.lblLoading.Visible = False
    Running = True
    
    engine.FpsLimit = 100
    
    Do
        
        Limiter.LimitFrames engine.FpsLimit
        RealFps.CalcFps
        RenderIntro
        DoEvents
        
    Loop Until IntroOver
    
    'GAME
    Map.RunScript "Initialize"
    Log "Entering Loop", ltInformation
    
    Do
    
        Limiter.LimitFrames engine.FpsLimit
        RealFps.CalcFps
        DoGameEvents
        DoEvents
        
    Loop Until Unloaded
    FinishLogging
    
End Sub


Public Sub DoGameEvents()
    ShowCursor False
    Selected = Selected + CVal(1)
    
    If Not EffectRunning Then
        
        If Selected > 1 Then
            NonRender
            Selected = 0
        End If
        
        'On Error Resume Next
        'FrameCount = FrameCount + 1
    
        'If FrameCount > FrameSkip Then
            RenderGame
        '    FrameCount = 0
        'End If
    
    End If
    DoEvents

End Sub

Public Sub RenderIntro()
    ShowCursor False
    engine.Clear
    engine.BeginScene
      
    If IntroBack = False Then
        IntroAlpha = IntroAlpha + 5
    ElseIf IntroWait = True Then
        IntroPos = IntroPos + 1
    Else
        IntroAlpha = IntroAlpha - 5
    End If
    
    If IntroAlpha >= 251 Then IntroBack = True: IntroWait = True
    If IntroAlpha <= 0 Then IntroOver = True
    If IntroPos >= 50 Then IntroWait = False
    
    Dim r As RECT
    r.Right = ScreenWidth * ZoomFactor
    r.Bottom = ScreenHeight * ZoomFactor
    
    Intro_Back.Render 0, 0, ScreenWidth, ScreenHeight, , , , , IIf(IntroBack, IntroAlpha, 255)
    Intro_Fore.Render ScreenWidth / 2 - Intro_Fore.Width / 2, ScreenHeight / 2 - Intro_Fore.Height / 2, , , , , , , IntroAlpha
    
    engine.EndScene
    engine.Flip frmMain.hwnd
    
End Sub

Public Sub NonRender()

    FocusNPC.AdjustCamera
    
    'For i = 1 To Map.m_npcs.Count
    'Map.m_npcs(i).Script.CallFunc ("OnEver")
    'Next i
    
    If Not IgnorePlrControls Then
        Dim xdir As Double, ydir As Double
        If Controller.CheckKey(vbKeyUp, 0) Then ydir = -2
        If Controller.CheckKey(vbKeyDown, 0) Then ydir = 2
        If Controller.CheckKey(vbKeyLeft, 0) Then xdir = -2
        If Controller.CheckKey(vbKeyRight, 0) Then xdir = 2
        If Controller.CheckKey(vbKeySpace, 0) Then Player.Jumping = True
        
        If InfoCamera Then
            If Controller.CheckKey(vbKeyQ, 0) Then GeneralCameraMaxSpeed = GeneralCameraMaxSpeed + 0.1
            If Controller.CheckKey(vbKeyA, 0) Then GeneralCameraMaxSpeed = GeneralCameraMaxSpeed - 0.1
            
            If Controller.CheckKey(vbKeyW, 0) Then GeneralCameraMaxDistance = GeneralCameraMaxDistance + 0.1
            If Controller.CheckKey(vbKeyS, 0) Then GeneralCameraMaxDistance = GeneralCameraMaxDistance - 0.1
            
            If Controller.CheckKey(vbKeyE, 0) Then GeneralCameraSpeed = GeneralCameraSpeed + 0.1
            If Controller.CheckKey(vbKeyD, 0) Then GeneralCameraSpeed = GeneralCameraSpeed - 0.1
            
            If Controller.CheckKey(vbKeyR, 0) Then GeneralCameraSpeedFactor = GeneralCameraSpeedFactor + 0.1
            If Controller.CheckKey(vbKeyF, 0) Then GeneralCameraSpeedFactor = GeneralCameraSpeedFactor - 0.1
            
            If Controller.CheckKey(vbKey1, 0) Then
                GeneralCameraMaxSpeed = 1.5
                GeneralCameraSpeedFactor = 10
            End If
            
            If Controller.CheckKey(vbKey2, 0) Then
                GeneralCameraMaxSpeed = 3.5
                GeneralCameraSpeedFactor = 3.5
            End If
            
            If Controller.CheckKey(vbKey3, 0) Then
                GeneralCameraMaxSpeed = 3.5
                GeneralCameraSpeedFactor = 1
                GeneralCameraMaxDistance = 80
            End If
            
            GeneralCameraMaxSpeed = Round(GeneralCameraMaxSpeed, 1)
            GeneralCameraMaxDistance = Round(GeneralCameraMaxDistance, 1)
            GeneralCameraSpeed = Round(GeneralCameraSpeed, 1)
            GeneralCameraSpeedFactor = Round(GeneralCameraSpeedFactor, 1)
        End If
    End If
    
    Player.GameLogic
    
    Dim i As Integer
    For i = 1 To Map.m_NPCs.Count
        Map.m_NPCs(i).GameLogic
    Next i
    
    If Not IgnorePlrControls Then Player.Move xdir, ydir
    GlobalEvent "Interval"
    ResetCamera
    
End Sub

Private Sub ResetCamera()
    
    If Not OldCameraX = CameraX Or Not OldCameraY = CameraY Then
        
        If CameraX > 0 Then CameraX = 0
        If CameraY > 0 Then CameraY = 0
        If CameraX < (Map.MapWidth * Const_TileWidth) * -1 + ScreenWidth Then CameraX = (Map.MapWidth * Const_TileWidth - ScreenWidth) * -1
        If CameraY < (Map.MapHeight * Const_TileHeight) * -1 + ScreenHeight Then CameraY = (Map.MapHeight * Const_TileHeight - ScreenHeight) * -1
        
    End If
    
    If Map.MapWidth * Const_TileWidth < ScreenWidth Then
        CameraX = (ScreenWidth / 2) - ((Map.MapWidth * Const_TileWidth) / 2)
    End If
    
    If Map.MapHeight * Const_TileHeight < ScreenHeight Then
        CameraY = (ScreenHeight / 2) - ((Map.MapHeight * Const_TileHeight) / 2)
    End If
    
    OldCameraX = CameraX
    OldCameraY = CameraY
    
End Sub

Public Sub DoGlobalScripts(FName As String)

    Dim i As Integer
    
    For i = 1 To GlobalScripts.Count
        GlobalScripts(i).CallFunc FName
    Next i

End Sub

Public Sub RenderGame()
    ShowCursor False
    engine.Clear
    engine.BeginScene
    RenderFps.CalcFps
    
    ResetCamera
    
    Map.Render CLng(CameraX), CLng(CameraY), 0, Player.Z + 1
    Effects.RenderRectangle 0, 0, ScreenWidth, ScreenHeight, sobj_game.BrightnessColor, sobj_game.BrightnessColor, sobj_game.BrightnessColor, sobj_game.BrightnessColor, 255 - sobj_game.Brightness
    Player.Render Player.x + CameraX, Player.y + CameraY
    Map.Render CLng(CameraX), CLng(CameraY), Player.Z + 1, 9999
    
    Particles.RenderAll CInt(CameraX), CInt(CameraY)
    Msg.RenderMessageSystem
    
    If Debug_Collision Then RenderColLevel
        
    If InfoOSD Then Text.DrawText 0, 0, "Fps:" & RealFps.SmoothFps & "<br>FrameSkip:" & FrameSkip
    
    If Debug_Collision Then
        Effects.RenderBorderRect Player.x + CameraX, Player.y - (Player.Z + Player.ZPlus) + CameraY, Player.Width, Player.Height, vbRed, 200, 3
        Text.DrawTextSimple 0, 20, Player.CurrentLevel
        Text.DrawTextSimple 0, 30, Player.Z & " + " & Player.ZPlus & " = " & (Player.Z + Player.ZPlus)
    End If
           
    Dim i As Integer
    For i = 0 To 5
        Text.DrawTextSimple 0, 70 + i * 10, DebugText(i)
    Next i
    
    If InfoCamera Then
        Text.DrawTextSimple 50, 0, "Camera Speed X :" & CameraSpeedX
        Text.DrawTextSimple 50, 10, "Camera Speed Y :" & CameraSpeedY
        Text.DrawTextSimple 50, 30, "[Q+][A-]General Camera Speed Max:" & GeneralCameraMaxSpeed
        Text.DrawTextSimple 50, 40, "[W+][S-]General Camera Distance Max :" & GeneralCameraMaxDistance
        Text.DrawTextSimple 50, 50, "[E+][D-]General Camera Speed:" & GeneralCameraSpeed
        Text.DrawTextSimple 50, 60, "[R+][F-]General Camera Speed Faktor:" & GeneralCameraSpeedFactor
        Text.DrawTextSimple 50, 70, "[1]Normal [2]Schunkeln [3]Schiff"
    End If
    
    engine.EndScene
    engine.Flip frmMain.hwnd
    
End Sub

Public Sub RenderColLevel()

    If Player.CurrentLevel = 0 Then Exit Sub
    
    Dim TexP As cS2DTexturePool_i
    Set TexP = engine.TexturePool
    
    Dim cl As cGAMLevel
    Set cl = Map.Levels(Player.CurrentLevel)
    
    Dim x As Integer, y As Integer
    Dim XTo As Double, YTo As Double
    Dim XFrom As Integer, YFrom As Integer
    
    Dim xOfs As Double
    Dim yOfs As Double
    xOfs = cl.XOffset + toX
    yOfs = cl.YOffset + toY
    
    Dim tsid As Byte
    Dim mc As tMapCell
    
    Dim StartX As Integer, StartY As Integer
    Dim EndX As Integer, EndY As Integer
    
    StartX = -1 * (CameraX / Const_TileWidth) - 1
    StartY = -1 * (CameraY / Const_TileHeight) - 1
    
    EndX = StartX + (ScreenWidth / Const_TileWidth) + 2
    EndY = StartY + (ScreenHeight / Const_TileHeight) + 2
    
    If EndX >= Map.MapWidth Then EndX = Map.MapWidth - 1
    If EndY >= Map.MapHeight Then EndY = Map.MapHeight - 1
    
    If StartX < 0 Then StartX = 0
    If StartY < 0 Then StartY = 0
    
    For x = StartX To EndX
    For y = StartY To EndY
    
        XTo = x * Const_TileWidth + CameraX
        YTo = y * Const_TileHeight + CameraY
        
        XFrom = cl.ColTileX(x, y) * Const_TileWidth
        YFrom = cl.ColTileY(x, y) * Const_TileHeight
        
        TexP.RenderTexture colts.TexID, XTo, YTo, Const_TileWidth, Const_TileHeight, Const_TileWidth, Const_TileHeight, XFrom, YFrom, 100, , , , , TileInfColors(cl.ColInf(x, y))
    
nextcell:
    Next y
    Next x
    
End Sub

Public Function CVal(Value As Double) As Double
    
    On Error Resume Next
    
    If RealFps.FrameRate = 0 Then
        CVal = 0
    Else
        CVal = (50 / RealFps.FrameRate) * Value
    End If
    
End Function


Public Sub GlobalEvent(FName As String)
    
    Map.RunScript FName
    DoGlobalScripts FName
    
End Sub


Public Function GetSettingsEditor(TypeName As String) As Object

    If Not LCase(TypeName) = "list" Then
        Set sEd = New cSettingsRenderer
        Set GetSettingsEditor = sEd
    Else
        Set sEd = New cSettingsRenderer_List
        Set GetSettingsEditor = sEd
    End If
End Function
