VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cGAMScript"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private CFm_sHost        As ScriptControl
Private m_ScriptText     As String
Private m_ScriptFile     As String

Public ParentObj As Object

Public Interval As Integer
Private tInterval As Integer

'dokumentieren: NEIN
Public Property Get sHost() As ScriptControl
    
    Set sHost = CFm_sHost

End Property

Public Property Set sHost(PropVal As ScriptControl)

    Set CFm_sHost = PropVal

End Property

'dokumentieren: NEIN
Public Sub AddObjects()

    If IgnoreScripts Then
        Exit Sub
    End If
    
    sHost.AddObject "script", Me
    sHost.AddObject "game", sobj_game
    If Not ParentObj Is Nothing Then sHost.AddObject "npc", ParentObj
    sHost.AddObject "gfx", engine
    sHost.AddObject "map", Map
    'sHost.AddObject "msg", Msg
    sHost.AddObject "player", Player
    sHost.AddObject "input", Controller
    sHost.AddObject "registry", sobj_Registry
    sHost.AddObject "menu", Menu
    sHost.AddObject "controller", Controller
    sHost.AddObject "particles", Particles
    
End Sub


Private Sub Class_Initialize()
    If IgnoreScripts Then Exit Sub
    
    
    Set CFm_sHost = GimmeAScriptControl

End Sub

'dokumentieren: JA
Public Sub Load(ByVal ScriptFile As String)
  
  Dim s As String
  Dim p As String
  Dim tf As Boolean
    m_ScriptFile = ScriptFile
    
    p = ProvideFile(ScriptFile, tf)
    
    If p = "" Then
        Log "Error: could not provide ScriptFile: '" & ScriptFile & "'", ltError
        Exit Sub
    End If
    
    Open p For Binary Access Read As #1
    s = String$(LOF(1), Chr$(0))
    Get #1, , s
    Close 1
    
    If tf Then Kill p
    
    LoadText s

End Sub


'dokumentieren: JA
Public Sub LoadText(ByVal s As String)

    m_ScriptText = m_ScriptText & vbCrLf & s
    If IgnoreScripts Then
        Exit Sub
    End If
    sHost.AddCode s

End Sub

'dokumentieren: JA
Public Property Get ScriptText() As String

    ScriptText = m_ScriptText

End Property

'Warnung: dadurch ändert sich das script im control nicht!
Public Property Let ScriptText(ByVal vNew As String)
 
    m_ScriptText = vNew

End Property

'dokumentieren: JA
Public Sub CallFunc(ByVal FName As String)

If FName = "Interval" Then
    If tInterval >= Interval Then
        DoCallFunc "Interval": tInterval = 0
    Else
        tInterval = tInterval + 1: Exit Sub
    End If
Else
    DoCallFunc FName
End If
End Sub

'dokumentieren: NEIN
Private Sub DoCallFunc(ByVal FName As String)

If IgnoreScripts Then
Exit Sub
End If
If LenB(m_ScriptText) = 0 Then
Exit Sub
End If

If InStr(1, LCase(m_ScriptText), "sub " & LCase(FName)) = 0 Then
If InStr(1, LCase(m_ScriptText), "function " & LCase(FName)) = 0 Then
Exit Sub
End If
End If

On Error GoTo screrr

sHost.Run FName

Exit Sub

screrr:

Log "Error (" & m_ScriptFile & "): " & Err.Description & "," & Err.source, ltError


End Sub

'dokumentieren: NEIN
Public Function DoEngineEvents()

'If IsRunning = True Then IsRunning = False Else IsRunning = True
'Debug.Print IsRunning

End Function
''



