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
P3D-Legacy/P3D/Screens/PC/StorageSystemScreen.vb

2577 lines
100 KiB
VB.net
Raw Blame History

Public Class StorageSystemScreen
Inherits Screen
Public Shared TileOffset As Integer = 0
Private renderTarget As RenderTarget2D
Public Enum FeatureTypes
Deposit
Withdraw
Organize
End Enum
Public Enum SelectionModes
SingleMove
EasyMove
ItemMove
Withdraw
Deposit
End Enum
Private Enum CursorModes
Selection
Box
End Enum
Public Enum FilterTypes
Pokémon
Type1
Type2
Move
Ability
Nature
Gender
HeldItem
End Enum
Public FeatureType As FeatureTypes = FeatureTypes.Organize
Public SelectionMode As SelectionModes = SelectionModes.SingleMove
Public Structure Filter
Public FilterType As FilterTypes
Public FilterValue As String
End Structure
Public Filters As New List(Of Filter)
Dim CursorMode As CursorModes = CursorModes.Selection
Dim CursorPosition As Vector2
Dim CursorMovePosition As Vector2 = New Vector2(0)
Dim CursorAimPosition As Vector2 = New Vector2(0)
Dim CursorMoving As Boolean = False
Dim CursorSpeed As Integer = 0
Dim MovingPokemon As Pokemon = Nothing
Dim PickupPlace As Vector2 = New Vector2(1)
Dim PickupBox As Integer = 0
Dim texture As Texture2D
Dim menuTexture As Texture2D
Dim MenuEntries As New List(Of MenuEntry)
Dim MenuVisible As Boolean = False
Dim MenuCursor As Integer = 0
Dim MenuHeader As String = ""
Dim BoxChooseMode As Boolean = False
Dim Boxes As New List(Of Box)
Dim CurrentBox As Integer = 0
Dim modelRoll As Single = 0.0F
Dim modelPan As Single = 0.0F
Public Sub New(ByVal currentScreen As Screen)
Me.renderTarget = New RenderTarget2D(Core.GraphicsDevice, 1200, 680, False, SurfaceFormat.Color, DepthFormat.Depth24Stencil8)
Me.PreScreen = currentScreen
Me.Identification = Identifications.StorageSystemScreen
Me.MouseVisible = True
Me.CanBePaused = True
Me.CanChat = True
Me.CanMuteMusic = True
Me.texture = TextureManager.GetTexture("GUI\Box\storage")
Me.menuTexture = TextureManager.GetTexture("GUI\Menus\General")
LoadScreen()
End Sub
Private Shared Function LoadBoxes() As List(Of Box)
Dim boxes As New List(Of Box)
For i = 0 To Core.Player.BoxAmount - 1
boxes.Add(New Box(i))
Next
For Each line As String In Core.Player.BoxData.SplitAtNewline()
If line.StartsWith("BOX") = False And line <> "" Then
Dim Data() As String = line.Split(CChar(","))
Dim boxIndex As String = Data(0)
Dim pokemonIndex As String = Data(1)
Dim pokemonData As String = line.Remove(0, line.IndexOf("{"))
If GetBox(CInt(boxIndex), boxes) Is Nothing Then
boxes.Add(New Box(CInt(boxIndex)))
End If
If GetBox(CInt(boxIndex), boxes).Pokemon.ContainsKey(CInt(pokemonIndex)) = False Then
GetBox(CInt(boxIndex), boxes).Pokemon.Add(CInt(pokemonIndex), New PokemonWrapper(pokemonData)) ' Pokemon.GetPokemonByData(pokemonData))
End If
ElseIf line.StartsWith("BOX") = True Then
Dim boxData() As String = line.Split(CChar("|"))
Dim boxIndex As Integer = CInt(boxData(1))
Dim boxName As String = boxData(2)
Dim boxBackground As Integer = CInt(boxData(3))
If GetBox(boxIndex, boxes) Is Nothing Then
boxes.Add(New Box(boxIndex))
End If
GetBox(boxIndex, boxes).Background = boxBackground
GetBox(boxIndex, boxes).Name = boxName
End If
Next
Dim minBox As Integer = -1
Dim maxBox As Integer = -1
For Each b As Box In boxes
If b.index < minBox Or minBox = -1 Then
minBox = b.index
End If
If b.index > maxBox Or maxBox = -1 Then
maxBox = b.index
End If
Next
For i = minBox To maxBox
If GetBox(i, boxes) Is Nothing Then
boxes.Add(New Box(i))
End If
Next
Dim lastBox As Box = boxes(0)
For Each b As Box In boxes
If b.index > lastBox.index Then
lastBox = b
End If
Next
lastBox.IsBattleBox = True
Return boxes
End Function
Private Sub LoadScreen()
SelectionMode = Player.Temp.PCSelectionType
CursorMode = CursorModes.Selection
CursorPosition = Player.Temp.StorageSystemCursorPosition
Me.Boxes = LoadBoxes()
Me.CurrentBox = Player.Temp.PCBoxIndex
Me.BoxChooseMode = Player.Temp.PCBoxChooseMode
End Sub
#Region "Update"
Public Overrides Sub Update()
If ControllerHandler.ButtonPressed(Buttons.Y) = True Or KeyBoardHandler.KeyPressed(KeyBindings.SpecialKey) = True Then
Core.SetScreen(New StorageSystemFilterScreen(Me))
End If
If MenuVisible = True Then
For i = 0 To Me.MenuEntries.Count - 1
If i <= Me.MenuEntries.Count - 1 Then
Dim m As MenuEntry = Me.MenuEntries(i)
m.Update(Me)
End If
Next
If Controls.Up(True, True) = True Then
Me.MenuCursor -= 1
End If
If Controls.Down(True, True) = True Then
Me.MenuCursor += 1
End If
Dim maxIndex As Integer = 0
Dim minIndex As Integer = 100
For Each e As MenuEntry In Me.MenuEntries
If e.Index < minIndex Then
minIndex = e.Index
End If
If e.Index > maxIndex Then
maxIndex = e.Index
End If
Next
If Me.MenuCursor > maxIndex Then
Me.MenuCursor = minIndex
ElseIf Me.MenuCursor < minIndex Then
Me.MenuCursor = maxIndex
End If
Else
TurnModel()
If CursorMoving = True Then
MoveCursor()
Else
If ControllerHandler.ButtonPressed(Buttons.RightShoulder) = True Or Controls.Right(True, False, True, False, False, False) = True Then
Me.CurrentBox += 1
If CurrentBox > Me.Boxes.Count - 1 Then
CurrentBox = 0
End If
End If
If ControllerHandler.ButtonPressed(Buttons.LeftShoulder) = True Or Controls.Left(True, False, True, False, False, False) = True Then
Me.CurrentBox -= 1
If CurrentBox < 0 Then
CurrentBox = Me.Boxes.Count - 1
End If
End If
PressNumberButtons()
If GetRelativeMousePosition() <> New Vector2(-1) AndAlso GetRelativeMousePosition() = CursorPosition AndAlso Controls.Accept(True, False, False) = True Then
ChooseObject()
End If
ControlCursor()
If Controls.Accept(False, True, True) = True Then
ChooseObject()
End If
If Controls.Dismiss(True, True, True) = True Then
CloseScreen()
End If
End If
End If
StorageSystemScreen.TileOffset += 1
If StorageSystemScreen.TileOffset >= 64 Then
StorageSystemScreen.TileOffset = 0
End If
End Sub
Private Sub TurnModel()
If Controls.ShiftDown("L", False) = True Then
modelRoll -= 0.1F
End If
If ControllerHandler.ButtonDown(Buttons.RightThumbstickLeft) = True Then
Dim gPadState As GamePadState = GamePad.GetState(PlayerIndex.One)
modelRoll -= gPadState.ThumbSticks.Right.X * 0.1F
End If
If ControllerHandler.ButtonDown(Buttons.RightThumbstickRight) = True Then
Dim gPadState As GamePadState = GamePad.GetState(PlayerIndex.One)
modelRoll -= gPadState.ThumbSticks.Right.X * 0.1F
End If
If Controls.ShiftDown("R", False) = True Then
modelRoll += 0.1F
End If
End Sub
Private Sub PressNumberButtons()
Dim switchTo As Integer = -1
If KeyBoardHandler.KeyPressed(Keys.D1) = True Then
switchTo = 0
End If
If KeyBoardHandler.KeyPressed(Keys.D2) = True Then
switchTo = 1
End If
If KeyBoardHandler.KeyPressed(Keys.D3) = True Then
switchTo = 2
End If
If KeyBoardHandler.KeyPressed(Keys.D4) = True Then
switchTo = 3
End If
If KeyBoardHandler.KeyPressed(Keys.D5) = True Then
switchTo = 4
End If
If KeyBoardHandler.KeyPressed(Keys.D6) = True Then
switchTo = 5
End If
If KeyBoardHandler.KeyPressed(Keys.D7) = True Then
switchTo = 6
End If
If KeyBoardHandler.KeyPressed(Keys.D8) = True Then
switchTo = 7
End If
If KeyBoardHandler.KeyPressed(Keys.D9) = True Then
switchTo = 8
End If
If KeyBoardHandler.KeyPressed(Keys.D0) = True Then
switchTo = 9
End If
If switchTo > -1 Then
If Me.Boxes.Count - 1 >= switchTo Then
CurrentBox = switchTo
End If
End If
End Sub
Private Sub ChooseObject()
Select Case CursorPosition.Y
Case 0
Select Case CursorPosition.X
Case 0
Me.CurrentBox -= 1
If CurrentBox < 0 Then
CurrentBox = Me.Boxes.Count - 1
End If
Case 1, 2, 3, 4
If Me.BoxChooseMode = True Then
Me.BoxChooseMode = False
Else
Dim e As New MenuEntry(3, "Choose Box", False, AddressOf Me.ChooseBox)
Dim e1 As New MenuEntry(4, "Change Mode", False, AddressOf Me.ChangemodeMenu)
If GetBox(CurrentBox).IsBattleBox = True Then
Dim e4 As New MenuEntry(5, "Cancel", True, Nothing)
Me.SetupMenu({e, e1, e4}, "What do you want to do?")
Else
Dim e2 As New MenuEntry(5, "Wallpaper", False, AddressOf WallpaperMain)
Dim e3 As New MenuEntry(6, "Name", False, AddressOf SelectNameBox)
Dim e4 As New MenuEntry(7, "Cancel", True, Nothing)
Me.SetupMenu({e, e1, e2, e3, e4}, "What do you want to do?")
End If
End If
Case 5
Me.CurrentBox += 1
If CurrentBox > Me.Boxes.Count - 1 Then
CurrentBox = 0
End If
Case 6
SelectPokemon()
End Select
Case 1, 2, 3, 4, 5
If BoxChooseMode = True And CursorPosition.X < 6 And CursorPosition.Y > 0 Then
Dim id As Integer = CInt(CursorPosition.X) + CInt((CursorPosition.Y - 1) * 6)
If Not GetBox(id) Is Nothing Then
Me.CurrentBox = id
Me.BoxChooseMode = False
End If
Else
SelectPokemon()
End If
End Select
End Sub
#Region "ChangeMode"
Private Sub ChangemodeMenu()
Dim e As New MenuEntry(3, "Withdraw", False, AddressOf SelectWithdraw)
Dim e1 As New MenuEntry(4, "Deposit", False, AddressOf SelectDeposit)
Dim e2 As New MenuEntry(5, "Single Move", False, AddressOf Me.SelectSingleMove)
Dim e3 As New MenuEntry(6, "Easy Move", False, AddressOf Me.SelectEasyMove)
Dim e4 As New MenuEntry(7, "Cancel", True, AddressOf Me.ChooseObject)
Me.SetupMenu({e, e1, e2, e3, e4}, "Choose a mode to use.")
End Sub
Private Sub SelectWithdraw()
Me.SelectionMode = SelectionModes.Withdraw
End Sub
Private Sub SelectDeposit()
Me.SelectionMode = SelectionModes.Deposit
End Sub
Private Sub SelectSingleMove()
Me.SelectionMode = SelectionModes.SingleMove
End Sub
Private Sub SelectEasyMove()
Me.SelectionMode = SelectionModes.EasyMove
End Sub
#End Region
Private Shadows Sub ChooseBox()
Me.BoxChooseMode = Not Me.BoxChooseMode
End Sub
Private Sub SelectNameBox()
Core.SetScreen(New InputScreen(Core.CurrentScreen, "BOX " & CStr(GetBox(CurrentBox).index + 1), InputScreen.InputModes.Text, GetBox(CurrentBox).Name, 11, New List(Of Texture2D), AddressOf Me.NameBox))
End Sub
Private Sub NameBox(ByVal name As String)
GetBox(CurrentBox).Name = name
End Sub
#Region "Backgrounds"
Private Sub WallpaperMain()
Dim badges As Integer = Core.Player.Badges.Count
If Core.Player.SandBoxMode = True Or GameController.IS_DEBUG_ACTIVE = True Then
badges = 16
End If
Select Case badges
Case 0, 1
Dim e As New MenuEntry(3, "Package 1", False, AddressOf WallpaperPackage1)
Dim e4 As New MenuEntry(4, "Cancel", True, AddressOf ChooseObject)
SetupMenu({e, e4}, "Please pick a theme.")
Case 2, 3, 4
Dim e As New MenuEntry(3, "Package 1", False, AddressOf WallpaperPackage1)
Dim e1 As New MenuEntry(4, "Package 2", False, AddressOf WallpaperPackage2)
Dim e4 As New MenuEntry(5, "Cancel", True, AddressOf ChooseObject)
SetupMenu({e, e1, e4}, "Please pick a theme.")
Case 5, 6, 7
Dim e As New MenuEntry(3, "Package 1", False, AddressOf WallpaperPackage1)
Dim e1 As New MenuEntry(4, "Package 2", False, AddressOf WallpaperPackage2)
Dim e2 As New MenuEntry(5, "Package 3", False, AddressOf WallpaperPackage3)
Dim e4 As New MenuEntry(6, "Cancel", True, AddressOf ChooseObject)
SetupMenu({e, e1, e2, e4}, "Please pick a theme.")
Case Else
Dim e As New MenuEntry(3, "Package 1", False, AddressOf WallpaperPackage1)
Dim e1 As New MenuEntry(4, "Package 2", False, AddressOf WallpaperPackage2)
Dim e2 As New MenuEntry(5, "Package 3", False, AddressOf WallpaperPackage3)
Dim e3 As New MenuEntry(6, "Package 4", False, AddressOf WallpaperPackage4)
Dim e4 As New MenuEntry(7, "Cancel", True, AddressOf ChooseObject)
SetupMenu({e, e1, e2, e3, e4}, "Please pick a theme.")
End Select
End Sub
Private Sub WallpaperPackage1()
Dim e As New MenuEntry(3, "Forest", False, AddressOf PickWallpaper, 0)
Dim e1 As New MenuEntry(4, "City", False, AddressOf PickWallpaper, 1)
Dim e2 As New MenuEntry(5, "Desert", False, AddressOf PickWallpaper, 2)
Dim e3 As New MenuEntry(6, "Savanna", False, AddressOf PickWallpaper, 3)
Dim e4 As New MenuEntry(7, "Cave", False, AddressOf PickWallpaper, 8)
Dim e5 As New MenuEntry(8, "River", False, AddressOf PickWallpaper, 11)
Dim e6 As New MenuEntry(9, "Cancel", True, AddressOf WallpaperMain)
SetupMenu({e, e1, e2, e3, e4, e5, e6}, "Pick the wallpaper.")
End Sub
Private Sub WallpaperPackage2()
Dim e As New MenuEntry(3, "Volcano", False, AddressOf PickWallpaper, 5)
Dim e1 As New MenuEntry(4, "Snow", False, AddressOf PickWallpaper, 6)
Dim e2 As New MenuEntry(5, "Beach", False, AddressOf PickWallpaper, 9)
Dim e3 As New MenuEntry(6, "Seafloor", False, AddressOf PickWallpaper, 10)
Dim e4 As New MenuEntry(7, "Crag", False, AddressOf PickWallpaper, 4)
Dim e5 As New MenuEntry(8, "Steel", False, AddressOf PickWallpaper, 7)
Dim e6 As New MenuEntry(9, "Cancel", True, AddressOf WallpaperMain)
SetupMenu({e, e1, e2, e3, e4, e5, e6}, "Pick the wallpaper.")
End Sub
Private Sub WallpaperPackage3()
Dim e As New MenuEntry(3, "Volcano 2", False, AddressOf PickWallpaper, 14)
Dim e1 As New MenuEntry(4, "City 2", False, AddressOf PickWallpaper, 15)
Dim e2 As New MenuEntry(5, "Snow 2", False, AddressOf PickWallpaper, 16)
Dim e3 As New MenuEntry(6, "Desert 2", False, AddressOf PickWallpaper, 17)
Dim e4 As New MenuEntry(7, "Savanna 2", False, AddressOf PickWallpaper, 18)
Dim e5 As New MenuEntry(8, "Steel 2", False, AddressOf PickWallpaper, 19)
Dim e6 As New MenuEntry(9, "Cancel", True, AddressOf WallpaperMain)
SetupMenu({e, e1, e2, e3, e4, e5, e6}, "Pick the wallpaper.")
End Sub
Private Sub WallpaperPackage4()
Dim e As New MenuEntry(3, "System", False, AddressOf PickWallpaper, 22)
Dim e1 As New MenuEntry(4, "Simple", False, AddressOf PickWallpaper, 13)
Dim e2 As New MenuEntry(5, "Checks", False, AddressOf PickWallpaper, 12)
Dim e3 As New MenuEntry(6, "Seasons", False, AddressOf PickWallpaper, 23)
Dim e4 As New MenuEntry(7, "Retro 1", False, AddressOf PickWallpaper, 20)
Dim e5 As New MenuEntry(8, "Retro 2", False, AddressOf PickWallpaper, 21)
Dim e6 As New MenuEntry(9, "Cancel", True, AddressOf WallpaperMain)
SetupMenu({e, e1, e2, e3, e4, e5, e6}, "Pick the wallpaper.")
End Sub
Private Sub PickWallpaper(ByVal e As MenuEntry)
GetBox(CurrentBox).Background = CInt(e.TAG)
End Sub
#End Region
Private Sub GetYOffset(ByVal p As Pokemon)
Dim t As Texture2D = p.GetTexture(True)
Me.yOffset = -1
Dim cArr(t.Width * t.Height - 1) As Color
t.GetData(cArr)
For y = 0 To t.Height - 1
For x = 0 To t.Width - 1
If cArr(x + y * t.Height) <> Color.Transparent Then
Me.yOffset = y
Exit For
End If
Next
If Me.yOffset <> -1 Then
Exit For
End If
Next
End Sub
Private Sub MoveCursor()
Dim changedPosition As Boolean = False
If CursorMovePosition <> CursorAimPosition Then
changedPosition = True
End If
If CursorMovePosition.X < CursorAimPosition.X Then
CursorMovePosition.X += Me.CursorSpeed
If CursorMovePosition.X >= CursorAimPosition.X Then
CursorMovePosition.X = CursorAimPosition.X
End If
End If
If CursorMovePosition.X > CursorAimPosition.X Then
CursorMovePosition.X -= Me.CursorSpeed
If CursorMovePosition.X <= CursorAimPosition.X Then
CursorMovePosition.X = CursorAimPosition.X
End If
End If
If CursorMovePosition.Y < CursorAimPosition.Y Then
CursorMovePosition.Y += Me.CursorSpeed
If CursorMovePosition.Y >= CursorAimPosition.Y Then
CursorMovePosition.Y = CursorAimPosition.Y
End If
End If
If CursorMovePosition.Y > CursorAimPosition.Y Then
CursorMovePosition.Y -= Me.CursorSpeed
If CursorMovePosition.Y <= CursorAimPosition.Y Then
CursorMovePosition.Y = CursorAimPosition.Y
End If
End If
If CursorAimPosition = CursorMovePosition Then
Me.CursorMoving = False
If Me.SelectionMode = SelectionModes.EasyMove And changedPosition = True And Me.ClickedObject = True Then
ChooseObject()
End If
End If
End Sub
Dim ClickedObject As Boolean = False
Private Sub ControlCursor()
Dim PreCursor As Vector2 = CursorPosition
If Controls.Right(True, True, False) = True Then
Me.CursorMovePosition = GetAbsoluteCursorPosition(Me.CursorPosition)
Me.CursorPosition.X += 1
If Me.CursorPosition.Y = 0 And Me.CursorPosition.X > 1 And Me.CursorPosition.X < 5 Then
Me.CursorPosition.X = 5
End If
Me.CursorMoving = True
Me.ClickedObject = False
End If
If Controls.Left(True, True, False) = True Then
Me.CursorMovePosition = GetAbsoluteCursorPosition(Me.CursorPosition)
Me.CursorPosition.X -= 1
If Me.CursorPosition.Y = 0 And Me.CursorPosition.X > 0 And Me.CursorPosition.X < 4 Then
Me.CursorPosition.X = 0
End If
Me.CursorMoving = True
Me.ClickedObject = False
End If
If Controls.Up(True, True, False) Then
Me.CursorMovePosition = GetAbsoluteCursorPosition(Me.CursorPosition)
Me.CursorPosition.Y -= 1
Me.CursorMoving = True
Me.ClickedObject = False
End If
If Controls.Down(True, True, False) Then
Me.CursorMovePosition = GetAbsoluteCursorPosition(Me.CursorPosition)
Me.CursorPosition.Y += 1
Me.CursorMoving = True
Me.ClickedObject = False
If Me.CursorPosition.Y = 1 And GetBox(CurrentBox).IsBattleBox = True And Me.CursorPosition.X < 6 And BoxChooseMode = False Then
Me.CursorPosition.X = 2
End If
End If
If ControllerHandler.ButtonPressed(Buttons.X) = True Then
Me.CursorMovePosition = GetAbsoluteCursorPosition(Me.CursorPosition)
Me.CursorPosition = New Vector2(1, 0)
Me.CursorMoving = True
Me.ClickedObject = False
End If
If Controls.Accept(True, False, False) = True AndAlso GetRelativeMousePosition() <> New Vector2(-1) Then
Me.CursorMovePosition = GetAbsoluteCursorPosition(Me.CursorPosition)
Me.CursorPosition = GetRelativeMousePosition()
Me.CursorMoving = True
Me.ClickedObject = True
End If
Dim XRange() As Integer = {0, 6}
If Me.BoxChooseMode = False Then
If Me.SelectionMode = SelectionModes.Withdraw And CursorPosition.Y > 0 Then
If GetBox(CurrentBox).IsBattleBox = True Then
XRange = {2, 3}
Else
XRange = {0, 5}
End If
ElseIf Me.SelectionMode = SelectionModes.Deposit And CursorPosition.Y > 0 Then
XRange = {6, 6}
Else
If GetBox(CurrentBox).IsBattleBox = True Then
If CursorPosition.Y = 0 Then
XRange = {0, 6}
Else
XRange = {2, 6}
End If
End If
End If
End If
If CursorPosition.X < XRange(0) Then
CursorPosition.X = XRange(1)
End If
If CursorPosition.X > XRange(1) Then
CursorPosition.X = XRange(0)
End If
If GetBox(CurrentBox).IsBattleBox = True And Me.BoxChooseMode = False Then
If Me.CursorPosition.Y > 0 And Me.CursorPosition.X > 3 And Me.CursorPosition.X < 6 Then
If PreCursor.X > Me.CursorPosition.X Then
Me.CursorPosition.X = 3
Else
Me.CursorPosition.X = 6
End If
End If
End If
Dim YRange() As Integer = {0, 5}
If Me.BoxChooseMode = False Then
If GetBox(CurrentBox).IsBattleBox = True And Me.CursorPosition.X < 6 Then
YRange = {0, 3}
End If
End If
If CursorPosition.Y < YRange(0) Then
CursorPosition.Y = YRange(1)
End If
If CursorPosition.Y > YRange(1) Then
CursorPosition.Y = YRange(0)
End If
CursorAimPosition = GetAbsoluteCursorPosition(Me.CursorPosition)
Me.CursorSpeed = CInt(Vector2.Distance(CursorMovePosition, CursorAimPosition) * (30 / 100))
End Sub
Private Sub CloseScreen()
If Me.BoxChooseMode = True Then
Me.BoxChooseMode = False
Else
If Not MovingPokemon Is Nothing Then
If PickupPlace.X = 6 Then
Core.Player.Pokemons.Add(Me.MovingPokemon)
Else
Dim id As Integer = CInt(PickupPlace.X) + CInt((PickupPlace.Y - 1) * 6)
If GetBox(PickupBox).IsBattleBox = True Then
GetBox(PickupBox).Pokemon.Add(GetBox(PickupBox).Pokemon.Count, New PokemonWrapper(Me.MovingPokemon)) ' Me.MovingPokemon))
Else
GetBox(PickupBox).Pokemon.Add(id, New PokemonWrapper(Me.MovingPokemon)) ' Me.MovingPokemon)
End If
CurrentBox = PickupBox
End If
Me.MovingPokemon = Nothing
Else
Player.Temp.StorageSystemCursorPosition = Me.CursorPosition
Player.Temp.PCBoxIndex = Me.CurrentBox
Player.Temp.PCBoxChooseMode = Me.BoxChooseMode
Player.Temp.PCSelectionType = Me.SelectionMode
Core.Player.BoxData = GetBoxSaveData(Me.Boxes)
Core.SetScreen(New TransitionScreen(Me, Me.PreScreen, Color.Black, False))
End If
End If
End Sub
Private Shared Function GetBoxSaveData(ByVal boxes As List(Of Box)) As String
Dim BoxesFull As Boolean = True
Dim newData As New List(Of String)
For Each b As Box In boxes
If b.IsBattleBox = False Then
newData.Add("BOX|" & b.index & "|" & b.Name & "|" & b.Background)
Dim hasPokemon As Boolean = False
For i = 0 To 29
If b.Pokemon.Keys.Contains(i) = True Then
hasPokemon = True
newData.Add(b.index.ToString() & "," & i.ToString() & "," & b.Pokemon(i).PokemonData)
End If
Next
If hasPokemon = False Then
BoxesFull = False
End If
End If
Next
Dim addedBoxes As Integer = 0
If BoxesFull = True And boxes.Count < 30 Then
Dim newBoxes As Integer = (5).Clamp(1, 30 - boxes.Count)
addedBoxes = newBoxes
For i = 0 To newBoxes - 1
Dim newBoxID As Integer = boxes.Count - 1 + i
newData.Add("BOX|" & newBoxID.ToString() & "|BOX " & (newBoxID + 1).ToString() & "|" & Core.Random.Next(0, 19).ToString())
Next
End If
Dim battleBox As Box = boxes.Last
newData.Add("BOX|" & CStr(boxes.Count - 1 + addedBoxes) & "|" & battleBox.Name & "|" & battleBox.Background)
For i = 0 To 29
If battleBox.Pokemon.Keys.Contains(i) = True Then
newData.Add(CStr(boxes.Count - 1 + addedBoxes) & "," & i.ToString() & "," & battleBox.Pokemon(i).PokemonData)
End If
Next
Dim returnData As String = ""
For Each l As String In newData
If returnData <> "" Then
returnData &= Environment.NewLine
End If
returnData &= l
Next
Return returnData
End Function
Private Function GetRelativeMousePosition() As Vector2
For x = 0 To 5
For y = 0 To 4
If New Rectangle(50 + x * 100, 200 + y * 84, 64, 64).Contains(MouseHandler.MousePosition) = True Then
Return New Vector2(x, y + 1)
End If
Next
Next
For y = 0 To 5
If New Rectangle(Core.windowSize.Width - 260, y * 100 + 50, 128, 80).Contains(MouseHandler.MousePosition) = True Then
Return New Vector2(6, y)
End If
Next
If New Rectangle(10, 52, 96, 96).Contains(MouseHandler.MousePosition) = True Then
Return New Vector2(0, 0)
End If
If New Rectangle(655, 52, 96, 96).Contains(MouseHandler.MousePosition) = True Then
Return New Vector2(5, 0)
End If
If New Rectangle(80, 50, 600, 100).Contains(MouseHandler.MousePosition) = True Then
Return New Vector2(1, 0)
End If
Return New Vector2(-1)
End Function
Private Function GetAbsoluteCursorPosition(ByVal relPos As Vector2) As Vector2
Select Case relPos.Y
Case 0
Select Case relPos.X
Case 0
Return New Vector2(60, 20)
Case 1, 2, 3, 4
Return New Vector2(380, 30)
Case 5
Return New Vector2(705, 20)
Case 6
Return New Vector2(Core.windowSize.Width - 200, 20)
End Select
Case 1, 2, 3, 4, 5
Select Case relPos.X
Case 0, 1, 2, 3, 4, 5
Return New Vector2(50 + relPos.X * 100 + 42, 200 + (relPos.Y - 1) * 84 - 42)
Case 6
Return New Vector2(Core.windowSize.Width - 200, 20 + 100 * relPos.Y)
End Select
End Select
End Function
Private Function GetBattleBoxID() As Integer
Dim id As Integer = -1
If CursorPosition.X = 2 Then
Select Case CursorPosition.Y
Case 1
Return 0
Case 2
Return 2
Case 3
Return 4
End Select
ElseIf CursorPosition.X = 3 Then
Select Case CursorPosition.Y
Case 1
Return 1
Case 2
Return 3
Case 3
Return 5
End Select
End If
Return -1
End Function
Private Sub SelectPokemon()
Select Case Me.SelectionMode
Case SelectionModes.SingleMove, SelectionModes.Withdraw, SelectionModes.Deposit
If Me.MovingPokemon Is Nothing Then
Dim id As Integer = CInt(CursorPosition.X) + CInt((CursorPosition.Y - 1) * 6)
If GetBox(CurrentBox).IsBattleBox = True Then
id = GetBattleBoxID()
End If
If GetBox(CurrentBox).Pokemon.Keys.Contains(id) = True And CursorPosition.X < 6 Or CursorPosition.X = 6 And Core.Player.Pokemons.Count - 1 >= CInt(CursorPosition.Y) Then
Dim p As Pokemon = Nothing
If CursorPosition.X = 6 Then
p = Core.Player.Pokemons(CInt(CursorPosition.Y))
Else
p = GetBox(CurrentBox).Pokemon(id).GetPokemon()
End If
Dim e As MenuEntry
Select Case Me.SelectionMode
Case SelectionModes.Withdraw
e = New MenuEntry(3, "Withdraw", False, AddressOf WithdrawPokemon)
Case SelectionModes.Deposit
e = New MenuEntry(3, "Deposit", False, AddressOf DepositPokemon)
Case Else
e = New MenuEntry(3, "Move", False, AddressOf PickupPokemon)
End Select
Dim e1 As New MenuEntry(4, "Summary", False, AddressOf SummaryPokemon)
Dim e2 As New MenuEntry(5, "Release", False, AddressOf ReleasePokemon)
Dim e3 As New MenuEntry(6, "Cancel", True, Nothing)
SetupMenu({e, e1, e2, e3}, p.GetDisplayName() & " is selected.")
End If
Else
PickupPokemon()
End If
Case SelectionModes.EasyMove
PickupPokemon()
End Select
End Sub
Private Sub PickupPokemon()
If CursorPosition.X = 6 Then
If Core.Player.Pokemons.Count - 1 >= CursorPosition.Y Then
If Not Me.MovingPokemon Is Nothing Then
Dim l As New List(Of Pokemon)
l.AddRange(Core.Player.Pokemons.ToArray())
l.RemoveAt(CInt(CursorPosition.Y))
l.Add(Me.MovingPokemon)
Dim hasPokemon As Boolean = False
For Each p As Pokemon In l
If p.IsEgg() = False And p.Status <> Pokemon.StatusProblems.Fainted And p.HP > 0 Then
hasPokemon = True
Exit For
End If
Next
If hasPokemon = True Then
Dim sPokemon As Pokemon = Core.Player.Pokemons(CInt(CursorPosition.Y))
Me.MovingPokemon.FullRestore()
Core.Player.Pokemons.Insert(CInt(CursorPosition.Y), Me.MovingPokemon)
MovingPokemon = sPokemon
Core.Player.Pokemons.RemoveAt(CInt(CursorPosition.Y) + 1)
Else
Dim e As New MenuEntry(3, "OK", True, Nothing)
SetupMenu({e}, "Can't remove last Pokémon from party.")
End If
Else
Dim l As New List(Of Pokemon)
l.AddRange(Core.Player.Pokemons.ToArray())
l.RemoveAt(CInt(CursorPosition.Y))
Dim hasPokemon As Boolean = False
For Each p As Pokemon In l
If p.IsEgg() = False And p.Status <> Pokemon.StatusProblems.Fainted And p.HP > 0 Then
hasPokemon = True
Exit For
End If
Next
If hasPokemon = True Then
Me.MovingPokemon = Core.Player.Pokemons(CInt(CursorPosition.Y))
Core.Player.Pokemons.RemoveAt(CInt(CursorPosition.Y))
PickupBox = 0
PickupPlace = New Vector2(6, 0)
Else
Dim e As New MenuEntry(3, "OK", True, Nothing)
SetupMenu({e}, "Can't remove last Pokémon from party.")
End If
End If
Else
If Not Me.MovingPokemon Is Nothing Then
Me.MovingPokemon.FullRestore()
Core.Player.Pokemons.Add(Me.MovingPokemon)
Me.MovingPokemon = Nothing
End If
End If
Else
Dim pokemonExists As Boolean = False
Dim id As Integer = CInt(CursorPosition.X) + CInt((CursorPosition.Y - 1) * 6)
If GetBox(CurrentBox).IsBattleBox = True Then
id = GetBattleBoxID()
End If
pokemonExists = GetBox(CurrentBox).Pokemon.Keys.Contains(id)
If pokemonExists = True Then
If Me.MovingPokemon Is Nothing Then
Me.MovingPokemon = GetBox(CurrentBox).Pokemon(id).GetPokemon()
GetBox(CurrentBox).Pokemon.Remove(id)
PickupBox = CurrentBox
PickupPlace = CursorPosition
RearrangeBattleBox(GetBox(CurrentBox))
Else
Me.MovingPokemon.FullRestore()
Dim sPokemon As Pokemon = GetBox(CurrentBox).Pokemon(id).GetPokemon()
GetBox(CurrentBox).Pokemon(id) = New PokemonWrapper(Me.MovingPokemon) ' Me.MovingPokemon
Me.MovingPokemon = sPokemon
End If
Else
If Not Me.MovingPokemon Is Nothing Then
Me.MovingPokemon.FullRestore()
If GetBox(CurrentBox).IsBattleBox = True Then
GetBox(CurrentBox).Pokemon.Add(GetBox(CurrentBox).Pokemon.Count, New PokemonWrapper(Me.MovingPokemon)) ' Me.MovingPokemon)
Else
GetBox(CurrentBox).Pokemon.Add(id, New PokemonWrapper(Me.MovingPokemon)) ' Me.MovingPokemon)
End If
Me.MovingPokemon = Nothing
End If
End If
End If
End Sub
Private Sub WithdrawPokemon()
If Core.Player.Pokemons.Count < 6 Then
Dim id As Integer = CInt(CursorPosition.X) + CInt((CursorPosition.Y - 1) * 6)
If GetBox(CurrentBox).IsBattleBox = True Then
id = GetBattleBoxID()
End If
Dim pokemonExists As Boolean = GetBox(CurrentBox).Pokemon.Keys.Contains(id)
If pokemonExists = True Then
Core.Player.Pokemons.Add(GetBox(CurrentBox).Pokemon(id).GetPokemon())
GetBox(CurrentBox).Pokemon.Remove(id)
End If
Else
Dim e As New MenuEntry(3, "OK", True, Nothing)
SetupMenu({e}, "Party is full!")
End If
RearrangeBattleBox(GetBox(CurrentBox))
End Sub
Private Sub DepositPokemon()
If GetBox(CurrentBox).Pokemon.Count < 30 Then
If Core.Player.Pokemons.Count - 1 >= CInt(Me.CursorPosition.Y) Then
Dim l As New List(Of Pokemon)
l.AddRange(Core.Player.Pokemons.ToArray())
l.RemoveAt(CInt(CursorPosition.Y))
Dim hasPokemon As Boolean = False
For Each p As Pokemon In l
If p.IsEgg() = False And p.Status <> Pokemon.StatusProblems.Fainted And p.HP > 0 Then
hasPokemon = True
Exit For
End If
Next
If hasPokemon = True Then
Dim nextIndex As Integer = 0
While GetBox(CurrentBox).Pokemon.Keys.Contains(nextIndex) = True
nextIndex += 1
End While
Core.Player.Pokemons(CInt(Me.CursorPosition.Y)).FullRestore()
GetBox(CurrentBox).Pokemon.Add(nextIndex, New PokemonWrapper(Core.Player.Pokemons(CInt(Me.CursorPosition.Y)))) ' Core.Player.Pokemons(CInt(Me.CursorPosition.Y)))
Core.Player.Pokemons.RemoveAt(CInt(Me.CursorPosition.Y))
Else
Dim e As New MenuEntry(3, "OK", True, Nothing)
SetupMenu({e}, "Can't remove last Pokémon from party.")
End If
End If
End If
End Sub
Private Sub SummaryPokemon()
If CursorPosition.X = 6 Then
Core.SetScreen(New SummaryScreen(Me, Core.Player.Pokemons.ToArray(), CInt(CursorPosition.Y)))
Else
Dim id As Integer = CInt(CursorPosition.X) + CInt((CursorPosition.Y - 1) * 6)
If GetBox(CurrentBox).IsBattleBox = True Then
id = GetBattleBoxID()
End If
Core.SetScreen(New SummaryScreen(Me, GetBox(CurrentBox).GetPokemonList().ToArray(), GetBox(CurrentBox).GetPokemonList().IndexOf(GetBox(CurrentBox).Pokemon(id).GetPokemon())))
End If
End Sub
Private Sub ReleasePokemon()
Dim hasPokemon As Boolean = False
If Me.CursorPosition.X = 6 Then
Dim l As New List(Of Pokemon)
l.AddRange(Core.Player.Pokemons.ToArray())
l.RemoveAt(CInt(CursorPosition.Y))
For Each p As Pokemon In l
If p.IsEgg() = False And p.Status <> Pokemon.StatusProblems.Fainted And p.HP > 0 Then
hasPokemon = True
Exit For
End If
Next
Else
hasPokemon = True
End If
If hasPokemon = True Then
Dim id As Integer = CInt(CursorPosition.X) + CInt((CursorPosition.Y - 1) * 6)
If GetBox(CurrentBox).IsBattleBox = True Then
id = GetBattleBoxID()
End If
Dim p As Pokemon = Nothing
If CursorPosition.X = 6 Then
p = Core.Player.Pokemons(CInt(CursorPosition.Y))
Else
p = GetBox(CurrentBox).Pokemon(id).GetPokemon()
End If
If p.IsEgg() = False Then
Dim e1 As New MenuEntry(3, "No", True, AddressOf SelectPokemon)
Dim e As New MenuEntry(4, "Yes", False, AddressOf ConfirmRelease)
Me.SetupMenu({e1, e}, "Release " & p.GetDisplayName() & "?")
Else
Me.SetupMenu({New MenuEntry(3, "OK", True, Nothing)}, "Cannot release an Egg.")
End If
Else
Me.SetupMenu({New MenuEntry(3, "OK", True, Nothing)}, "Cannot release the last Pokémon.")
End If
End Sub
Private Sub ConfirmRelease()
Dim id As Integer = CInt(CursorPosition.X) + CInt((CursorPosition.Y - 1) * 6)
If CursorPosition.X = 6 Then
Core.Player.Pokemons.RemoveAt(CInt(CursorPosition.Y))
Else
GetBox(CurrentBox).Pokemon.Remove(id)
End If
End Sub
Private Sub RearrangeBattleBox(ByVal b As Box)
If b.IsBattleBox = True Then
Dim p As List(Of Pokemon) = b.GetPokemonList()
b.Pokemon.Clear()
For i = 0 To p.Count - 1
b.Pokemon.Add(i, New PokemonWrapper(p(i))) ' p(i))
Next
End If
End Sub
#End Region
#Region "Draw"
Public Overrides Sub Draw()
' Draw3DModel()
DrawMainWindow()
DrawPokemonStatus()
DrawTopBar()
DrawTeamWindow()
If Me.MenuVisible = False Then
DrawCursor()
Else
DrawMenuEntries()
End If
End Sub
Private Sub DrawTopBar()
Dim b As Box = Nothing
Dim boxIndex As Integer = 0
If BoxChooseMode = True Then
If CursorPosition.X < 6 And CursorPosition.Y > 0 Then
boxIndex = CInt(CursorPosition.X) + CInt((CursorPosition.Y - 1) * 6)
Else
boxIndex = CurrentBox
End If
Else
boxIndex = Me.CurrentBox
End If
b = GetBox(boxIndex)
If Not b Is Nothing Then
If b.IsBattleBox = True Then
Core.SpriteBatch.Draw(TextureManager.GetTexture("GUI\Box\BattleBox"), New Rectangle(80, 50, 600, 100), Color.White)
Dim cArr(0) As Color
TextureManager.GetTexture("GUI\Box\BattleBox", New Rectangle(0, 0, 1, 1), "").GetData(cArr)
Canvas.DrawScrollBar(New Vector2(80, 36), Me.Boxes.Count, 1, boxIndex, New Size(600, 14), True, New Color(0, 0, 0, 0), cArr(0))
Else
Core.SpriteBatch.Draw(TextureManager.GetTexture("GUI\Box\" & b.Background.ToString()), New Rectangle(80, 50, 600, 100), Color.White)
Dim cArr(0) As Color
TextureManager.GetTexture("GUI\Box\" & b.Background, New Rectangle(0, 0, 1, 1), "").GetData(cArr)
Canvas.DrawScrollBar(New Vector2(80, 36), Me.Boxes.Count, 1, boxIndex, New Size(600, 14), True, New Color(0, 0, 0, 0), cArr(0))
End If
Core.SpriteBatch.DrawString(FontManager.MainFont, b.Name, New Vector2(384 - FontManager.MainFont.MeasureString(b.Name).X, 80), Color.Black, 0.0F, New Vector2(0), 2, SpriteEffects.None, 0.0F)
Core.SpriteBatch.DrawString(FontManager.MainFont, b.Name, New Vector2(380 - FontManager.MainFont.MeasureString(b.Name).X, 76), Color.White, 0.0F, New Vector2(0), 2, SpriteEffects.None, 0.0F)
Core.SpriteBatch.Draw(Me.menuTexture, New Rectangle(10, 52, 96, 96), New Rectangle(0, 16, 16, 16), Color.White)
Core.SpriteBatch.Draw(Me.menuTexture, New Rectangle(655, 52, 96, 96), New Rectangle(0, 16, 16, 16), Color.White, 0.0F, New Vector2(0), SpriteEffects.FlipHorizontally, 0.0F)
End If
End Sub
Private Sub DrawMainWindow()
If BoxChooseMode = True Then
Canvas.DrawRectangle(Core.windowSize, New Color(220, 220, 220))
For x = 0 To 5
For y = 0 To 4
Dim id As Integer = y * 6 + x
If Me.Boxes.Count - 1 >= id Then
Dim pCount As Integer = BoxPokemonCount(id, True)
Dim tCoord As New Vector2(64, 0)
If pCount = 0 Then
tCoord = New Vector2(64, 32)
ElseIf pCount = 30 Then
tCoord = New Vector2(32, 32)
End If
Core.SpriteBatch.Draw(Me.texture, New Rectangle(50 + x * 100, 200 + y * 84, 64, 64), New Rectangle(CInt(tCoord.X), CInt(tCoord.Y), 32, 32), Color.White)
End If
Next
Next
Else
If GetBox(CurrentBox).IsBattleBox = True Then
Canvas.DrawGradient(Core.windowSize, New Color(203, 40, 41), New Color(238, 128, 128), False, -1)
Dim cArr(0) As Color
TextureManager.GetTexture("GUI\Box\BattleBox", New Rectangle(0, 0, 1, 1), "").GetData(cArr)
For i = 0 To 5
Dim id As Integer = i
Dim x As Integer = i + 2
Dim y As Integer = 0
While x > 3
x -= 2
y += 1
End While
Canvas.DrawRectangle(New Rectangle(50 + x * 100, 200 + y * 84, 64, 64), New Color(cArr(0).R, cArr(0).G, cArr(0).B, 150))
Dim box As Box = GetBox(CurrentBox)
If box.Pokemon.Keys.Contains(id) = True Then
Dim c As Color = Color.White
If IsLit(box.Pokemon(id).GetPokemon()) = False Then
c = New Color(65, 65, 65, 255)
End If
Dim pokeTexture = box.Pokemon(id).GetPokemon().GetMenuTexture()
Core.SpriteBatch.Draw(pokeTexture, New Rectangle(50 + x * 100 - CInt(pokeTexture.Width - 32), 200 + y * 84, pokeTexture.Width * 2, 64), c)
End If
Next
Else
Dim xt As Integer = GetBox(CurrentBox).Background
Dim yt As Integer = 0
While xt > 7
xt -= 8
yt += 1
End While
For x = 0 To Core.windowSize.Width Step 64
For y = 0 To Core.windowSize.Height Step 64
Core.SpriteBatch.Draw(Me.texture, New Rectangle(x, y, 64, 64), New Rectangle(xt * 16, yt * 16 + 64, 16, 16), Color.White)
Next
Next
Dim cArr(0) As Color
TextureManager.GetTexture("GUI\Box\" & GetBox(CurrentBox).Background, New Rectangle(0, 0, 1, 1), "").GetData(cArr)
For x = 0 To 5
For y = 0 To 4
Dim id As Integer = y * 6 + x
Canvas.DrawRectangle(New Rectangle(50 + x * 100, 200 + y * 84, 64, 64), New Color(cArr(0).R, cArr(0).G, cArr(0).B, 150))
Dim box As Box = GetBox(CurrentBox)
If box.Pokemon.Keys.Contains(id) = True Then
Dim c As Color = Color.White
If IsLit(box.Pokemon(id).GetPokemon()) = False Then
c = New Color(65, 65, 65, 255)
End If
Dim pokeTexture = box.Pokemon(id).GetPokemon().GetMenuTexture()
Core.SpriteBatch.Draw(pokeTexture, New Rectangle(50 + x * 100 - CInt(pokeTexture.Width - 32), 200 + y * 84, pokeTexture.Width * 2, 64), c)
End If
Next
Next
End If
End If
End Sub
Dim yOffset As Integer = 0
Private Sub DrawPokemonStatus()
If Me.BoxChooseMode = True And CursorPosition.X < 6 And CursorPosition.Y > 0 Then
Dim box As Box = GetBox(CInt(CursorPosition.X) + CInt((CursorPosition.Y - 1) * 6))
If Not box Is Nothing Then
Canvas.DrawRectangle(New Rectangle(660, 200, 200, 200), New Color(84, 198, 216, 150))
Dim minLevel As Integer = -1
Dim maxLevel As Integer = -1
For x = 0 To 5
For y = 0 To 4
Dim id As Integer = y * 6 + x
If box.Pokemon.Keys.Contains(id) = True Then
Dim c As Color = Color.White
If IsLit(box.Pokemon(id).GetPokemon()) = False Then
c = New Color(65, 65, 65, 255)
End If
Dim pokeTexture = box.Pokemon(id).GetPokemon().GetMenuTexture()
Core.SpriteBatch.Draw(pokeTexture, New Rectangle(664 + x * 32 - CInt((pokeTexture.Width - 32) / 2), 215 + y * 32, pokeTexture.Width, 32), c)
If box.Pokemon(id).GetPokemon().Level < minLevel Or minLevel = -1 Then
minLevel = box.Pokemon(id).GetPokemon().Level
End If
If box.Pokemon(id).GetPokemon().Level > maxLevel Or maxLevel = -1 Then
maxLevel = box.Pokemon(id).GetPokemon().Level
End If
End If
Next
Next
Canvas.DrawRectangle(New Rectangle(660, 410, 200, 210), New Color(84, 198, 216, 150))
Dim levelString As String = minLevel & " - " & maxLevel
If minLevel = -1 Or maxLevel = -1 Then
levelString = "None"
End If
Dim maxPokemon As Integer = 30
If box.IsBattleBox = True Then
maxPokemon = 6
End If
Dim t As String = "Box: " & box.Name & Environment.NewLine & "Pokémon: " & box.Pokemon.Count & " / " & maxPokemon & Environment.NewLine & "Level: " & levelString
Core.SpriteBatch.DrawString(FontManager.MiniFont, t, New Vector2(667, 417), Color.Black)
Core.SpriteBatch.DrawString(FontManager.MiniFont, t, New Vector2(665, 415), Color.White)
End If
Else
Dim p As Pokemon = Nothing
If Not Me.MovingPokemon Is Nothing Then
p = Me.MovingPokemon
Else
If CursorPosition.X = 6 Then
If Core.Player.Pokemons.Count - 1 >= CursorPosition.Y Then
p = Core.Player.Pokemons(CInt(CursorPosition.Y))
End If
Else
Dim id As Integer = CInt(Me.CursorPosition.X) + CInt((Me.CursorPosition.Y - 1) * 6)
If GetBox(CurrentBox).IsBattleBox = True Then
id = GetBattleBoxID()
End If
If GetBox(CurrentBox).Pokemon.Keys.Contains(id) = True Then
p = GetBox(CurrentBox).Pokemon(id).GetPokemon()
End If
End If
End If
If Not p Is Nothing Then
Dim cArr(0) As Color
If GetBox(CurrentBox).IsBattleBox = True Then
TextureManager.GetTexture("GUI\Box\BattleBox", New Rectangle(0, 0, 1, 1), "").GetData(cArr)
Else
TextureManager.GetTexture("GUI\Box\" & GetBox(CurrentBox).Background, New Rectangle(0, 0, 1, 1), "").GetData(cArr)
End If
Dim c As Color = New Color(cArr(0).R, cArr(0).G, cArr(0).B, 150)
If BoxChooseMode = True Then
c = New Color(84, 198, 216, 150)
End If
Canvas.DrawRectangle(New Rectangle(660, 200, 200, 200), c)
Dim modelName As String = p.AnimationName
Dim shinyString As String = "Normal"
If p.IsShiny = True Then
shinyString = "Shiny"
End If
If Core.Player.ShowModelsInBattle = True AndAlso ModelManager.ModelExist("Models\" & modelName & "\" & shinyString) = True And p.IsEgg() = False Then
Draw3DModel(p, "Models\" & modelName & "\" & shinyString)
Else
GetYOffset(p)
Core.SpriteBatch.Draw(p.GetTexture(True), New Rectangle(634, 180 - yOffset, 256, 256), Color.White)
End If
Canvas.DrawRectangle(New Rectangle(660, 410, 200, 210), c)
If p.IsEgg() = True Then
Core.SpriteBatch.DrawString(FontManager.MiniFont, "Egg", New Vector2(667, 417), Color.Black)
Core.SpriteBatch.DrawString(FontManager.MiniFont, "Egg", New Vector2(665, 415), Color.White)
Else
Dim itemString As String = "None"
If Not p.Item Is Nothing Then
itemString = p.Item.Name
End If
Dim nameString As String = p.GetDisplayName() & "/" & p.OriginalName
If p.NickName = "" Then
nameString = p.GetDisplayName()
End If
Dim t As String = nameString & Environment.NewLine &
"DEX NO. " & p.Number & Environment.NewLine &
"LEVEL " & p.Level & Environment.NewLine &
"HP " & p.HP & " / " & p.MaxHP & Environment.NewLine &
"ATTACK " & p.Attack & Environment.NewLine &
"DEFENSE " & p.Defense & Environment.NewLine &
"SP. ATK " & p.SpAttack & Environment.NewLine &
"SP. DEF " & p.SpDefense & Environment.NewLine &
"SPEED " & p.Speed & Environment.NewLine &
"ITEM " & itemString
Core.SpriteBatch.DrawString(FontManager.MiniFont, t, New Vector2(667, 417), Color.Black)
Core.SpriteBatch.DrawString(FontManager.MiniFont, t, New Vector2(665, 415), Color.White)
End If
End If
End If
End Sub
Private Sub Draw3DModel(ByVal p As Pokemon, ByVal modelName As String)
Dim propList = p.GetModelProperties()
Dim scale As Single = propList.Item1
Dim x As Single = propList.Item2
Dim y As Single = propList.Item3
Dim z As Single = propList.Item4
Dim roll As Single = propList.Item5
Dim t As Texture2D = ModelManager.DrawModelToTexture(modelName, renderTarget, New Vector3(x, y, z), New Vector3(0.0F, 50.0F, 10.0F), New Vector3(0.0F, 0.2F, roll + modelRoll), scale, True)
Core.SpriteBatch.Draw(t, New Rectangle(160, 50, 1200, 680), Color.White)
End Sub
Private Sub DrawTeamWindow()
Canvas.DrawRectangle(New Rectangle(Core.windowSize.Width - 310, 0, 400, Core.windowSize.Height), New Color(84, 198, 216))
For y = -64 To Core.windowSize.Height Step 64
Core.SpriteBatch.Draw(Me.menuTexture, New Rectangle(Core.windowSize.Width - 128, y + StorageSystemScreen.TileOffset, 128, 64), New Rectangle(48, 0, 16, 16), Color.White)
Next
Core.SpriteBatch.Draw(Me.texture, New Rectangle(Core.windowSize.Width - 430, 0, 128, CInt(Core.windowSize.Height / 2)), New Rectangle(96, 0, 32, 64), Color.White)
Core.SpriteBatch.Draw(Me.texture, New Rectangle(Core.windowSize.Width - 430, CInt(Core.windowSize.Height / 2), 128, CInt(Core.windowSize.Height / 2)), New Rectangle(96, 0, 32, 64), Color.White, 0.0F, New Vector2(0), SpriteEffects.FlipVertically, 0.0F)
For i = 0 To 5
Canvas.DrawBorder(2, New Rectangle(Core.windowSize.Width - 260, i * 100 + 50, 128, 80), New Color(42, 167, 198))
If Core.Player.Pokemons.Count - 1 >= i Then
Dim c As Color = Color.White
If IsLit(Core.Player.Pokemons(i)) = False Then
c = New Color(65, 65, 65, 255)
End If
Dim pokeTexture = Core.Player.Pokemons(i).GetMenuTexture()
Core.SpriteBatch.Draw(pokeTexture, New Rectangle(Core.windowSize.Width - 228 - CInt(pokeTexture.Width - 32), i * 100 + 60, pokeTexture.Width * 2, 64), c)
If Not Core.Player.Pokemons(i).Item Is Nothing And Core.Player.Pokemons(i).IsEgg() = False Then
Core.SpriteBatch.Draw(Core.Player.Pokemons(i).Item.Texture, New Rectangle(Core.windowSize.Width - 196, i * 100 + 92, 24, 24), Color.White)
End If
End If
Next
End Sub
Private Sub DrawCursor()
Dim cPosition As Vector2 = GetAbsoluteCursorPosition(Me.CursorPosition)
If CursorMoving = True Then
cPosition = CursorMovePosition
End If
If Not Me.MovingPokemon Is Nothing Then
Dim pokeTexture = Me.MovingPokemon.GetMenuTexture()
Core.SpriteBatch.Draw(pokeTexture, New Rectangle(CInt(cPosition.X - 10) - CInt(pokeTexture.Width - 32), CInt(cPosition.Y + 44), pokeTexture.Width * 2, 64), New Color(0, 0, 0, 150))
Core.SpriteBatch.Draw(pokeTexture, New Rectangle(CInt(cPosition.X - 20) - CInt(pokeTexture.Width - 32), CInt(cPosition.Y + 34), pokeTexture.Width * 2, 64), Color.White)
If Not Me.MovingPokemon.Item Is Nothing And Me.MovingPokemon.IsEgg() = False Then
Core.SpriteBatch.Draw(Me.MovingPokemon.Item.Texture, New Rectangle(CInt(cPosition.X - 20) + 32, CInt(cPosition.Y + 34) + 32, 24, 24), Color.White)
End If
End If
Dim t As Texture2D = GetCursorTexture()
Core.SpriteBatch.Draw(t, New Rectangle(CInt(cPosition.X), CInt(cPosition.Y), 64, 64), Color.White)
End Sub
Private Sub DrawMenuEntries()
If Me.MenuHeader <> "" Then
Canvas.DrawRectangle(New Rectangle(Core.windowSize.Width - 370, 100, 356, 64), New Color(0, 0, 0, 180))
Core.SpriteBatch.DrawString(FontManager.MiniFont, MenuHeader, New Vector2(Core.windowSize.Width - 192 - FontManager.MiniFont.MeasureString(MenuHeader).X / 2, 120), Color.White)
End If
For Each e As MenuEntry In Me.MenuEntries
e.Draw(Me.MenuCursor, GetCursorTexture())
Next
End Sub
Private Function GetCursorTexture() As Texture2D
Select Case Me.SelectionMode
Case SelectionModes.SingleMove
Return TextureManager.GetTexture("GUI\Menus\General", New Rectangle(0, 0, 16, 16), "")
Case SelectionModes.EasyMove
Return TextureManager.GetTexture("GUI\Menus\General", New Rectangle(16, 0, 16, 16), "")
Case SelectionModes.Deposit
Return TextureManager.GetTexture("GUI\Menus\General", New Rectangle(32, 0, 16, 16), "")
Case SelectionModes.Withdraw
Return TextureManager.GetTexture("GUI\Menus\General", New Rectangle(0, 32, 16, 16), "")
End Select
Return Nothing
End Function
#End Region
Private Function IsLit(ByVal p As Pokemon) As Boolean
If Me.Filters.Count > 0 Then
If p.IsEgg() = True Then
Return False
End If
For Each f As Filter In Filters
Select Case f.FilterType
Case FilterTypes.Ability
If p.Ability.Name.ToLower() <> f.FilterValue.ToLower() Then
Return False
End If
Case FilterTypes.Gender
If p.Gender.ToString().ToLower() <> f.FilterValue.ToLower() Then
Return False
End If
Case FilterTypes.HeldItem
If f.FilterValue = "Has no Held Item" And Not p.Item Is Nothing Then
Return False
ElseIf f.FilterValue = "Has a Held Item" And p.Item Is Nothing Then
Return False
End If
Case FilterTypes.Move
Dim hasAttack As Boolean = False
For Each a As BattleSystem.Attack In p.Attacks
If a.Name.ToLower() = f.FilterValue.ToLower() Then
hasAttack = True
Exit For
End If
Next
If hasAttack = False Then
Return False
End If
Case FilterTypes.Nature
If p.Nature.ToString().ToLower() <> f.FilterValue.ToLower() Then
Return False
End If
Case FilterTypes.Pokémon
If p.GetName() <> f.FilterValue Then
Return False
End If
Case FilterTypes.Type1
Dim t As Element = New Element(f.FilterValue)
If p.Type1.Type <> t.Type Then
Return False
End If
Case FilterTypes.Type2
Dim t As Element = New Element(f.FilterValue)
If p.Type2.Type <> t.Type Then
Return False
End If
End Select
Next
End If
Return True
End Function
''' <summary>
''' Adds a Pokémon to the next free spot and returns the index of that box.
''' </summary>
Public Shared Function DepositPokemon(ByVal p As Pokemon, Optional ByVal BoxIndex As Integer = -1) As Integer
p.FullRestore()
Dim Boxes As List(Of Box) = LoadBoxes()
Dim startIndex As Integer = 0
If BoxIndex > -1 Then
startIndex = BoxIndex
End If
For i = startIndex To Boxes.Count - 1
If GetBox(i, Boxes).Pokemon.Count < 30 Then
For l = 0 To 29
If GetBox(i, Boxes).Pokemon.Keys.Contains(l) = False Then
GetBox(i, Boxes).Pokemon.Add(l, New PokemonWrapper(p)) ' p)
Exit For
End If
Next
Core.Player.BoxData = GetBoxSaveData(Boxes)
Return i
End If
Next
If startIndex <> 0 Then
For i = 0 To startIndex - 1
If GetBox(i, Boxes).Pokemon.Count < 30 Then
For l = 0 To 29
If GetBox(i, Boxes).Pokemon.Keys.Contains(l) = False Then
GetBox(i, Boxes).Pokemon.Add(l, New PokemonWrapper(p)) ' p)
Exit For
End If
Next
Core.Player.BoxData = GetBoxSaveData(Boxes)
Return i
End If
Next
End If
Return -1
End Function
Public Shared Function GetBoxName(ByVal boxIndex As Integer) As String
Return GetBox(boxIndex, LoadBoxes()).Name
End Function
Private Shared Function GetBox(ByVal index As Integer, ByVal boxes As List(Of Box)) As Box
For Each b As Box In boxes
If b.index = index Then
Return b
End If
Next
Return Nothing
End Function
Private Function GetBox(ByVal index As Integer) As Box
For Each b As Box In Me.Boxes
If b.index = index Then
Return b
End If
Next
Return Nothing
End Function
Private Function BoxPokemonCount(ByVal selBox As Integer, ByVal lit As Boolean) As Integer
Dim c As Integer = 0
Dim box As Box = GetBox(selBox)
If Not box Is Nothing Then
For Each p As PokemonWrapper In box.Pokemon.Values
If lit = True Then
If IsLit(p.GetPokemon()) = True Then
c += 1
End If
Else
c += 1
End If
Next
End If
Return c
End Function
Private Sub SetupMenu(ByVal entries() As MenuEntry, ByVal header As String)
Me.MenuEntries.Clear()
Me.MenuEntries.AddRange(entries)
Me.MenuVisible = True
Me.MenuCursor = MenuEntries(0).Index
Me.MenuHeader = header
End Sub
Public Class PokemonWrapper
Private _pokemon As Pokemon = Nothing
Private _pokemonData As String
Private _loaded As Boolean = False
Public Sub New(ByVal PokemonData As String)
Me._pokemonData = PokemonData
End Sub
Public Sub New(ByVal p As Pokemon)
Me._loaded = True
Me._pokemon = p
Me._pokemonData = p.GetSaveData()
End Sub
Public Function GetPokemon() As Pokemon
If _loaded = False Then
_loaded = True
_pokemon = Pokemon.GetPokemonByData(Me._pokemonData)
End If
Return Me._pokemon
End Function
Public ReadOnly Property PokemonData() As String
Get
If _loaded = True Then
Return Me._pokemon.GetSaveData()
Else
Return Me._pokemonData
End If
End Get
End Property
End Class
Class Box
Public index As Integer = 0
Public Name As String = "BOX 0"
Public Pokemon As New Dictionary(Of Integer, PokemonWrapper)
Public Background As Integer = 0
Public isSelected As Boolean = False
Private _isBattleBox As Boolean = False
Public Sub New(ByVal index As Integer)
Me.index = index
Me.Name = "BOX " & (index + 1).ToString()
Me.Background = index
End Sub
Public ReadOnly Property HasPokemon() As Boolean
Get
Return (Pokemon.Count > 0)
End Get
End Property
Public Function GetPokemonList() As List(Of Pokemon)
Dim l As New List(Of Pokemon)
For i = 0 To Pokemon.Count - 1
l.Add(Pokemon.Values(i).GetPokemon())
Next
Return l
End Function
Public Property IsBattleBox() As Boolean
Get
Return Me._isBattleBox
End Get
Set(value As Boolean)
Me._isBattleBox = value
If Me._isBattleBox = True Then
Me.Name = "BATTLE BOX"
End If
End Set
End Property
End Class
Class MenuEntry
Public Index As Integer = 0
Public TAG As Object = Nothing
Public Text As String = "Menu"
Public IsBack As Boolean = False
Public Delegate Sub ClickEvent(ByVal m As MenuEntry)
Public ClickHandler As ClickEvent = Nothing
Dim t1 As Texture2D
Dim t2 As Texture2D
Public Sub New(ByVal Index As Integer, ByVal text As String, ByVal isBack As Boolean, ByVal ClickHandler As ClickEvent)
Me.New(Index, text, isBack, ClickHandler, Nothing)
End Sub
Public Sub New(ByVal Index As Integer, ByVal text As String, ByVal isBack As Boolean, ByVal ClickHandler As ClickEvent, ByVal TAG As Object)
Me.Index = Index
Me.TAG = TAG
Me.Text = text
Me.IsBack = isBack
Me.ClickHandler = ClickHandler
t1 = TextureManager.GetTexture("GUI\Menus\General", New Rectangle(16, 16, 16, 16), "")
t2 = TextureManager.GetTexture("GUI\Menus\General", New Rectangle(32, 16, 16, 16), "")
End Sub
Public Sub Update(ByVal s As StorageSystemScreen)
If Controls.Accept(True, False, False) = True And s.MenuCursor = Me.Index And New Rectangle(Core.windowSize.Width - 270, 66 * Index, 256, 64).Contains(MouseHandler.MousePosition) = True Or
Controls.Accept(False, True, True) = True And s.MenuCursor = Me.Index Or Controls.Dismiss(True, True, True) = True And Me.IsBack = True Then
s.MenuVisible = False
If Not ClickHandler Is Nothing Then
ClickHandler(Me)
End If
End If
If New Rectangle(Core.windowSize.Width - 270, 66 * Index, 256, 64).Contains(MouseHandler.MousePosition) = True And Controls.Accept(True, False, False) = True Then
s.MenuCursor = Me.Index
End If
End Sub
Public Sub Draw(ByVal CursorIndex As Integer, ByVal CursorTexture As Texture2D)
Dim startPos As New Vector2(Core.windowSize.Width - 270, 66 * Index)
Core.SpriteBatch.Draw(t1, New Rectangle(CInt(startPos.X), CInt(startPos.Y), 64, 64), Color.White)
Core.SpriteBatch.Draw(t2, New Rectangle(CInt(startPos.X + 64), CInt(startPos.Y), 64, 64), Color.White)
Core.SpriteBatch.Draw(t2, New Rectangle(CInt(startPos.X + 128), CInt(startPos.Y), 64, 64), Color.White)
Core.SpriteBatch.Draw(t1, New Rectangle(CInt(startPos.X + 192), CInt(startPos.Y), 64, 64), Nothing, Color.White, 0.0F, New Vector2(0), SpriteEffects.FlipHorizontally, 0.0F)
Core.SpriteBatch.DrawString(FontManager.MainFont, Me.Text, New Vector2(startPos.X + 128 - (FontManager.MainFont.MeasureString(Me.Text).X * 1.4F) / 2, startPos.Y + 15), Color.Black, 0.0F, Vector2.Zero, 1.4F, SpriteEffects.None, 0.0F)
If Me.Index = CursorIndex Then
Dim cPosition As Vector2 = New Vector2(startPos.X + 128, startPos.Y - 40)
Dim t As Texture2D = CursorTexture
Core.SpriteBatch.Draw(t, New Rectangle(CInt(cPosition.X), CInt(cPosition.Y), 64, 64), Color.White)
End If
End Sub
End Class
Public Shared Function GetAllBoxPokemon() As List(Of Pokemon)
Dim Pokemons As New List(Of Pokemon)
Dim Data() As String = Core.Player.BoxData.SplitAtNewline()
For Each line As String In Data
If line.StartsWith("BOX|") = False And line <> "" Then
Dim pokeData As String = line.Remove(0, line.IndexOf("{"))
Pokemons.Add(Pokemon.GetPokemonByData(pokeData))
End If
Next
Return Pokemons
End Function
Public Function GetPokemonList(ByVal includeTeam As Boolean, ByVal lit As Boolean) As List(Of Pokemon)
Dim L As New List(Of Pokemon)
For Each Box As Box In Me.Boxes
If Box.HasPokemon = True Then
For i = 0 To Box.Pokemon.Count - 1
If (lit = True AndAlso IsLit(Box.Pokemon.Values(i).GetPokemon()) = True) = True Or lit = False Then
L.Add(Box.Pokemon.Values(i).GetPokemon())
End If
Next
End If
Next
If includeTeam = True Then
For Each p As Pokemon In Core.Player.Pokemons
If (lit = True AndAlso IsLit(p) = True) = True Or lit = False Then
L.Add(p)
End If
Next
End If
Return L
End Function
Public Shared Function GetBattleBoxPokemon() As List(Of Pokemon)
Dim BattleBoxID As Integer = 0
Dim Data() As String = Core.Player.BoxData.SplitAtNewline()
Dim PokemonList As New List(Of Pokemon)
For Each line As String In Data
If line.StartsWith("BOX|") = True Then
Dim boxData() As String = line.Split(CChar("|"))
If CInt(boxData(1)) > BattleBoxID Then
BattleBoxID = CInt(boxData(1))
End If
End If
Next
For Each line As String In Data
If line.StartsWith(BattleBoxID.ToString() & ",") = True And line.EndsWith("}") = True Then
Dim pokemonData As String = line.Remove(0, line.IndexOf("{"))
PokemonList.Add(Pokemon.GetPokemonByData(pokemonData))
End If
Next
' Prevent more than six Pokémon:
While PokemonList.Count > 6
PokemonList.RemoveAt(PokemonList.Count - 1)
End While
Return PokemonList
End Function
End Class
Public Class StorageSystemFilterScreen
Inherits Screen
Private Class SelectMenu
Dim Items As New List(Of String)
Dim Index As Integer = 0
Public Delegate Sub ClickEvent(ByVal s As SelectMenu)
Dim ClickHandler As ClickEvent = Nothing
Dim BackIndex As Integer = 0
Public Visible As Boolean = True
Public Scroll As Integer = 0
Dim t1 As Texture2D
Dim t2 As Texture2D
Public Sub New(ByVal Items As List(Of String), ByVal Index As Integer, ByVal ClickHandle As ClickEvent, ByVal BackIndex As Integer)
Me.Items = Items
Me.Index = Index
Me.ClickHandler = ClickHandle
Me.BackIndex = BackIndex
If Me.BackIndex < 0 Then
Me.BackIndex = Me.Items.Count + Me.BackIndex
End If
Me.Visible = True
t1 = TextureManager.GetTexture("GUI\Menus\General", New Rectangle(16, 16, 16, 16), "")
t2 = TextureManager.GetTexture("GUI\Menus\General", New Rectangle(32, 16, 16, 16), "")
End Sub
Public Sub Update()
If Visible = True Then
If Controls.Up(True, True, True, True, True, True) = True Then
Me.Index -= 1
End If
If Controls.Down(True, True, True, True, True, True) = True Then
Me.Index += 1
End If
Me.Index = Me.Index.Clamp(0, Me.Items.Count - 1)
For i = Scroll To Me.Scroll + 8
If i <= Me.Items.Count - 1 Then
If Controls.Accept(True, False, False) = True And i = Me.Index And New Rectangle(Core.windowSize.Width - 270, 66 * ((i + 1) - Scroll), 256, 64).Contains(MouseHandler.MousePosition) = True Or
Controls.Accept(False, True, True) = True And i = Me.Index Or Controls.Dismiss(True, True, True) = True And Me.BackIndex = Me.Index Then
If Not ClickHandler Is Nothing Then
ClickHandler(Me)
End If
Me.Visible = False
End If
If Controls.Dismiss(True, True, True) = True Then
Me.Index = Me.BackIndex
If Not ClickHandler Is Nothing Then
ClickHandler(Me)
End If
Me.Visible = False
End If
If New Rectangle(Core.windowSize.Width - 270, 66 * ((i + 1) - Scroll), 256, 64).Contains(MouseHandler.MousePosition) = True And Controls.Accept(True, False, False) = True Then
Me.Index = i
End If
End If
Next
If Index - Scroll > 8 Then
Scroll = Index - 8
End If
If Index - Scroll < 0 Then
Scroll = Index
End If
End If
End Sub
Public Sub Draw()
If Visible = True Then
For i = Scroll To Me.Scroll + 8
If i <= Me.Items.Count - 1 Then
Dim Text As String = Items(i)
Dim startPos As New Vector2(Core.windowSize.Width - 270, 66 * ((i + 1) - Scroll))
Core.SpriteBatch.Draw(t1, New Rectangle(CInt(startPos.X), CInt(startPos.Y), 64, 64), Color.White)
Core.SpriteBatch.Draw(t2, New Rectangle(CInt(startPos.X + 64), CInt(startPos.Y), 64, 64), Color.White)
Core.SpriteBatch.Draw(t2, New Rectangle(CInt(startPos.X + 128), CInt(startPos.Y), 64, 64), Color.White)
Core.SpriteBatch.Draw(t1, New Rectangle(CInt(startPos.X + 192), CInt(startPos.Y), 64, 64), Nothing, Color.White, 0.0F, New Vector2(0), SpriteEffects.FlipHorizontally, 0.0F)
Core.SpriteBatch.DrawString(FontManager.MainFont, Text, New Vector2(startPos.X + 128 - (FontManager.MainFont.MeasureString(Text).X * 1.4F) / 2, startPos.Y + 15), Color.Black, 0.0F, Vector2.Zero, 1.4F, SpriteEffects.None, 0.0F)
If Me.Index = i Then
Dim cPosition As Vector2 = New Vector2(startPos.X + 128, startPos.Y - 40)
Dim t As Texture2D = TextureManager.GetTexture("GUI\Menus\General", New Rectangle(0, 0, 16, 16), "")
Core.SpriteBatch.Draw(t, New Rectangle(CInt(cPosition.X), CInt(cPosition.Y), 64, 64), Color.White)
End If
End If
Next
End If
End Sub
Public ReadOnly Property SelectedItem() As String
Get
Return Items(Me.Index)
End Get
End Property
End Class
Private _storageSystemScreen As StorageSystemScreen
Dim texture As Texture2D
Dim Filters As New List(Of StorageSystemScreen.Filter)
Dim Menu As SelectMenu
Dim mainMenuItems As New List(Of String)
Dim Cursor As Integer = 0
Dim Scroll As Integer = 0
Dim Results As Integer = 0
Dim CalculatedFilters As New List(Of StorageSystemScreen.Filter)
Public Sub New(ByVal currentScreen As StorageSystemScreen)
Me.Identification = Identifications.StorageSystemFilterScreen
Me._storageSystemScreen = currentScreen
Me.texture = TextureManager.GetTexture("GUI\Menus\General")
For Each Filter As StorageSystemScreen.Filter In currentScreen.Filters
Me.Filters.Add(Filter)
Next
Me.MouseVisible = True
Me.CanMuteMusic = True
Me.CanBePaused = True
Me.mainMenuItems = {"Pokémon", "Type1", "Type2", "Move", "Ability", "Nature", "Gender", "HeldItem"}.ToList()
Me.Menu = New SelectMenu({""}.ToList(), 0, Nothing, 0)
Me.Menu.Visible = False
End Sub
Public Overrides Sub Draw()
Canvas.DrawRectangle(Core.windowSize, New Color(84, 198, 216))
For y = -64 To Core.windowSize.Height Step 64
Core.SpriteBatch.Draw(Me.texture, New Rectangle(Core.windowSize.Width - 128, y + StorageSystemScreen.TileOffset, 128, 64), New Rectangle(48, 0, 16, 16), Color.White)
Next
Canvas.DrawGradient(New Rectangle(0, 0, CInt(Core.windowSize.Width), 200), New Color(42, 167, 198), New Color(42, 167, 198, 0), False, -1)
Canvas.DrawGradient(New Rectangle(0, CInt(Core.windowSize.Height - 200), CInt(Core.windowSize.Width), 200), New Color(42, 167, 198, 0), New Color(42, 167, 198), False, -1)
Core.SpriteBatch.DrawString(FontManager.MainFont, "Configure the filters:", New Vector2(100, 24), Color.White, 0.0F, Vector2.Zero, 2.0F, SpriteEffects.None, 0.0F)
For i = Scroll To Scroll + 5
If i <= Me.mainMenuItems.Count - 1 Then
Dim p As Integer = i - Scroll
Core.SpriteBatch.Draw(Me.texture, New Rectangle(100, 100 + p * 96, 64, 64), New Rectangle(16, 16, 16, 16), Color.White)
Core.SpriteBatch.Draw(Me.texture, New Rectangle(100 + 64, 100 + p * 96, 64 * 8, 64), New Rectangle(32, 16, 16, 16), Color.White)
Core.SpriteBatch.Draw(Me.texture, New Rectangle(100 + 64 * 9, 100 + p * 96, 64, 64), New Rectangle(16, 16, 16, 16), Color.White, 0.0F, Vector2.Zero, SpriteEffects.FlipHorizontally, 0.0F)
Dim s As String = mainMenuItems(i)
If GetFilterText(mainMenuItems(i)) <> "" Then
s &= " (" & GetFilterText(mainMenuItems(i)) & ")"
Core.SpriteBatch.Draw(Me.texture, New Rectangle(120, 116 + p * 96, 32, 32), New Rectangle(16, 48, 16, 16), Color.White)
Else
Core.SpriteBatch.Draw(Me.texture, New Rectangle(120, 116 + p * 96, 32, 32), New Rectangle(16, 32, 16, 16), Color.White)
End If
Core.SpriteBatch.DrawString(FontManager.MainFont, s, New Vector2(160, 116 + p * 96), Color.Black, 0.0F, Vector2.Zero, 1.25F, SpriteEffects.None, 0.0F)
End If
Next
If Filters.Count > 0 Then
Core.SpriteBatch.DrawString(FontManager.MainFont, "Results: " & Environment.NewLine & Environment.NewLine & "Filters: ", New Vector2(90 + 64 * 11, 119), Color.Black)
Core.SpriteBatch.DrawString(FontManager.MainFont, Me.Results & Environment.NewLine & Environment.NewLine & Me.Filters.Count, New Vector2(190 + 64 * 11, 119), Color.White)
End If
If Menu.Visible = True Then
Menu.Draw()
Else
DrawCursor()
End If
End Sub
Private Function GetFilterText(ByVal filterTypeString As String) As String
For Each f As StorageSystemScreen.Filter In Me.Filters
If f.FilterType.ToString().ToLower() = filterTypeString.ToLower() Then
Return f.FilterValue
End If
Next
Return ""
End Function
Private Sub DrawCursor()
Dim cPosition As Vector2 = New Vector2(520, 100 + Me.Cursor * 96 - 42)
Dim t As Texture2D = TextureManager.GetTexture("GUI\Menus\General", New Rectangle(0, 0, 16, 16), "")
Core.SpriteBatch.Draw(t, New Rectangle(CInt(cPosition.X), CInt(cPosition.Y), 64, 64), Color.White)
End Sub
Private Sub ApplyFilters()
Me._storageSystemScreen.Filters.Clear()
For Each f As StorageSystemScreen.Filter In Me.Filters
Me._storageSystemScreen.Filters.Add(f)
Next
End Sub
Public Overrides Sub Update()
If Menu.Visible = True Then
Menu.Update()
Else
If Controls.Down(True, True, True, True, True, True) = True Then
Me.Cursor += 1
If Controls.ShiftDown() = True Then
Me.Cursor += 4
End If
End If
If Controls.Up(True, True, True, True, True, True) = True Then
Me.Cursor -= 1
If Controls.ShiftDown() = True Then
Me.Cursor -= 4
End If
End If
While Me.Cursor > 5
Me.Cursor -= 1
Me.Scroll += 1
End While
While Me.Cursor < 0
Me.Cursor += 1
Me.Scroll -= 1
End While
If Me.mainMenuItems.Count < 7 Then
Me.Scroll = 0
Else
Me.Scroll = Me.Scroll.Clamp(0, Me.mainMenuItems.Count - 6)
End If
If Me.mainMenuItems.Count < 6 Then
Me.Cursor = Me.Cursor.Clamp(0, Me.mainMenuItems.Count - 1)
Else
Me.Cursor = Me.Cursor.Clamp(0, 5)
End If
If Me.mainMenuItems.Count > 0 Then
If Controls.Accept(True, False, False) = True Then
For i = Scroll To Scroll + 5
If i <= Me.mainMenuItems.Count - 1 Then
If New Rectangle(100, 100 + (i - Scroll) * 96, 640, 64).Contains(MouseHandler.MousePosition) = True Then
If i = Cursor + Scroll Then
SelectFilter()
Else
Cursor = i - Scroll
End If
End If
End If
Next
End If
If Controls.Accept(False, True, True) = True Then
SelectFilter()
End If
End If
If Controls.Dismiss(True, True, True) = True Then
ApplyFilters()
Core.SetScreen(Me._storageSystemScreen)
End If
End If
CalculateResults()
StorageSystemScreen.TileOffset += 1
If StorageSystemScreen.TileOffset >= 64 Then
StorageSystemScreen.TileOffset = 0
End If
End Sub
Private Sub CalculateResults()
Dim s As String = ""
Dim s1 As String = ""
For Each f As StorageSystemScreen.Filter In Me.CalculatedFilters
s &= f.FilterType.ToString() & "|" & f.FilterValue
Next
For Each f As StorageSystemScreen.Filter In Me.Filters
s1 &= f.FilterType.ToString() & "|" & f.FilterValue
Next
If s1 <> s Then
Me.CalculatedFilters.Clear()
For Each f As StorageSystemScreen.Filter In Me.Filters
Me.CalculatedFilters.Add(f)
Next
ApplyFilters()
Me.Results = Me._storageSystemScreen.GetPokemonList(True, True).Count
End If
End Sub
Private Sub SelectFilter()
Dim filterType As String = Me.mainMenuItems(Me.Scroll + Me.Cursor)
Select Case filterType.ToLower()
Case "pokémon"
Me.OpenPokemonMenu()
Case "type1"
Me.OpenType1Menu()
Case "type2"
Me.OpenType2Menu()
Case "move"
Me.OpenMoveMenu()
Case "ability"
Me.OpenAbilityMenu()
Case "nature"
Me.OpenNatureMenu()
Case "gender"
Me.OpenGenderMenu()
Case "helditem"
Me.OpenHeldItemMenu()
End Select
End Sub
#Region "PokémonFilter"
Private Sub OpenPokemonMenu()
Dim l As List(Of Pokemon) = Me._storageSystemScreen.GetPokemonList(True, False)
Dim letters As New List(Of String)
For Each p As Pokemon In l
If letters.Contains(p.GetName()(0).ToString().ToUpper()) = False Then
letters.Add(p.GetName()(0).ToString().ToUpper())
End If
Next
letters = (From letter As String In letters Order By letter Ascending).ToList()
letters.Add("Back")
If GetFilterText("Pokémon") <> "" Then
letters.Insert(0, "Clear")
End If
Me.Menu = New SelectMenu(letters, 0, AddressOf SelectPokemonLetter, -1)
End Sub
Private Sub SelectPokemonLetter(ByVal s As SelectMenu)
Select Case s.SelectedItem
Case "Back"
' Go back.
Case "Clear"
For Each Filter As StorageSystemScreen.Filter In Me.Filters
If Filter.FilterType = StorageSystemScreen.FilterTypes.Pokémon Then
Filters.Remove(Filter)
Exit For
End If
Next
Case Else
Dim chosenLetter As String = s.SelectedItem
Dim pokemonList As New List(Of String)
Dim l As List(Of Pokemon) = Me._storageSystemScreen.GetPokemonList(True, False)
For Each p As Pokemon In l
If p.GetName(0).ToString().ToUpper() = chosenLetter And pokemonList.Contains(p.GetName()) = False Then
pokemonList.Add(p.GetName)
End If
Next
pokemonList = (From name As String In pokemonList Order By name Ascending).ToList()
pokemonList.Add("Back")
Me.Menu = New SelectMenu(pokemonList, 0, AddressOf SelectPokemon, -1)
End Select
End Sub
Private Sub SelectPokemon(ByVal s As SelectMenu)
If s.SelectedItem <> "Back" Then
For Each Filter As StorageSystemScreen.Filter In Me.Filters
If Filter.FilterType = StorageSystemScreen.FilterTypes.Pokémon Then
Filters.Remove(Filter)
Exit For
End If
Next
Me.Filters.Add(New StorageSystemScreen.Filter() With {.FilterType = StorageSystemScreen.FilterTypes.Pokémon, .FilterValue = s.SelectedItem})
Else
OpenPokemonMenu()
End If
End Sub
#End Region
#Region "Type1Filter"
Private Sub OpenType1Menu()
Dim l As List(Of Pokemon) = Me._storageSystemScreen.GetPokemonList(True, False)
Dim types As New List(Of String)
For Each p As Pokemon In l
If types.Contains(p.Type1.Type.ToString()) = False Then
types.Add(p.Type1.Type.ToString())
End If
Next
types = (From type As String In types Order By type Ascending).ToList()
types.Add("Back")
If GetFilterText("Type1") <> "" Then
types.Insert(0, "Clear")
End If
Me.Menu = New SelectMenu(types, 0, AddressOf SelectType1Type, -1)
End Sub
Private Sub SelectType1Type(ByVal s As SelectMenu)
Select Case s.SelectedItem
Case "Back"
' Go back.
Case "Clear"
For Each Filter As StorageSystemScreen.Filter In Me.Filters
If Filter.FilterType = StorageSystemScreen.FilterTypes.Type1 Then
Filters.Remove(Filter)
Exit For
End If
Next
Case Else
For Each Filter As StorageSystemScreen.Filter In Me.Filters
If Filter.FilterType = StorageSystemScreen.FilterTypes.Type1 Then
Filters.Remove(Filter)
Exit For
End If
Next
Me.Filters.Add(New StorageSystemScreen.Filter() With {.FilterType = StorageSystemScreen.FilterTypes.Type1, .FilterValue = s.SelectedItem})
End Select
End Sub
#End Region
#Region "Type2Filter"
Private Sub OpenType2Menu()
Dim l As List(Of Pokemon) = Me._storageSystemScreen.GetPokemonList(True, False)
Dim types As New List(Of String)
For Each p As Pokemon In l
If types.Contains(p.Type2.Type.ToString()) = False Then
types.Add(p.Type2.Type.ToString())
End If
Next
types = (From type As String In types Order By type Ascending).ToList()
types.Add("Back")
If GetFilterText("Type2") <> "" Then
types.Insert(0, "Clear")
End If
Me.Menu = New SelectMenu(types, 0, AddressOf SelectType2Type, -1)
End Sub
Private Sub SelectType2Type(ByVal s As SelectMenu)
Select Case s.SelectedItem
Case "Back"
' Go back.
Case "Clear"
For Each Filter As StorageSystemScreen.Filter In Me.Filters
If Filter.FilterType = StorageSystemScreen.FilterTypes.Type2 Then
Filters.Remove(Filter)
Exit For
End If
Next
Case Else
For Each Filter As StorageSystemScreen.Filter In Me.Filters
If Filter.FilterType = StorageSystemScreen.FilterTypes.Type2 Then
Filters.Remove(Filter)
Exit For
End If
Next
Me.Filters.Add(New StorageSystemScreen.Filter() With {.FilterType = StorageSystemScreen.FilterTypes.Type2, .FilterValue = s.SelectedItem})
End Select
End Sub
#End Region
#Region "MoveFilter"
Private Sub OpenMoveMenu()
Dim l As List(Of Pokemon) = Me._storageSystemScreen.GetPokemonList(True, False)
Dim letters As New List(Of String)
For Each p As Pokemon In l
For Each a As BattleSystem.Attack In p.Attacks
If letters.Contains(a.Name(0).ToString().ToUpper()) = False Then
letters.Add(a.Name(0).ToString().ToUpper())
End If
Next
Next
letters = (From letter As String In letters Order By letter Ascending).ToList()
letters.Add("Back")
If GetFilterText("Move") <> "" Then
letters.Insert(0, "Clear")
End If
Me.Menu = New SelectMenu(letters, 0, AddressOf SelectMoveLetter, -1)
End Sub
Private Sub SelectMoveLetter(ByVal s As SelectMenu)
Select Case s.SelectedItem
Case "Back"
' Go back.
Case "Clear"
For Each Filter As StorageSystemScreen.Filter In Me.Filters
If Filter.FilterType = StorageSystemScreen.FilterTypes.Move Then
Filters.Remove(Filter)
Exit For
End If
Next
Case Else
Dim chosenLetter As String = s.SelectedItem
Dim attackList As New List(Of String)
Dim l As List(Of Pokemon) = Me._storageSystemScreen.GetPokemonList(True, False)
For Each p As Pokemon In l
For Each a As BattleSystem.Attack In p.Attacks
If a.Name(0).ToString().ToUpper() = chosenLetter And attackList.Contains(a.Name) = False Then
attackList.Add(a.Name)
End If
Next
Next
attackList = (From name As String In attackList Order By name Ascending).ToList()
attackList.Add("Back")
Me.Menu = New SelectMenu(attackList, 0, AddressOf SelectMove, -1)
End Select
End Sub
Private Sub SelectMove(ByVal s As SelectMenu)
If s.SelectedItem <> "Back" Then
For Each Filter As StorageSystemScreen.Filter In Me.Filters
If Filter.FilterType = StorageSystemScreen.FilterTypes.Move Then
Filters.Remove(Filter)
Exit For
End If
Next
Me.Filters.Add(New StorageSystemScreen.Filter() With {.FilterType = StorageSystemScreen.FilterTypes.Move, .FilterValue = s.SelectedItem})
Else
OpenMoveMenu()
End If
End Sub
#End Region
#Region "AbilityFilter"
Private Sub OpenAbilityMenu()
Dim l As List(Of Pokemon) = Me._storageSystemScreen.GetPokemonList(True, False)
Dim letters As New List(Of String)
For Each p As Pokemon In l
If letters.Contains(p.Ability.Name(0).ToString().ToUpper()) = False Then
letters.Add(p.Ability.Name(0).ToString().ToUpper())
End If
Next
letters = (From letter As String In letters Order By letter Ascending).ToList()
letters.Add("Back")
If GetFilterText("Ability") <> "" Then
letters.Insert(0, "Clear")
End If
Me.Menu = New SelectMenu(letters, 0, AddressOf SelectAbilityLetter, -1)
End Sub
Private Sub SelectAbilityLetter(ByVal s As SelectMenu)
Select Case s.SelectedItem
Case "Back"
' Go back.
Case "Clear"
For Each Filter As StorageSystemScreen.Filter In Me.Filters
If Filter.FilterType = StorageSystemScreen.FilterTypes.Ability Then
Filters.Remove(Filter)
Exit For
End If
Next
Case Else
Dim chosenLetter As String = s.SelectedItem
Dim abilityList As New List(Of String)
Dim l As List(Of Pokemon) = Me._storageSystemScreen.GetPokemonList(True, False)
For Each p As Pokemon In l
If p.Ability.Name(0).ToString().ToUpper() = chosenLetter And abilityList.Contains(p.Ability.Name) = False Then
abilityList.Add(p.Ability.Name)
End If
Next
abilityList = (From name As String In abilityList Order By name Ascending).ToList()
abilityList.Add("Back")
Me.Menu = New SelectMenu(abilityList, 0, AddressOf SelectAbility, -1)
End Select
End Sub
Private Sub SelectAbility(ByVal s As SelectMenu)
If s.SelectedItem <> "Back" Then
For Each Filter As StorageSystemScreen.Filter In Me.Filters
If Filter.FilterType = StorageSystemScreen.FilterTypes.Ability Then
Filters.Remove(Filter)
Exit For
End If
Next
Me.Filters.Add(New StorageSystemScreen.Filter() With {.FilterType = StorageSystemScreen.FilterTypes.Ability, .FilterValue = s.SelectedItem})
Else
OpenAbilityMenu()
End If
End Sub
#End Region
#Region "NatureFilter"
Private Sub OpenNatureMenu()
Dim l As List(Of Pokemon) = Me._storageSystemScreen.GetPokemonList(True, False)
Dim natures As New List(Of String)
For Each p As Pokemon In l
If natures.Contains(p.Nature.ToString()) = False Then
natures.Add(p.Nature.ToString())
End If
Next
natures = (From nature As String In natures Order By nature Ascending).ToList()
natures.Add("Back")
If GetFilterText("Nature") <> "" Then
natures.Insert(0, "Clear")
End If
Me.Menu = New SelectMenu(natures, 0, AddressOf SelectNatureType, -1)
End Sub
Private Sub SelectNatureType(ByVal s As SelectMenu)
Select Case s.SelectedItem
Case "Back"
' Go back.
Case "Clear"
For Each Filter As StorageSystemScreen.Filter In Me.Filters
If Filter.FilterType = StorageSystemScreen.FilterTypes.Nature Then
Filters.Remove(Filter)
Exit For
End If
Next
Case Else
For Each Filter As StorageSystemScreen.Filter In Me.Filters
If Filter.FilterType = StorageSystemScreen.FilterTypes.Nature Then
Filters.Remove(Filter)
Exit For
End If
Next
Me.Filters.Add(New StorageSystemScreen.Filter() With {.FilterType = StorageSystemScreen.FilterTypes.Nature, .FilterValue = s.SelectedItem})
End Select
End Sub
#End Region
#Region "GenderFilter"
Private Sub OpenGenderMenu()
Dim l As List(Of Pokemon) = Me._storageSystemScreen.GetPokemonList(True, False)
Dim genders As New List(Of String)
For Each p As Pokemon In l
If genders.Contains(p.Gender.ToString()) = False Then
genders.Add(p.Gender.ToString())
End If
Next
genders = (From gender As String In genders Order By gender Ascending).ToList()
genders.Add("Back")
If GetFilterText("Gender") <> "" Then
genders.Insert(0, "Clear")
End If
Me.Menu = New SelectMenu(genders, 0, AddressOf SelectGenderType, -1)
End Sub
Private Sub SelectGenderType(ByVal s As SelectMenu)
Select Case s.SelectedItem
Case "Back"
' Go back.
Case "Clear"
For Each Filter As StorageSystemScreen.Filter In Me.Filters
If Filter.FilterType = StorageSystemScreen.FilterTypes.Gender Then
Filters.Remove(Filter)
Exit For
End If
Next
Case Else
For Each Filter As StorageSystemScreen.Filter In Me.Filters
If Filter.FilterType = StorageSystemScreen.FilterTypes.Gender Then
Filters.Remove(Filter)
Exit For
End If
Next
Me.Filters.Add(New StorageSystemScreen.Filter() With {.FilterType = StorageSystemScreen.FilterTypes.Gender, .FilterValue = s.SelectedItem})
End Select
End Sub
#End Region
#Region "HeldItemFilter"
Private Sub OpenHeldItemMenu()
Dim l As List(Of Pokemon) = Me._storageSystemScreen.GetPokemonList(True, False)
Dim helditems As List(Of String) = {"Has a Held Item", "Has no Held Item", "Back"}.ToList()
If GetFilterText("HeldItem") <> "" Then
helditems.Insert(0, "Clear")
End If
Me.Menu = New SelectMenu(helditems, 0, AddressOf SelectHeldItemType, -1)
End Sub
Private Sub SelectHeldItemType(ByVal s As SelectMenu)
Select Case s.SelectedItem
Case "Back"
' Go back.
Case "Clear"
For Each Filter As StorageSystemScreen.Filter In Me.Filters
If Filter.FilterType = StorageSystemScreen.FilterTypes.HeldItem Then
Filters.Remove(Filter)
Exit For
End If
Next
Case Else
For Each Filter As StorageSystemScreen.Filter In Me.Filters
If Filter.FilterType = StorageSystemScreen.FilterTypes.HeldItem Then
Filters.Remove(Filter)
Exit For
End If
Next
Me.Filters.Add(New StorageSystemScreen.Filter() With {.FilterType = StorageSystemScreen.FilterTypes.HeldItem, .FilterValue = s.SelectedItem})
End Select
End Sub
#End Region
End Class
Reference in New Issue View Git Blame Copy Permalink