tyler.durden
/
P3D-Legacy
mirror of https://github.com/P3D-Legacy/P3D-Legacy.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

push old status

This commit is contained in:
nilllzz 2018-01-08 19:12:10 +01:00
parent 16bb5c2ec1
commit 640dfc313e
24 changed files with 2635 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
2.5DHero/2.5DHero/2.5DHero.vbproj
View File

@ -87,6 +87,8 @@
<Content Include="Scripts\underwatercave\rocks\Clipboard Text %2823-10-16, 22.00.44%29.txt">
<CopyToOutputDirectory>Always</CopyToOutputDirectory>
</Content>
<Compile Include="World\ActionScript\V3\Prototypes\CameraPrototype.vb" />
<Compile Include="World\ActionScript\V3\Prototypes\DaycarePrototype.vb" />
<None Include="maps\battle\fortune\altering.dat">
<CopyToOutputDirectory>Always</CopyToOutputDirectory>
</None>
@ -12678,6 +12680,24 @@
<Compile Include="World\ActionScript\V2\ScriptConstructs\DoSystem.vb" />
<Compile Include="World\ActionScript\V2\ScriptLibrary.vb" />
<Compile Include="World\ActionScript\V2\ScriptV2.vb" />
<Compile Include="World\ActionScript\V3\ApiClasses\ApiClass.vb" />
<Compile Include="World\ActionScript\V3\ApiClasses\ApiClassAttribute.vb" />
<Compile Include="World\ActionScript\V3\ApiClasses\ApiClassMethodAttribute.vb" />
<Compile Include="World\ActionScript\V3\ApiClasses\Chat.vb" />
<Compile Include="World\ActionScript\V3\ApiClasses\Text.vb" />
<Compile Include="World\ActionScript\V3\ParamHelper.vb" />
<Compile Include="World\ActionScript\V3\Prototypes\AbilityPrototype.vb" />
<Compile Include="World\ActionScript\V3\Prototypes\BattlePrototype.vb" />
<Compile Include="World\ActionScript\V3\Prototypes\EntityPrototype.vb" />
<Compile Include="World\ActionScript\V3\Prototypes\ItemPrototype.vb" />
<Compile Include="World\ActionScript\V3\Prototypes\MovePrototype.vb" />
<Compile Include="World\ActionScript\V3\Prototypes\PokemonPrototype.vb" />
<Compile Include="World\ActionScript\V3\Prototypes\TrainerProtoype.vb" />
<Compile Include="World\ActionScript\V3\Prototypes\TypeContract.vb" />
<Compile Include="World\ActionScript\V3\Prototypes\Vector3Prototype.vb" />
<Compile Include="World\ActionScript\V3\ScriptInputType.vb" />
<Compile Include="World\ActionScript\V3\ScriptManager.vb" />
<Compile Include="World\ActionScript\V3\ScriptStartFlag.vb" />
<Compile Include="World\Badge.vb" />
<Compile Include="World\BaseEntity.vb" />
<Compile Include="World\Level.vb" />
@ -12690,6 +12710,12 @@
<Compile Include="World\Terrain.vb" />
<Compile Include="World\World.vb" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\..\kolben\Kolben\Kolben.csproj">
<Project>{ed665f9b-07f4-4415-bd72-a728cf1ea909}</Project>
<Name>Kolben</Name>
</ProjectReference>
</ItemGroup>
<ItemGroup />
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
<Import Condition=" '$(Configuration)' != 'DebugNoContent' Or '$(Configuration)' != 'ReleaseNoContent' " Project="$(MSBuildExtensionsPath)\MonoGame\v3.0\MonoGame.Content.Builder.targets" />

32
2.5DHero/2.5DHero/Entites/Enviroment/SignBlock.vb
View File

@ -1,4 +1,6 @@
Public Class SignBlock
Imports net.Pokemon3D.Game.Scripting.V3
Public Class SignBlock
Inherits Entity
@ -34,18 +36,30 @@
End Select
If canRead = True Then
Dim oScreen As OverworldScreen = CType(Core.CurrentScreen, OverworldScreen)
If oScreen.ActionScript.IsReady = True Then
'Dim oScreen As OverworldScreen = CType(Core.CurrentScreen, OverworldScreen)
'If oScreen.ActionScript.IsReady = True Then
' SoundManager.PlaySound("select")
' Select Case Me.ActionValue
' Case 0, 3
' oScreen.ActionScript.StartScript(Me.AdditionalValue, 1)
' Case 1
' oScreen.ActionScript.StartScript(Me.AdditionalValue, 0)
' Case 2
' oScreen.ActionScript.StartScript(Me.AdditionalValue.Replace("<br>", Environment.NewLine), 2)
' Case Else
' oScreen.ActionScript.StartScript(Me.AdditionalValue, 1)
' End Select
'End If
Dim sManager = ScriptManager.Instance
If Not sManager.IsActive Then
SoundManager.PlaySound("select")
Select Case Me.ActionValue
Case 0, 3
oScreen.ActionScript.StartScript(Me.AdditionalValue, 1)
Case 1
oScreen.ActionScript.StartScript(Me.AdditionalValue, 0)
sManager.StartScript(Me.AdditionalValue, ScriptInputType.File, ScriptStartFlag.None)
Case 2
oScreen.ActionScript.StartScript(Me.AdditionalValue.Replace("<br>", Environment.NewLine), 2)
Case Else
oScreen.ActionScript.StartScript(Me.AdditionalValue, 1)
sManager.StartScript(Me.AdditionalValue.Replace("<br>", Environment.NewLine), ScriptInputType.Raw, ScriptStartFlag.None)
Case Else ' 0 and 3
sManager.StartScript(Me.AdditionalValue, ScriptInputType.Text, ScriptStartFlag.None)
End Select
End If
End If

26
2.5DHero/2.5DHero/Modules/Extensions.vb
View File

@ -312,31 +312,7 @@ Module Extensions
<Extension()>
Public Function SplitAtNewline(ByVal s As String) As String()
If s.Contains("§") = False Then
Return s.Replace(StringHelper.CrLf, "§").Replace(StringHelper.LineFeed, "§").Split(CChar("§"))
Else
Dim Data As New List(Of String)
If s = "" Then
Return (New List(Of String)).ToArray()
End If
Dim i As Integer = 0
While s <> "" And i < s.Length
If s.Substring(i).StartsWith(StringHelper.CrLf) = False Or s.Substring(i).StartsWith(StringHelper.LineFeed) = False Then
i += 1
Else
Data.Add(s.Substring(0, i))
i += 2
s = s.Remove(0, i)
i = 0
End If
End While
Data.Add(s.Substring(0, i))
Return Data.ToArray()
End If
Return s.Split({Environment.NewLine}, StringSplitOptions.None)
End Function
<Extension()>

1
2.5DHero/2.5DHero/Overworld/OverworldScreen.vb
View File

@ -214,6 +214,7 @@ Public Class OverworldScreen
End If
ActionScript.Update() 'Update the action script.
Scripting.V3.ScriptManager.Instance.Update()
Else 'Dialogues are showing:
'Update some parts of the camera:
If Camera.Name = "Overworld" Then

35
2.5DHero/2.5DHero/World/ActionScript/V3/ApiClasses/ApiClass.vb Normal file
View File

@ -0,0 +1,35 @@
Imports Kolben.Adapters
Imports Kolben.Types
Namespace Scripting.V3.ApiClasses
Friend MustInherit Class ApiClass
Protected Shared Function EnsureTypeContract(parameters As SObject(), typeContract As Type(), ByRef netObjects As Object(), Optional optionalCount As Integer = 0) As Boolean
If parameters.Length + optionalCount >= typeContract.Length Then
netObjects = New Object(parameters.Length - 1) {}
Dim i = 0
While i < parameters.Length
netObjects(i) = ScriptOutAdapter.Translate(parameters(i))
If i < typeContract.Length AndAlso Not typeContract(i) = netObjects(i).GetType() Then
Return False
End If
i += 1
End While
Return True
Else
netObjects = Nothing
Return False
End If
End Function
End Class
End Namespace

16
2.5DHero/2.5DHero/World/ActionScript/V3/ApiClasses/ApiClassAttribute.vb Normal file
View File

@ -0,0 +1,16 @@
Namespace Scripting.V3.ApiClasses
<AttributeUsage(AttributeTargets.Class)>
Friend Class ApiClassAttribute
Inherits Attribute
Public Property ClassName As String
Public Sub New(className As String)
Me.ClassName = className
End Sub
End Class
End Namespace

10
2.5DHero/2.5DHero/World/ActionScript/V3/ApiClasses/ApiClassMethodAttribute.vb Normal file
View File

@ -0,0 +1,10 @@
Namespace Scripting.V3.ApiClasses
<AttributeUsage(AttributeTargets.Method)>
Friend Class ApiClassMethodAttribute
Inherits Attribute
End Class
End Namespace

18
2.5DHero/2.5DHero/World/ActionScript/V3/ApiClasses/Chat.vb Normal file
View File

@ -0,0 +1,18 @@
Imports Kolben
Imports Kolben.Adapters
Imports Kolben.Types
Namespace Scripting.V3.ApiClasses
<ApiClass("Chat")>
Friend NotInheritable Class ChatWrapper
<ApiClassMethod>
Public Shared Function clear(processor As ScriptProcessor, parameters As SObject()) As SObject
Chat.ClearChat()
Return ScriptInAdapter.GetUndefined(processor)
End Function
End Class
End Namespace

115
2.5DHero/2.5DHero/World/ActionScript/V3/ApiClasses/Text.vb Normal file
View File

@ -0,0 +1,115 @@
Imports Kolben
Imports Kolben.Adapters
Imports Kolben.Types
Namespace Scripting.V3.ApiClasses
<ApiClass("Text")>
Friend NotInheritable Class Text
Inherits ApiClass
<ApiClassMethod>
Public Shared Function show(processor As ScriptProcessor, parameters As SObject()) As SObject
Dim netObjects As Object() = Nothing
If EnsureTypeContract(parameters, {GetType(String)}, netObjects) Then
Screen.TextBox.reDelay = 0.0F
Screen.TextBox.Show(CType(netObjects(0), String), {}, False, False)
ScriptManager.Instance.WaitFrames(1)
End If
Return ScriptInAdapter.GetUndefined(processor)
End Function
<ApiClassMethod>
Public Shared Function setFont(processor As ScriptProcessor, parameters As SObject()) As SObject
Dim netObjects = New Object(0) {}
If EnsureTypeContract(parameters, {GetType(String)}, netObjects) Then
Dim fontName = CType(netObjects(0), String)
Dim f As FontContainer = FontManager.GetFontContainer(fontName)
If Not f Is Nothing Then
Screen.TextBox.TextFont = f
Else
Screen.TextBox.TextFont = FontManager.GetFontContainer("textfont")
End If
End If
Return ScriptInAdapter.Translate(processor, Screen.TextBox.TextFont.FontName)
End Function
<ApiClassMethod>
Public Shared Function debug(processor As ScriptProcessor, parameters As SObject()) As SObject
Dim netObjects = New Object(0) {}
If EnsureTypeContract(parameters, {GetType(String)}, netObjects) Then
Dim text = CType(netObjects(0), String)
Logger.Debug("DEBUG: " & text)
End If
Return ScriptInAdapter.GetUndefined(processor)
End Function
<ApiClassMethod>
Public Shared Function log(processor As ScriptProcessor, parameters As SObject()) As SObject
Dim netObjects = New Object(0) {}
If EnsureTypeContract(parameters, {GetType(String)}, netObjects) Then
Dim text = CType(netObjects(0), String)
Logger.Log(Logger.LogTypes.Debug, text)
End If
Return ScriptInAdapter.GetUndefined(processor)
End Function
<ApiClassMethod>
Public Shared Function setColor(processor As ScriptProcessor, parameters As SObject()) As SObject
Dim netObjects As Object() = Nothing
If EnsureTypeContract(parameters, {GetType(String)}, netObjects) Then
Dim colorType = CType(netObjects(0), String)
Select Case colorType.ToLowerInvariant()
Case "playercolor", "player"
Screen.TextBox.TextColor = TextBox.PlayerColor
Case "defaultcolor", "default"
Screen.TextBox.TextColor = TextBox.DefaultColor
Case Else 'Try to convert the input color name into a color: (https://msdn.microsoft.com/en-us/library/system.drawing.knowncolor%28v=vs.110%29.aspx)
Screen.TextBox.TextColor = Drawing.Color.FromName(colorType).ToXNA()
End Select
ElseIf EnsureTypeContract(parameters, {GetType(Integer), GetType(Integer), GetType(Integer), GetType(Integer)}, netObjects, 1) Then
Dim helper = New ParamHelper(netObjects)
Dim r = helper.Pop(Of Integer)
Dim g = helper.Pop(Of Integer)
Dim b = helper.Pop(Of Integer)
Dim a = helper.Pop(255)
Screen.TextBox.TextColor = New Color(r, g, b, a)
End If
Return ScriptInAdapter.GetUndefined(processor)
End Function
End Class
End Namespace

55
2.5DHero/2.5DHero/World/ActionScript/V3/ParamHelper.vb Normal file
View File

@ -0,0 +1,55 @@
Namespace Scripting.V3
Friend NotInheritable Class ParamHelper
Private _parameters As Object()
Private _index As Integer
Public Sub New(parameters As Object())
_parameters = parameters
End Sub
''' <summary>
''' Grabs the next item from the parameter stack and advances the stack.
''' </summary>
Public Function Pop(Of T)(Optional defaultValue As T = Nothing) As T
If HasEnded() Then Return defaultValue
Dim result As T
If _parameters(_index) IsNot Nothing Then
result = CType(_parameters(_index), T)
Else
result = defaultValue
End If
_index += 1
Return result
End Function
''' <summary>
''' Skips a set amount of items on the stack.
''' </summary>
Public Sub Skip(Optional steps As Integer = 1)
_index += steps
End Sub
''' <summary>
''' Checks if the helper has reached the end of the stack.
''' </summary>
Public Function HasEnded() As Boolean
Return _index = _parameters.Length
End Function
''' <summary>
''' Returns the amount of items still on the stack.
''' </summary>
Public Function GetStackSize() As Integer
Return _parameters.Length - _index
End Function
End Class
End Namespace

61
2.5DHero/2.5DHero/World/ActionScript/V3/Prototypes/AbilityPrototype.vb Normal file
View File

@ -0,0 +1,61 @@
Option Strict On
Imports Kolben.Adapters
Namespace Scripting.V3.Prototypes
<ScriptPrototype(VariableName:="Ability")>
Friend NotInheritable Class AbilityPrototype
Public Shared Function GetAbility(This As Object) As Ability
Return CType(This, AbilityPrototype).ref
End Function
<Reference>
Public ref As Ability
Public Sub New() : End Sub
Public Sub New(a As Ability)
ref = a
End Sub
<ScriptFunction(ScriptFunctionType.Constructor, VariableName:="constructor")>
Public Shared Function Constructor(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(Integer)) Then
objLink.SetReference(NameOf(ref), Ability.GetAbilityByID(CType(parameters(0), Integer)))
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="name")>
Public Shared Function GetName(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim a = GetAbility(This)
Return a.Name
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="id")>
Public Shared Function GetId(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim a = GetAbility(This)
Return a.ID
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="description")>
Public Shared Function GetDescription(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim a = GetAbility(This)
Return a.Description
End Function
End Class
End Namespace

195
2.5DHero/2.5DHero/World/ActionScript/V3/Prototypes/BattlePrototype.vb Normal file
View File

@ -0,0 +1,195 @@
Option Strict On
Imports Kolben.Adapters
Namespace Scripting.V3.Prototypes
<ScriptPrototype(VariableName:="Battle")>
Friend NotInheritable Class BattlePrototype
<ScriptVariable>
Public canRun As Boolean = True
<ScriptVariable>
Public canCatch As Boolean = True
<ScriptVariable>
Public canBlackout As Boolean = True
<ScriptVariable>
Public canReceiveExp As Boolean = True
<ScriptVariable>
Public canUseItems As Boolean = True
<ScriptVariable>
Public frontierTrainer As Integer = -1
<ScriptVariable>
Public isDiveBattle As Boolean = False
<ScriptVariable>
Public isInverseBattle As Boolean = False
<ScriptVariable>
Public customBattleMusic As String = ""
<ScriptVariable>
Public hiddenAbilityChance As Integer = 0
Private Shared Sub ApplyValues(This As BattlePrototype)
BattleSystem.BattleScreen.CanRun = This.canRun
BattleSystem.BattleScreen.CanCatch = This.canCatch
BattleSystem.BattleScreen.CanBlackout = This.canBlackout
BattleSystem.BattleScreen.CanReceiveEXP = This.canReceiveExp
BattleSystem.BattleScreen.CanUseItems = This.canUseItems
BattleSystem.BattleScreen.DiveBattle = This.isDiveBattle
BattleSystem.BattleScreen.IsInverseBattle = This.isInverseBattle
BattleSystem.BattleScreen.CustomBattleMusic = This.customBattleMusic
Trainer.FrontierTrainer = This.frontierTrainer
Screen.Level.HiddenAbilityChance = This.hiddenAbilityChance
End Sub
<ScriptFunction(ScriptFunctionType.Standard, VariableName:="reset")>
Public Shared Function Reset(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
objLink.SetMember("canRun", True)
objLink.SetMember("canCatch", True)
objLink.SetMember("canBlackout", True)
objLink.SetMember("canReceiveExp", True)
objLink.SetMember("canUseItems", True)
objLink.SetMember("frontierTrainer", -1)
objLink.SetMember("isDiveBattle", False)
objLink.SetMember("isInverseBattle", False)
objLink.SetMember("customBattleMusic", "")
objLink.SetMember("hiddenAbilityChance", 0)
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Standard, VariableName:="startWild")>
Public Shared Function StartWild(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, {GetType(PokemonPrototype), GetType(String), GetType(Integer)}, 2) Then
Dim helper = New ParamHelper(parameters)
Dim wrapper = helper.Pop(Of PokemonPrototype)
Dim musicLoop As String = helper.Pop("")
Dim introType As Integer = helper.Pop(Core.Random.Next(0, 10))
Dim p = PokemonPrototype.GetPokemon(wrapper)
Dim method As Integer = 0
If Screen.Level.Surfing = True Then
method = 2
End If
Core.Player.PokedexData = Pokedex.ChangeEntry(Core.Player.PokedexData, p.Number, 1)
ApplyValues(CType(This, BattlePrototype))
Dim b As New BattleSystem.BattleScreen(p, Core.CurrentScreen, method)
Core.SetScreen(New BattleIntroScreen(Core.CurrentScreen, b, introType, musicLoop))
ScriptManager.Instance.WaitFrames(1)
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Standard, VariableName:="startTrainer")>
Public Shared Function StartTrainer(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(TrainerPrototype)) Then
Dim wrapper = CType(parameters(0), TrainerPrototype)
Dim t = New Trainer(wrapper.file)
Dim method As Integer = 0
If Screen.Level.Surfing = True Then
method = 2
End If
ApplyValues(CType(This, BattlePrototype))
Dim b As New BattleSystem.BattleScreen(t, Core.CurrentScreen, method)
Core.SetScreen(New BattleIntroScreen(Core.CurrentScreen, b, t, t.GetIniMusicName(), t.IntroType))
ScriptManager.Instance.WaitFrames(1)
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Standard, VariableName:="encounterTrainer")>
Public Shared Function EncounterTrainer(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(TrainerPrototype)) Then
Dim wrapper = CType(parameters(0), TrainerPrototype)
Dim t = New Trainer(wrapper.file)
If Not t.IsBeaten() Then
CType(Core.CurrentScreen, OverworldScreen).TrainerEncountered = True
If t.GetInSightMusic() <> "" And t.GetInSightMusic() <> "nomusic" Then
MusicManager.PlayMusic(t.GetInSightMusic(), True, 0.0F, 0.0F)
End If
If t.IntroMessage <> "" Then
Screen.TextBox.reDelay = 0.0F
Screen.TextBox.Show(t.IntroMessage, {})
End If
ScriptManager.WaitUntil(Function()
Return Not Screen.TextBox.Showing
End Function)
CType(Core.CurrentScreen, OverworldScreen).TrainerEncountered = False
Dim method As Integer = 0
If Screen.Level.Surfing = True Then
method = 2
End If
ApplyValues(CType(This, BattlePrototype))
Dim b As New BattleSystem.BattleScreen(t, Core.CurrentScreen, method)
Core.SetScreen(New BattleIntroScreen(Core.CurrentScreen, b, t, t.GetIniMusicName(), t.IntroType))
Else
Screen.TextBox.reDelay = 0.0F
Screen.TextBox.Show(t.DefeatMessage, {})
ScriptManager.WaitUntil(Function()
Return Not Screen.TextBox.Showing
End Function)
End If
ScriptManager.Instance.WaitFrames(1)
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="wonLast", IsStatic:=True)>
Public Shared Function WonLast(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Return BattleSystem.Battle.Won
End Function
End Class
End Namespace

319
2.5DHero/2.5DHero/World/ActionScript/V3/Prototypes/CameraPrototype.vb Normal file
View File

@ -0,0 +1,319 @@
Option Strict On
Imports Kolben.Adapters
Namespace Scripting.V3.Prototypes
<ScriptPrototype(VariableName:="Camera")>
Friend NotInheritable Class CameraPrototype
Private Shared Function GetCamera() As OverworldCamera
Return CType(Screen.Camera, OverworldCamera)
End Function
Private Shared Sub UpdateCamera(fullUpdate As Boolean)
Dim camera = GetCamera()
camera.UpdateThirdPersonCamera()
If fullUpdate Then
camera.UpdateFrustum()
camera.UpdateViewMatrix()
Screen.Level.Entities = (From e In Screen.Level.Entities Order By e.CameraDistance Descending).ToList()
Screen.Level.UpdateEntities()
End If
End Sub
Private Shared Function ParseFocusType(focusType As String) As OverworldCamera.CameraFocusTypes
Select Case focusType.ToLowerInvariant()
Case "player"
Return OverworldCamera.CameraFocusTypes.Player
Case "npc"
Return OverworldCamera.CameraFocusTypes.NPC
Case "entity"
Return OverworldCamera.CameraFocusTypes.Entity
End Select
Return OverworldCamera.CameraFocusTypes.Player
End Function
<ScriptFunction(ScriptFunctionType.Standard, VariableName:="update", IsStatic:=True)>
Public Shared Function Update(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
UpdateCamera(True)
ScriptManager.Instance.WaitFrames(1)
Return Nothing
End Function
<ScriptFunction(ScriptFunctionType.Standard, VariableName:="setBehindPlayer", IsStatic:=True)>
Public Shared Function SetBehindPlayer(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim facing = Screen.Camera.GetPlayerFacingDirection() * MathHelper.PiOver2
GetCamera().Yaw = facing
UpdateCamera(True)
Return facing
End Function
#Region "Position"
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="position", IsStatic:=True)>
Public Shared Function GetPosition(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim position = GetCamera().ThirdPersonOffset
Return New Vector3Prototype(position)
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="position", IsStatic:=True)>
Public Shared Function SetPosition(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, {GetType(Vector3Prototype)}) Then
Dim camera = GetCamera()
Dim v3 = CType(parameters(0), Vector3Prototype)
camera.ThirdPersonOffset = v3.ToVector3()
UpdateCamera(True)
End If
Return NetUndefined.Instance
End Function
#End Region
#Region "Yaw"
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="yaw", IsStatic:=True)>
Public Shared Function GetYaw(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Return GetCamera().Yaw
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="yaw", IsStatic:=True)>
Public Shared Function SetYaw(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, {TypeContract.Number}) Then
GetCamera().Yaw = CType(parameters(0), Single)
UpdateCamera(True)
End If
Return NetUndefined.Instance
End Function
#End Region
#Region "Pitch"
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="pitch", IsStatic:=True)>
Public Shared Function GetPitch(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Return GetCamera().Pitch
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="pitch", IsStatic:=True)>
Public Shared Function SetPitch(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, {TypeContract.Number}) Then
GetCamera().Pitch = CType(parameters(0), Single)
UpdateCamera(True)
End If
Return NetUndefined.Instance
End Function
#End Region
#Region "X, Y, Z"
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="x", IsStatic:=True)>
Public Shared Function GetX(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Return GetCamera().ThirdPersonOffset.X
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="x", IsStatic:=True)>
Public Shared Function SetX(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, {TypeContract.Number}) Then
GetCamera().ThirdPersonOffset.X = CType(parameters(0), Single)
UpdateCamera(True)
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="y", IsStatic:=True)>
Public Shared Function GetY(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Return GetCamera().ThirdPersonOffset.Y
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="y", IsStatic:=True)>
Public Shared Function SetY(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, {TypeContract.Number}) Then
GetCamera().ThirdPersonOffset.Y = CType(parameters(0), Single)
UpdateCamera(True)
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="z", IsStatic:=True)>
Public Shared Function GetZ(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Return GetCamera().ThirdPersonOffset.Z
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="z", IsStatic:=True)>
Public Shared Function SetZ(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, {TypeContract.Number}) Then
GetCamera().ThirdPersonOffset.Z = CType(parameters(0), Single)
UpdateCamera(True)
End If
Return NetUndefined.Instance
End Function
#End Region
#Region "ThirdPerson"
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="thirdPerson", IsStatic:=True)>
Public Shared Function GetThirdPerson(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Return GetCamera().ThirdPerson
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="thirdPerson", IsStatic:=True)>
Public Shared Function SetThirdPerson(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(Boolean)) Then
GetCamera().SetThirdPerson(CType(parameters(0), Boolean), False)
End If
Return NetUndefined.Instance
End Function
#End Region
#Region "Fixed"
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="fixed", IsStatic:=True)>
Public Shared Function GetFixed(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Return GetCamera().Fixed
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="fixed", IsStatic:=True)>
Public Shared Function SetFixed(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(Boolean)) Then
GetCamera().Fixed = CType(parameters(0), Boolean)
End If
Return NetUndefined.Instance
End Function
#End Region
#Region "Focus"
<ScriptFunction(ScriptFunctionType.Standard, VariableName:="setupFocus", IsStatic:=True)>
Public Shared Function SetupFocus(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, {GetType(String), GetType(Integer)}) Then
Dim helper = New ParamHelper(parameters)
Dim focusTypeStr = helper.Pop(Of String)
Dim focusId = helper.Pop(Of Integer)
GetCamera().SetupFocus(ParseFocusType(focusTypeStr), focusId)
UpdateCamera(True)
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Standard, VariableName:="resetFocus", IsStatic:=True)>
Public Shared Function ResetFocus(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
GetCamera().SetupFocus(OverworldCamera.CameraFocusTypes.Player, -1)
UpdateCamera(True)
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="focusType", IsStatic:=True)>
Public Shared Function SetFocusType(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(String)) Then
GetCamera().CameraFocusType = ParseFocusType(CType(parameters(0), String))
UpdateCamera(True)
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="focusId", IsStatic:=True)>
Public Shared Function SetFocusId(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(Integer)) Then
GetCamera().CameraFocusID = CType(parameters(0), Integer)
UpdateCamera(True)
End If
Return NetUndefined.Instance
End Function
#End Region
End Class
End Namespace

292
2.5DHero/2.5DHero/World/ActionScript/V3/Prototypes/DaycarePrototype.vb Normal file
View File

@ -0,0 +1,292 @@
Option Strict On
Imports Kolben.Adapters
Namespace Scripting.V3.Prototypes
<ScriptPrototype(VariableName:="Daycare")>
Friend NotInheritable Class DaycarePrototype
<ScriptVariable(VariableName:="daycareId")>
Public daycareId As Integer
Public Sub New() : End Sub
Public Sub New(daycareId As Integer)
Me.daycareId = daycareId
End Sub
<ScriptFunction(ScriptFunctionType.Constructor, VariableName:="constructor")>
Public Shared Function Constructor(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(Integer)) Then
objLink.SetMember("daycareId", CType(parameters(0), Integer))
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.IndexerGet, VariableName:="indexerGet")>
Public Shared Function IndexerGet(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim pokemonIndex = CType(parameters(0), Integer)
Dim daycareId = CType(This, DaycarePrototype).daycareId
For Each line As String In Core.Player.DaycareData.SplitAtNewline()
If line.StartsWith(daycareId.ToString() & "|" & pokemonIndex.ToString() & "|") Then
Dim data = line.Remove(0, line.IndexOf("{"))
Dim p = Pokemon.GetPokemonByData(data)
Return New PokemonPrototype(p)
End If
Next
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Standard, VariableName:="getGrownLevels")>
Public Shared Function GetGrownLevels(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, {GetType(Integer)}) Then
Dim pokemonIndex = CType(parameters(0), Integer)
Dim daycareId = CType(This, DaycarePrototype).daycareId
For Each line As String In Core.Player.DaycareData.SplitAtNewline()
If line.StartsWith(daycareId.ToString() & "|" & pokemonIndex.ToString() & "|") Then
Dim data = line.Remove(0, line.IndexOf("{"))
Dim startStep = CInt(line.Split(CChar("|"))(2))
Dim p = Pokemon.GetPokemonByData(data)
Dim startLevel = p.Level
p.GetExperience(Core.Player.DaycareSteps - startStep, True)
Return p.Level - startLevel
End If
Next
End If
Return 0
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="canBreed")>
Public Shared Function GetCanBreed(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim daycareId = CType(This, DaycarePrototype).daycareId
Return Daycare.CanBreed(daycareId)
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="hasEgg")>
Public Shared Function GetHasEgg(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim daycareId = CType(This, DaycarePrototype).daycareId
Return Core.Player.DaycareData.SplitAtNewline().Any(Function(line As String)
Return line.StartsWith(daycareId.ToString() & "|Egg|")
End Function)
End Function
Private Shared Function GetDaycarePokemonCount(daycareId As Integer) As Integer
If Core.Player.DaycareData <> "" Then
Return Core.Player.DaycareData.SplitAtNewline().Count(Function(line As String)
Return line.StartsWith(daycareId.ToString() & "|")
End Function)
End If
Return 0
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="pokemonCount")>
Public Shared Function GetPokemonCount(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim daycareId = CType(This, DaycarePrototype).daycareId
Return GetDaycarePokemonCount(daycareId)
End Function
<ScriptFunction(ScriptFunctionType.Standard, VariableName:="takeEgg")>
Public Shared Function TakeEgg(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim daycareId = CType(This, DaycarePrototype).daycareId
Dim newData As String = ""
Dim eggPokemon As Pokemon = Nothing
For Each line As String In Core.Player.DaycareData.SplitAtNewline()
If line.StartsWith(daycareId.ToString() & "|Egg|") = False Then
If newData <> "" Then
newData &= Environment.NewLine
End If
newData &= line
Else
eggPokemon = Daycare.ProduceEgg(daycareId)
End If
Next
If eggPokemon Is Nothing Then
Return Nothing
Else
Core.Player.DaycareData = newData
Return New PokemonPrototype(eggPokemon)
End If
End Function
<ScriptFunction(ScriptFunctionType.Standard, VariableName:="takePokemon")>
Public Shared Function TakePokemon(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(Integer)) Then
Dim daycareId = CType(This, DaycarePrototype).daycareId
Dim pokemonIndex = CType(parameters(0), Integer)
Dim newData As String = ""
Dim takenPokemon As Pokemon = Nothing
For Each line As String In Core.Player.DaycareData.SplitAtNewline()
If line.StartsWith(daycareId.ToString() & "|" & pokemonIndex.ToString() & "|") = True Then
Dim data As String = line.Remove(0, line.IndexOf("{"))
Dim startStep As Integer = CInt(line.Split(CChar("|"))(2))
takenPokemon = Pokemon.GetPokemonByData(data)
takenPokemon.GetExperience(Core.Player.DaycareSteps - startStep, True)
Else
If newData <> "" Then
newData &= Environment.NewLine
End If
newData &= line
End If
Next
If takenPokemon Is Nothing Then
Return Nothing
Else
Core.Player.DaycareData = newData
Return New PokemonPrototype(takenPokemon)
End If
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Standard, VariableName:="putPokemon")>
Public Shared Function PutPokemon(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, {GetType(Integer), GetType(PokemonPrototype)}) Then
Dim daycareId = CType(This, DaycarePrototype).daycareId
Dim daycareIndex As Integer = CType(parameters(0), Integer)
Dim wrapper = CType(parameters(1), PokemonPrototype)
Dim pokemonData = PokemonPrototype.GetPokemon(wrapper).GetSaveData()
If Core.Player.DaycareData <> "" Then
Core.Player.DaycareData &= Environment.NewLine
End If
Core.Player.DaycareData &= daycareId.ToString() & "|" & daycareIndex.ToString() & "|" & Core.Player.DaycareSteps & "|0|" & pokemonData
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Standard, VariableName:="cleanData")>
Public Shared Function CleanData(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim daycareId = CType(This, DaycarePrototype).daycareId
Dim newData As String = ""
Dim lines As New List(Of String)
For Each line As String In Core.Player.DaycareData.SplitAtNewline()
If line.StartsWith(daycareId & "|") = True Then
lines.Add(line)
Else
If newData <> "" Then
newData &= Environment.NewLine
End If
newData &= line
End If
Next
For i = 0 To lines.Count - 1
Dim line As String = lines(i)
Dim data() As String = line.Split(CChar("|"))
If newData <> "" Then
newData &= Environment.NewLine
End If
If data(1) = "Egg" Then
newData &= daycareId.ToString() & "|Egg|" & data(2)
Else
newData &= daycareId.ToString() & "|" & i.ToString() & "|" & data(2) & "|" & data(3) & "|" & line.Remove(0, line.IndexOf("{"))
End If
Next
Core.Player.DaycareData = newData
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Standard, VariableName:="clear")>
Public Shared Function Clear(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim daycareId = CType(This, DaycarePrototype).daycareId
Dim newData As String = ""
For Each line As String In Core.Player.DaycareData.SplitAtNewline()
If line.StartsWith(daycareId.ToString() & "|") = False Then
If newData <> "" Then
newData &= Environment.NewLine
End If
newData &= line
End If
Next
Core.Player.DaycareData = newData
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Standard, VariableName:="call")>
Public Shared Function CallPhone(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim daycareId = CType(This, DaycarePrototype).daycareId
Daycare.TriggerCall(daycareId)
Return NetUndefined.Instance
End Function
End Class
End Namespace

104
2.5DHero/2.5DHero/World/ActionScript/V3/Prototypes/EntityPrototype.vb Normal file
View File

@ -0,0 +1,104 @@
Option Strict On
Imports Kolben.Adapters
Namespace Scripting.V3.Prototypes
<ScriptPrototype(VariableName:="Entity")>
Friend NotInheritable Class EntityPrototype
<Reference>
Public ref As Entity
Public Shared Function GetEntity(This As Object) As Entity
Return CType(This, EntityPrototype).ref
End Function
#Region "Position"
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="position")>
Public Shared Function GetPosition(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim entity = GetEntity(This)
Return New Vector3Prototype(entity.Position)
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="position")>
Public Shared Function SetPosition(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(Vector3Prototype)) Then
Dim entity = GetEntity(This)
entity.Position = CType(parameters(0), Vector3Prototype).ToVector3()
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="x", IsStatic:=True)>
Public Shared Function GetX(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Return GetEntity(This).Position.X
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="x", IsStatic:=True)>
Public Shared Function SetX(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, {TypeContract.Number}) Then
GetEntity(This).Position.X = CType(parameters(0), Single)
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="y", IsStatic:=True)>
Public Shared Function GetY(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Return GetEntity(This).Position.Y
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="y", IsStatic:=True)>
Public Shared Function SetY(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, {TypeContract.Number}) Then
GetEntity(This).Position.Y = CType(parameters(0), Single)
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="z", IsStatic:=True)>
Public Shared Function GetZ(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Return GetEntity(This).Position.Z
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="z", IsStatic:=True)>
Public Shared Function SetZ(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, {TypeContract.Number}) Then
GetEntity(This).Position.Z = CType(parameters(0), Single)
End If
Return NetUndefined.Instance
End Function
#End Region
End Class
End Namespace

51
2.5DHero/2.5DHero/World/ActionScript/V3/Prototypes/ItemPrototype.vb Normal file
View File

@ -0,0 +1,51 @@
Option Strict On
Imports Kolben.Adapters
Namespace Scripting.V3.Prototypes
<ScriptPrototype(VariableName:="Item")>
Friend NotInheritable Class ItemPrototype
<Reference>
Public ref As Item
Public Shared Function ToItem(This As Object) As Item
Return CType(This, ItemPrototype).ref
End Function
Public Sub New() : End Sub
Public Sub New(item As Item)
ref = item
End Sub
<ScriptFunction(ScriptFunctionType.Constructor, VariableName:="constructor")>
Public Shared Function Constructor(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, {GetType(Integer), GetType(String)}, 1) Then
Dim helper = New ParamHelper(parameters)
Dim itemRef = Item.GetItemByID(helper.Pop(Of Integer))
itemRef.AdditionalData = helper.Pop("")
objLink.SetReference(NameOf(ref), itemRef)
ElseIf TypeContract.Ensure(parameters, {GetType(String), GetType(String)}, 1) Then
Dim helper = New ParamHelper(parameters)
Dim itemRef = Item.GetItemByName(helper.Pop(Of String))
itemRef.AdditionalData = helper.Pop("")
objLink.SetReference(NameOf(ref), itemRef)
End If
Return NetUndefined.Instance
End Function
End Class
End Namespace

94
2.5DHero/2.5DHero/World/ActionScript/V3/Prototypes/MovePrototype.vb Normal file
View File

@ -0,0 +1,94 @@
Option Strict On
Imports Kolben.Adapters
Imports net.Pokemon3D.Game.BattleSystem
Namespace Scripting.V3.Prototypes
<ScriptPrototype(VariableName:="Move")>
Friend NotInheritable Class MovePrototype
<Reference>
Public ref As Attack
Public Shared Function GetAttack(This As Object) As Attack
Return CType(This, MovePrototype).ref
End Function
Public Sub New() : End Sub
Public Sub New(a As Attack)
ref = a
End Sub
<ScriptFunction(ScriptFunctionType.Constructor, VariableName:="constructor")>
Public Shared Function Constructor(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(Integer)) Then
objLink.SetMember("id", CType(parameters(0), Integer))
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="name")>
Public Shared Function GetName(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim attack = GetAttack(This)
Return attack.Name
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="pp")>
Public Shared Function GetPP(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim attack = GetAttack(This)
Return attack.CurrentPP
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="maxPP")>
Public Shared Function GetMaxPP(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim attack = GetAttack(This)
Return attack.MaxPP
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="id")>
Public Shared Function GetId(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim attack = GetAttack(This)
Return attack.ID
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="category")>
Public Shared Function GetCategory(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim attack = GetAttack(This)
Return attack.Category.ToString()
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="description")>
Public Shared Function GetDescription(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim attack = GetAttack(This)
Return attack.Description
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="type")>
Public Shared Function GetElementType(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim attack = GetAttack(This)
Return attack.Type.Type.ToString()
End Function
End Class
End Namespace

763
2.5DHero/2.5DHero/World/ActionScript/V3/Prototypes/PokemonPrototype.vb Normal file
View File

@ -0,0 +1,763 @@
Option Strict On
Imports Kolben.Adapters
Namespace Scripting.V3.Prototypes
<ScriptPrototype(VariableName:="Pokemon")>
Friend NotInheritable Class PokemonPrototype
<Reference>
Public ref As Pokemon
Public Shared Function GetPokemon(This As Object) As Pokemon
Return CType(This, PokemonPrototype).ref
End Function
Public Sub New() : End Sub
Public Sub New(p As Pokemon)
ref = p
End Sub
<ScriptFunction(ScriptFunctionType.Constructor, VariableName:="constructor")>
Public Shared Function Constructor(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If parameters.Length = 1 AndAlso TypeContract.Ensure(parameters, GetType(String)) Then
Dim p = Pokemon.GetPokemonByData(CType(parameters(0), String))
ElseIf parameters.Length >= 2 AndAlso TypeContract.Ensure(parameters, {GetType(Integer), GetType(Integer), GetType(String)}, 1) Then
Dim helper = New ParamHelper(parameters)
Dim id = helper.Pop(Of Integer)
Dim level = helper.Pop(Of Integer)
Dim additionalData = helper.Pop("")
Dim p = Pokemon.GetPokemonByID(id, additionalData)
Dim exp = p.NeedExperience(level)
p.GetExperience(exp, True)
objLink.SetMember("data", p.GetSaveData())
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Standard, VariableName:="getLegendaryIds", IsStatic:=True)>
Public Shared Function GetLegendaryIds(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Return Pokemon.Legendaries
End Function
<ScriptFunction(ScriptFunctionType.Standard, VariableName:="getSprite")>
Public Shared Function GetOverworldSprite(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
Return $"[POKEMON|{If(p.IsShiny, "S", "N")}]{p.Number.ToString()}{PokemonForms.GetOverworldAddition(p)}"
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="id")>
Public Shared Function GetId(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
Return p.Number
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="name")>
Public Shared Function GetName(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
Return p.OriginalName
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="translatedName")>
Public Shared Function GetTranslatedName(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
Return p.GetName()
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="nickname")>
Public Shared Function GetNickname(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
Return p.NickName
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="nickname")>
Public Shared Function SetNickname(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(String)) Then
Dim p = GetPokemon(This)
p.NickName = CType(parameters(0), String)
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="displayName")>
Public Shared Function GetDisplayName(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
Return p.GetDisplayName()
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="isShiny")>
Public Shared Function GetIsShiny(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
Return p.IsShiny
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="isShiny")>
Public Shared Function SetIsShiny(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(Boolean)) Then
Dim p = GetPokemon(This)
p.IsShiny = CType(parameters(0), Boolean)
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="canSwim")>
Public Shared Function GetCanSwim(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
Return p.CanSwim
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="level")>
Public Shared Function GetLevel(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
Return p.Level
End Function
<ScriptFunction(ScriptFunctionType.Standard, VariableName:="cry")>
Public Shared Function PlayCry(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
p.PlayCry()
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="additionalData")>
Public Shared Function GetAdditionalData(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
Return p.AdditionalData
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="additionalData")>
Public Shared Function SetAdditionalData(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(String)) Then
Dim p = GetPokemon(This)
p.AdditionalData = CType(parameters(0), String)
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="isEgg")>
Public Shared Function GetIsEgg(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
Return p.IsEgg()
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="nature")>
Public Shared Function GetNature(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
Return p.Nature.ToString()
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="nature")>
Public Shared Function SetNature(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(Integer)) Then
Dim p = GetPokemon(This)
p.Nature = Pokemon.ConvertIDToNature(CType(parameters(0), Integer))
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="friendship")>
Public Shared Function GetFriendship(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
Return p.Friendship
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="friendship")>
Public Shared Function SetFriendship(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(Integer)) Then
Dim p = GetPokemon(This)
p.Friendship = CType(parameters(0), Integer)
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="ot")>
Public Shared Function GetOT(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
Return p.OT
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="ot")>
Public Shared Function SetOT(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(String)) Then
Dim p = GetPokemon(This)
p.OT = CType(parameters(0), String)
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="catchTrainer")>
Public Shared Function GetCatchTrainer(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
Return p.CatchTrainerName
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="catchTrainer")>
Public Shared Function SetCatchTrainer(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(String)) Then
Dim p = GetPokemon(This)
p.CatchTrainerName = CType(parameters(0), String)
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="catchMethod")>
Public Shared Function GetCatchMethod(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
Return p.CatchMethod
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="catchMethod")>
Public Shared Function SetCatchMethod(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(String)) Then
Dim p = GetPokemon(This)
p.CatchMethod = CType(parameters(0), String)
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="catchLocation")>
Public Shared Function GetCatchLocation(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
Return p.CatchLocation
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="catchLocation")>
Public Shared Function SetCatchLocation(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(String)) Then
Dim p = GetPokemon(This)
p.CatchLocation = CType(parameters(0), String)
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="catchBall")>
Public Shared Function GetCatchBall(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
Return New ItemPrototype(p.CatchBall)
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="catchBall")>
Public Shared Function SetCatchBall(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(ItemPrototype)) Then
Dim p = GetPokemon(This)
p.CatchBall = ItemPrototype.ToItem(parameters(0))
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="item")>
Public Shared Function GetItem(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
If p.Item IsNot Nothing Then
Return New ItemPrototype(p.Item)
Else
Return Nothing
End If
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="item")>
Public Shared Function SetItem(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(ItemPrototype)) Then
Dim p = GetPokemon(This)
If parameters(0) Is Nothing Then
p.Item = Nothing
Else
Dim item = CType(parameters(0), ItemPrototype)
p.Item = ItemPrototype.ToItem(item)
End If
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="gender")>
Public Shared Function GetGender(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
Return p.Gender
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="gender")>
Public Shared Function SetGender(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(String)) Then
Dim p = GetPokemon(This)
Dim newGender As Pokemon.Genders
If [Enum].TryParse(CType(parameters(0), String), newGender) Then
p.Gender = newGender
End If
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="ability")>
Public Shared Function GetAbility(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
Return New AbilityPrototype(p.Ability)
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="ability")>
Public Shared Function SetAbility(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(AbilityPrototype)) Then
Dim p = GetPokemon(This)
p.Ability = AbilityPrototype.GetAbility(parameters(0))
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="types")>
Public Shared Function GetTypes(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
If p.Type2.Type = Element.Types.Blank Then
Return {p.Type1.Type.ToString()}
Else
Return {p.Type1.Type.ToString(), p.Type2.Type.ToString()}
End If
End Function
#Region "Stats"
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="stats")>
Public Shared Function GetStats(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
Return New With
{
.hp = p.HP,
.maxHp = p.MaxHP,
.atk = p.Attack,
.def = p.Defense,
.spAtk = p.SpAttack,
.spDef = p.SpDefense,
.speed = p.Speed
}
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="EVs")>
Public Shared Function GetEVs(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
Return New With
{
.hp = p.EVHP,
.atk = p.EVAttack,
.def = p.EVDefense,
.spAtk = p.EVSpAttack,
.spDef = p.EVSpDefense,
.speed = p.EVSpeed
}
End Function
<ScriptFunction(ScriptFunctionType.Standard, VariableName:="setEV")>
Public Shared Function SetEV(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, {GetType(String), GetType(Integer)}) Then
Dim p = GetPokemon(This)
Dim evType = CType(parameters(0), String).ToLowerInvariant()
Dim evValue = CType(parameters(1), Integer)
Select Case evType.ToLower()
Case "hp"
p.EVHP = evValue
Case "atk"
p.EVAttack = evValue
Case "def"
p.EVDefense = evValue
Case "spatk"
p.EVSpAttack = evValue
Case "spdef"
p.EVSpDefense = evValue
Case "speed"
p.EVSpeed = evValue
End Select
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Standard, VariableName:="setIV")>
Public Shared Function SetIV(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, {GetType(String), GetType(Integer)}) Then
Dim p = GetPokemon(This)
Dim ivType = CType(parameters(0), String).ToLowerInvariant()
Dim ivValue = CType(parameters(1), Integer)
Select Case ivType.ToLower()
Case "hp"
p.IVHP = ivValue
Case "atk"
p.IVAttack = ivValue
Case "def"
p.IVDefense = ivValue
Case "spatk"
p.IVSpAttack = ivValue
Case "spdef"
p.IVSpDefense = ivValue
Case "speed"
p.IVSpeed = ivValue
End Select
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="giveEVs")>
Public Shared Function GetGiveEVs(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
Return New With
{
.hp = p.GiveEVHP,
.atk = p.GiveEVAttack,
.def = p.GiveEVDefense,
.spAtk = p.GiveEVSpAttack,
.spDef = p.GiveEVSpDefense,
.speed = p.GiveEVSpeed
}
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="IVs")>
Public Shared Function GetIVs(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
Return New With
{
.hp = p.IVHP,
.atk = p.IVAttack,
.def = p.IVDefense,
.spAtk = p.IVSpAttack,
.spDef = p.IVSpDefense,
.speed = p.IVSpeed
}
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="hp")>
Public Shared Function GetHP(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
Return p.HP
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="hp")>
Public Shared Function SetHP(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(Integer)) Then
Dim p = GetPokemon(This)
p.HP = CType(parameters(0), Integer)
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="exp")>
Public Shared Function GetExp(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
Return p.Experience
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="exp")>
Public Shared Function SetExp(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(Integer)) Then
Dim p = GetPokemon(This)
p.Experience = CType(parameters(0), Integer)
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="heal")>
Public Shared Function Heal(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(Integer), 1) Then
Dim p = GetPokemon(This)
Dim hp = New ParamHelper(parameters).Pop(p.MaxHP)
p.Heal(hp)
End If
Return NetUndefined.Instance
End Function
#End Region
#Region "Moves"
<ScriptFunction(ScriptFunctionType.Standard, VariableName:="getMoves")>
Public Shared Function GetMoves(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
Return p.Attacks.Select(Function(a As BattleSystem.Attack)
Return New MovePrototype(a)
End Function).ToArray()
End Function
<ScriptFunction(ScriptFunctionType.Standard, VariableName:="removeMoveAt")>
Public Shared Function RemoveMoveAt(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(Integer)) Then
Dim p = GetPokemon(This)
Dim moveIndex = CType(parameters(0), Integer)
If p.Attacks.Count > moveIndex Then
p.Attacks.RemoveAt(moveIndex)
End If
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Standard, VariableName:="clearMoves")>
Public Shared Function ClearMoves(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
p.Attacks.Clear()
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Standard, VariableName:="addMove")>
Public Shared Function AddMove(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(MovePrototype)) Then
Dim p = GetPokemon(This)
If p.Attacks.Count < 4 Then
Dim move = CType(parameters(0), MovePrototype)
p.Attacks.Add(MovePrototype.GetAttack(move))
End If
End If
Return NetUndefined.Instance
End Function
#End Region
<ScriptFunction(ScriptFunctionType.Standard, VariableName:="reload")>
Public Shared Function ReloadDefinitions(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
p.ReloadDefinitions()
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="status")>
Public Shared Function GetStatus(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim p = GetPokemon(This)
Return p.Status
End Function
<ScriptFunction(ScriptFunctionType.Setter, VariableName:="status")>
Public Shared Function SetStatus(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(String)) Then
Dim p = GetPokemon(This)
Dim newStatus As Pokemon.StatusProblems
If [Enum].TryParse(CType(parameters(0), String), newStatus) Then
p.Status = newStatus
End If
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Standard, VariableName:="canEvolve")>
Public Shared Function CanEvolve(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, GetType(String)) Then
Dim helper = New ParamHelper(parameters)
Dim triggerStr = helper.Pop("LevelUp")
Dim trigger As EvolutionCondition.EvolutionTrigger
If Not [Enum].TryParse(triggerStr, trigger) Then
trigger = EvolutionCondition.EvolutionTrigger.LevelUp
End If
Dim evolutionArg = helper.Pop("")
Dim p = GetPokemon(This)
Return p.CanEvolve(trigger, evolutionArg)
End If
Return False
End Function
End Class
End Namespace

64
2.5DHero/2.5DHero/World/ActionScript/V3/Prototypes/TrainerProtoype.vb Normal file
View File

@ -0,0 +1,64 @@
Option Strict On
Imports Kolben.Adapters
Namespace Scripting.V3.Prototypes
<ScriptPrototype(VariableName:="Trainer")>
Friend NotInheritable Class TrainerPrototype
<ScriptVariable(VariableName:="file")>
Public file As String = ""
Public Sub New() : End Sub
Public Sub New(file As String)
Me.file = file
End Sub
<ScriptFunction(ScriptFunctionType.Constructor, VariableName:="constructor")>
Public Shared Function Constructor(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, {GetType(String)}) Then
Dim trainerFile = CType(parameters(0), String)
objLink.SetMember("file", trainerFile)
End If
Return NetUndefined.Instance
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="defeatMessage")>
Public Shared Function GetDefeatMessage(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim wrapper = CType(This, TrainerPrototype)
Dim trainer = New Trainer(wrapper.file)
Return trainer.DefeatMessage
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="introMessage")>
Public Shared Function GetIntroMessage(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim wrapper = CType(This, TrainerPrototype)
Dim trainer = New Trainer(wrapper.file)
Return trainer.IntroMessage
End Function
<ScriptFunction(ScriptFunctionType.Getter, VariableName:="outroMessage")>
Public Shared Function GetOutroMessage(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
Dim wrapper = CType(This, TrainerPrototype)
Dim trainer = New Trainer(wrapper.file)
Return trainer.OutroMessage
End Function
End Class
End Namespace

80
2.5DHero/2.5DHero/World/ActionScript/V3/Prototypes/TypeContract.vb Normal file
View File

@ -0,0 +1,80 @@
Option Strict On
Namespace Scripting.V3.Prototypes
Friend Class TypeContract
Public Shared Function Ensure(objects As Object(), typeContract As Type, Optional optionalCount As Integer = 0) As Boolean
Return Ensure(objects, {typeContract}, optionalCount)
End Function
Public Shared Function Ensure(objects As Object(), typeContract As Type(), Optional optionalCount As Integer = 0) As Boolean
If optionalCount > typeContract.Length Then
Throw New ArgumentOutOfRangeException(NameOf(optionalCount))
End If
If objects.Length + optionalCount < typeContract.Length Then
Return False
End If
Return Not typeContract.Where(Function(t As Type, i As Integer)
If t Is Nothing Then
Return False
End If
If objects.Length <= i Then
Return i < typeContract.Length - optionalCount
End If
Return objects(i) IsNot Nothing AndAlso objects(i).GetType() <> t
End Function).Any()
End Function
Public Shared Function Ensure(objects As Object(), typeContract As Type()(), Optional optionalCount As Integer = 0) As Boolean
If optionalCount > typeContract.Length Then
Throw New ArgumentOutOfRangeException(NameOf(optionalCount))
End If
If objects.Length + optionalCount < typeContract.Length Then
Return False
End If
Return Not typeContract.Where(Function(types As Type(), i As Integer)
If types Is Nothing OrElse types.Length = 0 Then
Return False
End If
If objects.Length <= i Then
Return i < typeContract.Length - optionalCount
End If
If objects(i) IsNot Nothing Then
For Each t As Type In types
If objects(i).GetType() = t Then
Return False
End If
Next
Return True
Else
Return False
End If
End Function).Any()
End Function
Private Shared _numberBuffer As Type()
Public Shared ReadOnly Property Number() As Type()
Get
If _numberBuffer Is Nothing Then
_numberBuffer = {GetType(Double), GetType(Integer)}
End If
Return _numberBuffer
End Get
End Property
End Class
End Namespace

55
2.5DHero/2.5DHero/World/ActionScript/V3/Prototypes/Vector3Prototype.vb Normal file
View File

@ -0,0 +1,55 @@
Option Strict On
Imports Kolben.Adapters
Namespace Scripting.V3.Prototypes
<ScriptPrototype(VariableName:="Vector3")>
Friend NotInheritable Class Vector3Prototype
Public Function ToVector3() As Vector3
Return New Vector3(CType(x, Single), CType(y, Single), CType(z, Single))
End Function
<ScriptVariable(VariableName:="x")>
Public x As Double = 0D
<ScriptVariable(VariableName:="y")>
Public y As Double = 0D
<ScriptVariable(VariableName:="z")>
Public z As Double = 0D
Public Sub New() : End Sub
Public Sub New(x As Double, y As Double, z As Double)
Me.x = x
Me.y = y
Me.z = z
End Sub
Public Sub New(v As Vector3)
x = v.X
y = v.Y
z = v.Z
End Sub
<ScriptFunction(ScriptFunctionType.Constructor, VariableName:="constructor")>
Public Shared Function Constructor(This As Object, objLink As ScriptObjectLink, parameters As Object()) As Object
If TypeContract.Ensure(parameters, {TypeContract.Number, TypeContract.Number, TypeContract.Number}, 3) Then
Dim helper = New ParamHelper(parameters)
objLink.SetMember("x", helper.Pop(0D))
objLink.SetMember("y", helper.Pop(0D))
objLink.SetMember("z", helper.Pop(0D))
End If
Return NetUndefined.Instance
End Function
End Class
End Namespace

11
2.5DHero/2.5DHero/World/ActionScript/V3/ScriptInputType.vb Normal file
View File

@ -0,0 +1,11 @@
Namespace Scripting.V3
Friend Enum ScriptInputType
File
Text
Raw
End Enum
End Namespace

234
2.5DHero/2.5DHero/World/ActionScript/V3/ScriptManager.vb Normal file
View File

@ -0,0 +1,234 @@
Imports System.Reflection
Imports System.Threading
Imports System.Threading.Tasks
Imports Kolben
Imports Kolben.Adapters
Imports Kolben.Types
Imports net.Pokemon3D.Game.Scripting.V3.ApiClasses
Namespace Scripting.V3
Friend Class ScriptManager
#Region "Singleton"
Private Sub New()
' Set constructor to private to not allow instances.
End Sub
Private Shared _instance As ScriptManager
Public Shared ReadOnly Property Instance As ScriptManager
Get
If _instance Is Nothing Then
_instance = New ScriptManager()
End If
Return _instance
End Get
End Property
#End Region
Private _reDelay As Single = 0.0F
Private _scriptName As String
Private _activeProcessorCount As Integer = 0
Private _unlockCamera As Boolean = False
Private _waitFrames As Integer = 0
Private _prototypeBuffer As List(Of SObject)
Private _apiClasses As Dictionary(Of String, MethodInfo())
Public Property IsInSightScript As Boolean
Public ReadOnly Property IsActive As Boolean
Get
Return _activeProcessorCount > 0
End Get
End Property
Public Sub StartScript(input As String, inputType As ScriptInputType, flags As ScriptStartFlag)
Dim skipDelayCheck As Boolean = flags.HasFlag(ScriptStartFlag.SkipDelayCheck)
Dim resetInSight = flags.HasFlag(ScriptStartFlag.ResetInSight)
If resetInSight Then
IsInSightScript = False
End If
If skipDelayCheck OrElse _reDelay = 0.0F Then
Select Case inputType
Case ScriptInputType.File
StartScriptFromFile(input)
Case ScriptInputType.Text
StartScriptFromText(input)
Case ScriptInputType.Raw
StartScriptFromRaw(input)
End Select
End If
_reDelay = 1.0F
End Sub
Private Sub StartScriptFromFile(input As String)
Logger.Debug($"Start script (ID: {input})")
_scriptName = $"Type: Script; Input: {input}"
Dim path As String = GameModeManager.GetScriptPath($"{input}.dat")
Security.FileValidation.CheckFileValid(path, False, "ActionScript.vb")
If File.Exists(path) Then
Dim source = File.ReadAllText(path)
RunScript(source)
Else
Logger.Log(Logger.LogTypes.ErrorMessage, $"ActionScript.vb: The script file ""{path}"" doesn't exist!")
End If
End Sub
Private Sub StartScriptFromText(input As String)
Logger.Debug($"Start Script (Text: {input})")
_scriptName = $"Type: Text; Input: {input}"
' Sanitize text
input = input.Replace("""", "\""")
Dim source As String = $"import Text from ""Text"";Text.show(""{input}"");"
RunScript(source)
End Sub
Private Sub StartScriptFromRaw(input As String)
Dim activator As String = Environment.StackTrace.Split(Environment.NewLine)(3)
activator = activator.Remove(activator.IndexOf("("))
Logger.Debug($"Start Script (DirectInput; {activator})")
_scriptName = $"Type: Direct; Input: {input}"
Dim source As String = input
RunScript(source)
End Sub
Private Sub RunScript(source As String)
_unlockCamera = True
_activeProcessorCount += 1
Task.Run(Sub()
Try
Dim processor = CreateProcessor()
Dim result = processor.Run(source)
If ScriptContextManipulator.ThrownRuntimeError(processor) Then
Dim exObj = ScriptOutAdapter.Translate(result)
Dim runtimeException = TryCast(exObj, ScriptRuntimeException)
If runtimeException IsNot Nothing Then
Throw runtimeException
End If
End If
Catch ex As ScriptRuntimeException
Logger.Log(Logger.LogTypes.ErrorMessage, $"Script execution failed at runtime. {ex.Type} (L{ex.Line}: {ex.Message})")
End Try
_activeProcessorCount -= 1
End Sub)
End Sub
Private Function CreateProcessor() As ScriptProcessor
If _prototypeBuffer Is Nothing Then
InitializePrototypeBuffer()
End If
Dim processor = New ScriptProcessor(_prototypeBuffer)
ScriptContextManipulator.SetCallbackExecuteMethod(processor, AddressOf ExecuteMethod)
Return processor
End Function
Private Function ExecuteMethod(processor As ScriptProcessor, className As String, methodName As String, parameters As SObject()) As SObject
If _apiClasses Is Nothing Then
InitializeApiClasses()
End If
If _apiClasses.ContainsKey(className) Then
Dim method = _apiClasses(className).FirstOrDefault(Function(m As MethodInfo)
Return m.Name = methodName
End Function)
If method IsNot Nothing Then
Dim result = method.Invoke(Nothing, New Object() {processor, parameters})
Return TryCast(result, SObject)
End If
End If
Return ScriptInAdapter.GetUndefined(processor)
End Function
Private Sub InitializePrototypeBuffer()
_prototypeBuffer = New List(Of SObject)()
Dim processor = New ScriptProcessor()
For Each o As Type In GetType(ScriptManager).Assembly.GetTypes().Where(Function(t As Type)
Return t.GetCustomAttributes(GetType(ScriptPrototypeAttribute), True).Length > 0
End Function)
_prototypeBuffer.Add(ScriptInAdapter.Translate(processor, o))
Next
End Sub
Private Sub InitializeApiClasses()
_apiClasses = New Dictionary(Of String, MethodInfo())()
For Each o As Type In GetType(ScriptManager).Assembly.GetTypes().Where(Function(t As Type)
Return t.IsSubclassOf(GetType(ApiClass)) AndAlso
t.GetCustomAttributes(GetType(ApiClassAttribute), True).Length > 0
End Function)
Dim attr = CType(o.GetCustomAttribute(GetType(ApiClassAttribute)), ApiClassAttribute)
Dim methods = o.GetMethods(BindingFlags.Public Or BindingFlags.Static).Where(Function(m As MethodInfo)
Return m.GetCustomAttributes(GetType(ApiClassMethodAttribute), True).Length > 0
End Function).ToArray()
If methods.Length > 0 Then
_apiClasses.Add(attr.ClassName, methods)
End If
Next
End Sub
Public Sub Update()
If _waitFrames > 0 Then
_waitFrames -= 1
End If
If Not IsActive Then
If _unlockCamera Then
_unlockCamera = False
Logger.Debug("Unlock Camera")
CType(Screen.Camera, OverworldCamera).YawLocked = False
CType(Screen.Camera, OverworldCamera).ResetCursor()
End If
If _reDelay > 0.0F Then
_reDelay -= 0.1F
If _reDelay <= 0.0F Then
_reDelay = 0.0F
End If
End If
End If
End Sub
Public Shared Sub WaitUntil(condition As Func(Of Boolean))
SpinWait.SpinUntil(condition)
End Sub
Public Sub WaitFrames(Optional frames As Integer = 1)
_waitFrames += frames
SpinWait.SpinUntil(Function()
Return _waitFrames = 0
End Function)
End Sub
End Class
End Namespace

12
2.5DHero/2.5DHero/World/ActionScript/V3/ScriptStartFlag.vb Normal file
View File

@ -0,0 +1,12 @@
Namespace Scripting.V3
<Flags>
Friend Enum ScriptStartFlag
None = 0
SkipDelayCheck = 1
ResetInSight = 2
End Enum
End Namespace