Imports P3D.Screens.UI ''' ''' Displays the inventory and gives the player options to choose and use items. ''' Public Class NewInventoryScreen Inherits Screen Implements ISelectionScreen 'Private _translation As Globalization.Classes.LOCAL_InventoryScreen Private target_1 As RenderTarget2D Private target_2 As RenderTarget2D Private itemBatch As CoreSpriteBatch Private infoBatch As CoreSpriteBatch ''' ''' Texture from file: GUI\Menus\General ''' Private _texture As Texture2D ''' ''' Texture from file: GUI\Menus\Inventory ''' Private _menuTexture As Texture2D 'Stores the current tab index and if the player is controlling the tab list: Private _tabIndex As Integer = 0 Private _tabInControl As Boolean = True 'We have 8 indexes for the current page and item on that page (0-9) here, for each tab: Private _itemindex As Integer() = {0, 0, 0, 0, 0, 0, 0, 0} Private _pageIndex As Integer() = {0, 0, 0, 0, 0, 0, 0, 0} 'Shows amount window if tossing item when true Private _tossingItems As Boolean = False Private _tossValue As Integer = 1 'Stuff related to blurred PreScreens Private _preScreenTexture As RenderTarget2D Private _preScreenTarget As RenderTarget2D Private _blurScreens As Identifications() = {Identifications.BattleScreen, Identifications.OverworldScreen, Identifications.MailSystemScreen} ''' ''' The item index of the current tab and page: ''' Private Property ItemIndex As Integer Get Return _itemindex(_tabIndex) End Get Set(value As Integer) _itemindex(_tabIndex) = value End Set End Property ''' ''' The page index for the current tab. ''' Private Property PageIndex As Integer Get Return _pageIndex(_tabIndex) End Get Set(value As Integer) _pageIndex(_tabIndex) = value End Set End Property 'Stores a value from 0-255 for each tab that determines their light state when scrolling over it. Private _tabHighlight As Integer() = {0, 0, 0, 0, 0, 0, 0, 0} 'Interface animation state values: Private _interfaceFade As Single = 0F Private _closing As Boolean = False Private _enrollY As Single = 0F Private _itemIntro As Single = 0F 'Item animation: Private Class ItemAnimation Public _shakeV As Single Public _shakeLeft As Boolean Public _shakeCount As Integer End Class 'The current state for the item animations: Private _itemAnimation As ItemAnimation 'If the info popup is visible: Private _isInfoShowing As Boolean = False 'Info popup state information: Private _infoSide As Integer = 0 '0 = left, 1 = right Private _infoSize As Integer = 0 Private _infoSizeTarget As Integer = 0 Private _infoPosition As Integer = 0 Private _infoPositionTarget As Integer = 0 Private _itemColumnLeft As Integer = 0 'Until which item column is considered left Private _itemColumnLeftOffset As Integer = 0 Private _itemColumnLeftOffsetTarget As Integer = 0 Private _itemColumnRightOffset As Integer = 0 Private _itemColumnRightOffsetTarget As Integer = 0 'Selectable options for items. ' - Use ' - Give (to pokémon) ' - Toss ' - Select '#EC_NO_TRANSLATION: Private Const INFO_ITEM_OPTION_USE As String = "USE" Private Const INFO_ITEM_OPTION_GIVE As String = "GIVE" Private Const INFO_ITEM_OPTION_TOSS As String = "TOSS" Private Const INFO_ITEM_OPTION_SELECT As String = "SELECT" Private _infoItemOptions As New List(Of String) Private _infoItemOptionsNormal As New List(Of String) 'Contains untranslated strings. Private _infoItemOptionSize As Integer() = {0, 0, 0} Private _infoItemOptionSelection As Integer = 0 'Items for the current tab: Private _items As PlayerInventory.ItemContainer() 'Displays a message box: Private _messageDelay As Single = 0F Private _messageText As String = "" 'experiment Public Delegate Sub DoStuff(ByVal ItemID As Integer) Dim ReturnItem As DoStuff Dim AllowedPages() As Integer Public Sub New(ByVal currentScreen As Screen, ByVal AllowedPages As Integer(), ByVal StartPageIndex As Integer, ByVal DoStuff As DoStuff) _preScreenTarget = New RenderTarget2D(GraphicsDevice, windowSize.Width, windowSize.Height) _blur = New Resources.Blur.BlurHandler(windowSize.Width, windowSize.Height) _tabIndex = StartPageIndex Me.AllowedPages = AllowedPages ReturnItem = DoStuff 'JSON Stuff '_translation = New Globalization.Classes.LOCAL_InventoryScreen() target_1 = New RenderTarget2D(GraphicsDevice, 816, 400 - 32, False, SurfaceFormat.Color, DepthFormat.Depth24Stencil8, 0, RenderTargetUsage.PreserveContents) target_2 = New RenderTarget2D(GraphicsDevice, 500, 368, False, SurfaceFormat.Color, DepthFormat.Depth24Stencil8) itemBatch = New CoreSpriteBatch(GraphicsDevice) infoBatch = New CoreSpriteBatch(GraphicsDevice) Identification = Identifications.InventoryScreen PreScreen = currentScreen IsDrawingGradients = True _texture = TextureManager.GetTexture("GUI\Menus\General") _menuTexture = TextureManager.GetTexture("GUI\Menus\Inventory") ''DEBUG: Add all items in the game to the inventory: 'For i = 1 To 2500 ' Dim cItem As Item = Item.GetItemByID(i) ' If Not cItem Is Nothing Then ' Core.Player.Inventory.AddItem(cItem.ID, 1) ' End If 'Next ResetAnimation() ' Set up the default visible item types configuration: _visibleItemTypes = New Items.ItemTypes() {Items.ItemTypes.Standard, Items.ItemTypes.Medicine, Items.ItemTypes.Plants, Items.ItemTypes.Pokéballs, Items.ItemTypes.Machines, Items.ItemTypes.Mail, Items.ItemTypes.BattleItems, Items.ItemTypes.KeyItems} 'TODO: Load state information from the PlayerTemp. _tabHighlight(_tabIndex) = 255 'Load the items once when loading up the inventory screen: LoadItems() End Sub Public Sub New(ByVal currentScreen As Screen, ByVal AllowedPages() As Integer, ByVal DoStuff As DoStuff) Me.New(currentScreen, AllowedPages, Player.Temp.BagIndex, DoStuff) End Sub Public Sub New(ByVal currentScreen As Screen) Me.New(currentScreen, {}, Player.Temp.BagIndex, Nothing) End Sub Public Overrides Sub Draw() If _blurScreens.Contains(PreScreen.Identification) Then DrawPrescreen() Else PreScreen.Draw() End If DrawGradients(CInt(255 * _interfaceFade)) DrawMain() DrawTabs() DrawMessage() PokemonImageView.Draw() TextBox.Draw() ChooseBox.Draw() DrawAmount() End Sub Private _blur As Resources.Blur.BlurHandler Private Sub DrawPrescreen() If _preScreenTexture Is Nothing OrElse _preScreenTexture.IsContentLost Then SpriteBatch.EndBatch() Dim target As RenderTarget2D = _preScreenTarget GraphicsDevice.SetRenderTarget(target) GraphicsDevice.Clear(BackgroundColor) SpriteBatch.BeginBatch() PreScreen.Draw() SpriteBatch.EndBatch() GraphicsDevice.SetRenderTarget(Nothing) SpriteBatch.BeginBatch() _preScreenTexture = target End If SpriteBatch.Draw(_blur.Perform(_preScreenTexture), windowSize, Color.White) End Sub ''' ''' Draws the temporary message. ''' Private Sub DrawMessage() If _messageDelay > 0F Then Dim textFade As Single = 1.0F If _messageDelay <= 1.0F Then textFade = _messageDelay End If Canvas.DrawRectangle(New Rectangle(CInt(Core.windowSize.Width / 2 - 150), CInt(Core.windowSize.Height - 200), 300, 100), New Color(0, 0, 0, CInt(150 * textFade * _interfaceFade))) Dim text As String = _messageText.CropStringToWidth(FontManager.ChatFont, 250) Dim size As Vector2 = FontManager.ChatFont.MeasureString(text) SpriteBatch.DrawString(FontManager.ChatFont, text, New Vector2(CSng(Core.windowSize.Width / 2 - size.X / 2), CSng(Core.windowSize.Height - 150 - size.Y / 2)), New Color(255, 255, 255, CInt(255 * textFade * _interfaceFade))) End If End Sub ''' ''' Draws the tabs on the top of the UI. ''' Private Sub DrawTabs() Dim halfWidth As Integer = CInt(Core.windowSize.Width / 2) Dim halfHeight As Integer = CInt(Core.windowSize.Height / 2) Dim mainBackgroundColor As Color = Color.White If _closing = True Then mainBackgroundColor = New Color(255, 255, 255, CInt(255 * _interfaceFade)) End If For x = 0 To 368 Step 16 Dim cTabIndex As Integer = CInt(Math.Floor(x / 48)) Dim bgColor As Color = Color.White If cTabIndex <> _tabIndex And cTabIndex < _tabHighlight.Length Then Dim gC As Integer = 128 + CInt(128 * (_tabHighlight(cTabIndex) / 255)) bgColor = New Color(gC, gC, gC) End If If _closing Then bgColor = New Color(bgColor.R, bgColor.G, bgColor.B, CInt(CInt(bgColor.A) * _interfaceFade)) End If For y = 0 To 32 Step 16 SpriteBatch.Draw(_menuTexture, New Rectangle(halfWidth - 400 + x, halfHeight - 200 + y, 16, 16), New Rectangle(0, 0, 4, 4), bgColor) Next If x Mod 48 = 32 Then SpriteBatch.Draw(_menuTexture, New Rectangle(halfWidth - 400 + x - 24, halfHeight - 200 + 8, 32, 32), GetTabImageRect(cTabIndex), bgColor) End If Next Dim TabDesriptionWidth As Integer = 176 Dim TbgColor As New Color(128, 128, 128) If _closing Then TbgColor = New Color(TbgColor.R, TbgColor.G, TbgColor.B, CInt(CInt(TbgColor.A) * _interfaceFade)) End If For x = 0 To TabDesriptionWidth Step 16 For y = 0 To 32 Step 16 SpriteBatch.Draw(_menuTexture, New Rectangle(halfWidth - 400 + x + 384, halfHeight - 200 + y, 16, 16), New Rectangle(0, 0, 4, 4), TbgColor) Next Next Canvas.DrawGradient(Core.SpriteBatch, New Rectangle(halfWidth - 400 + 384 + TabDesriptionWidth + 16, halfHeight - 200, 800 - (384 + TabDesriptionWidth), 48), New Color(0, 0, 0, CInt(TbgColor.A * 0.5)), New Color(0, 0, 0, CInt(TbgColor.A * 0.00)), True, -1) Dim TabName As String = "" Select Case _tabIndex Case 0 : TabName = "Standard" Case 1 : TabName = "Medicine" Case 2 : TabName = "Plants" Case 3 : TabName = "Pokéball" Case 4 : TabName = "TM/HM" Case 5 : TabName = "Mail" Case 6 : TabName = "Battle Items" Case 7 : TabName = "Key Items" End Select Dim gColor As New Color(164, 164, 164) If _closing Then gColor = New Color(gColor.R, gColor.G, gColor.B, CInt(CInt(gColor.A) * _interfaceFade)) End If Dim fontWidth As Integer = CInt(FontManager.ChatFont.MeasureString(TabName).X) SpriteBatch.DrawString(FontManager.ChatFont, TabName, New Vector2(halfWidth - 400 + 384 + CInt((TabDesriptionWidth - fontWidth) * 0.5), halfHeight - 200 + 12), gColor) End Sub ''' ''' Draws the main content. ''' Private Sub DrawMain() 'Calculate the center of the screen: Dim halfWidth As Integer = CInt(Core.windowSize.Width / 2) Dim halfHeight As Integer = CInt(Core.windowSize.Height / 2) 'When the interface is fading in/out, use a custom alpha: Dim mainBackgroundColor As Color = Color.White If _closing = True Then mainBackgroundColor = New Color(255, 255, 255, CInt(255 * _interfaceFade)) End If Canvas.DrawRectangle(New Rectangle(halfWidth - 400, halfHeight - 232, 260, 32), New Color(84, 198, 216, mainBackgroundColor.A)) Canvas.DrawRectangle(New Rectangle(halfWidth - 140, halfHeight - 216, 16, 16), New Color(84, 198, 216, mainBackgroundColor.A)) SpriteBatch.Draw(_texture, New Rectangle(halfWidth - 140, halfHeight - 232, 16, 16), New Rectangle(80, 0, 16, 16), mainBackgroundColor) SpriteBatch.Draw(_texture, New Rectangle(halfWidth - 124, halfHeight - 216, 16, 16), New Rectangle(80, 0, 16, 16), mainBackgroundColor) SpriteBatch.DrawString(FontManager.ChatFont, "Inventory", New Vector2(halfWidth - 390, halfHeight - 228), mainBackgroundColor) 'Draw background pattern: For y = 0 To CInt(_enrollY) Step 16 For x = 0 To 800 Step 16 SpriteBatch.Draw(_texture, New Rectangle(halfWidth - 400 + x, halfHeight - 200 + y, 16, 16), New Rectangle(64, 0, 4, 4), mainBackgroundColor) Next Next 'This draws the lowest row so the background is not cut off: Dim modRes As Integer = CInt(_enrollY) Mod 16 If modRes > 0 Then For x = 0 To 800 Step 16 SpriteBatch.Draw(_texture, New Rectangle(halfWidth - 400 + x, CInt(_enrollY + (halfHeight - 200)), 16, modRes), New Rectangle(64, 0, 4, 4), mainBackgroundColor) Next End If 'Create a render target and render the items to it. 'We do this because the items move to the left/right "outside" of the screen. 'So we don't need to fiddle around with the offset, we just move them outside the render target. If CInt(_enrollY) - 32 > 0 Then 'Only draw, when the size is at least 1 pixel high. 'Bring back when Monogame begins supporting this stuff ' Dim target As New RenderTarget2D(GraphicsDevice, 816, CInt(_enrollY) - 32, False, GraphicsDevice.PresentationParameters.BackBufferFormat, DepthFormat.Depth24Stencil8, 0, RenderTargetUsage.PreserveContents) GraphicsDevice.SetRenderTarget(target_1) GraphicsDevice.Clear(Color.Transparent) 'Create a designated sprite batch: itemBatch.BeginBatch() Dim itemPanelAlpha As Integer = CInt(If(_tabInControl, 180, 255) * _interfaceFade) Dim iX, iY As Integer For i = 0 To 9 iX = CInt(Math.Floor(i / 2)) iY = i Mod 2 If _items.Length > i + (PageIndex * 10) Then Dim cItem = Item.GetItemByID(_items(i + (PageIndex * 10)).ItemID) If _itemIntro >= i / 10 Then Dim Yoffset As Integer = 0 If _itemIntro < (i + 1) / 10 Then Yoffset = CInt((_itemIntro - (i / 10)) * 80) End If Dim XOffset As Integer = ComputeXOffset(iX) Dim itemLoc = New Vector2(iX * 160 + 32 + XOffset, 48 + iY * 160 + 32) Dim size As Integer = If(i = ItemIndex, 96, 72) itemBatch.Draw(cItem.Texture, New Rectangle(CInt(itemLoc.X) + 48, CInt(itemLoc.Y) + Yoffset, size, size), Nothing, New Color(255, 255, 255, itemPanelAlpha), If(i = ItemIndex, _itemAnimation._shakeV, 0F), New Vector2(cItem.Texture.Width / 2.0F), SpriteEffects.None, 0F) Dim nameTextHeight As Integer = 24 If _tabIndex = 4 Then nameTextHeight = 40 End If Canvas.DrawRectangle(itemBatch, New Rectangle(CInt(itemLoc.X) - 16, CInt(itemLoc.Y) + 48, 128, nameTextHeight), New Color(0, 0, 0, CInt(If(_tabInControl, 64, 128) * _interfaceFade))) Dim fontWidth As Integer = CInt(FontManager.MiniFont.MeasureString(cItem.Name).X) itemBatch.DrawString(FontManager.MiniFont, cItem.Name, itemLoc + New Vector2(48 - fontWidth / 2.0F, 51), New Color(255, 255, 255, itemPanelAlpha)) If _tabIndex <> 7 Then itemBatch.DrawString(FontManager.MiniFont, "x" & _items(i + (PageIndex * 10)).Amount.ToString(), itemLoc + New Vector2(84, 26), New Color(40, 40, 40, itemPanelAlpha)) End If If _tabIndex = 4 Then Dim AttackName As String = CType(cItem, Items.TechMachine).Attack.Name Dim TMfontWidth As Integer = CInt(FontManager.MiniFont.MeasureString(AttackName).X) itemBatch.DrawString(FontManager.MiniFont, AttackName, itemLoc + New Vector2(48 - TMfontWidth / 2.0F, 51 + 16), New Color(255, 255, 255, itemPanelAlpha)) End If End If End If Next 'When the info is visible, draw it: If _infoSize > 0 Then DrawInfo(itemBatch, target_1) End If itemBatch.EndBatch() 'Reset to back buffer and render the result: GraphicsDevice.SetRenderTarget(Nothing) Dim drawheight As Integer = 368 If _closing Then drawheight = CInt(_enrollY) - 32 End If SpriteBatch.Draw(target_1, New Rectangle(halfWidth - 400, halfHeight - 200 + 48, 816, drawheight), mainBackgroundColor) End If End Sub ''' ''' Draws the info popup. ''' Private Sub DrawInfo(ByVal preBatch As SpriteBatch, ByVal preTarget As RenderTarget2D) 'Create a new render target and set it. 'Bring back when Monogame begins supporting this stuff ' Dim target As New RenderTarget2D(GraphicsDevice, _infoSize, 368, False, GraphicsDevice.PresentationParameters.BackBufferFormat, DepthFormat.Depth24Stencil8, 0, RenderTargetUsage.PreserveContents) GraphicsDevice.SetRenderTarget(target_2) GraphicsDevice.Clear(Color.Transparent) 'Render background: infoBatch.BeginBatch() Dim alpha = CInt(CSng(_infoSize) / 500 * 255) For y = 0 To 368 Step 16 For x = 0 To _infoSize + 16 Step 16 If x < _infoSize - 16 Then infoBatch.Draw(_menuTexture, New Rectangle(x, y, 16, 16), New Rectangle(0, 0, 4, 4), New Color(128, 128, 128, alpha)) End If Next Next Canvas.DrawGradient(infoBatch, New Rectangle(0, 0, 100, 368), New Color(0, 0, 0, alpha), New Color(0, 0, 0, 0), True, -1) Canvas.DrawGradient(infoBatch, New Rectangle(_infoSize - 100, 0, 100, 368), New Color(0, 0, 0, 0), New Color(0, 0, 0, alpha), True, -1) 'Get item and gets its display texts based on the item category: Dim cItem As Item = Item.GetItemByID(_items(ItemIndex + PageIndex * 10).ItemID) infoBatch.Draw(cItem.Texture, New Rectangle(24, 24, 48, 48), Color.White) Dim itemTitle As String = cItem.Name Dim itemSubTitle As String = cItem.ItemType.ToString() Dim itemDescription As String = cItem.Description Select Case cItem.ItemType Case Items.ItemTypes.Machines Dim techMachine = CType(cItem, Items.TechMachine) itemTitle = techMachine.Attack.Name If techMachine.IsTM Then 'JSON stuff 'itemSubTitle = _translation.TECH_MACHINE_TITLE(cItem.ItemType.ToString()) itemSubTitle = "Technical Machine" Else 'JSON stuff 'itemSubTitle = _translation.HIDDEN_MACHINE_TITLE(cItem.ItemType.ToString()) itemSubTitle = "Hidden Machine" End If itemDescription &= Environment.NewLine & techMachine.Attack.Description Case Items.ItemTypes.Standard 'JSON stuff 'itemSubTitle = _translation.STANDARD_ITEM_TITLE(cItem.ItemType.ToString()) itemSubTitle = cItem.ItemType.ToString() & " Item" Case Items.ItemTypes.KeyItems 'JSON stuff 'itemSubTitle = _translation.KEYITEM_TITLE(cItem.ItemType.ToString()) itemSubTitle = "Key Item" Case Items.ItemTypes.Pokéballs 'JSON stuff 'itemSubTitle = _translation.POKEBALL_TITLE(cItem.ItemType.ToString()) itemSubTitle = "Poké Ball" Case Items.ItemTypes.Plants 'JSON stuff 'itemSubTitle = _translation.PLANT_TITLE(cItem.ItemType.ToString()) itemSubTitle = "Plant" Case Items.ItemTypes.BattleItems 'JSON stuff 'itemSubTitle = _translation.BATTLEITEM_TITLE(cItem.ItemType.ToString()) itemSubTitle = "Battle Item" End Select infoBatch.DrawString(FontManager.TextFont, itemTitle, New Vector2(80, 20), Color.White, 0F, Vector2.Zero, 2.0F, SpriteEffects.None, 0F) infoBatch.DrawString(FontManager.TextFont, itemSubTitle, New Vector2(80, 46), Color.LightGray, 0F, Vector2.Zero, 1.5F, SpriteEffects.None, 0F) infoBatch.DrawString(FontManager.TextFont, itemDescription.CropStringToWidth(FontManager.TextFont, 1.0F, 430), New Vector2(28, 84), Color.LightGray, 0F, Vector2.Zero, 1.0F, SpriteEffects.None, 0F) For i = 0 To _infoItemOptions.Count - 1 Canvas.DrawRectangle(infoBatch, New Rectangle(CInt(250 - _infoItemOptionSize(i) / 2), 158 + i * 64, _infoItemOptionSize(i), 48), New Color(255, 255, 255, 20)) infoBatch.DrawString(FontManager.TextFont, _infoItemOptions(i), New Vector2(CInt(250 - FontManager.TextFont.MeasureString(_infoItemOptions(i)).X), 168 + i * 64), Color.White, 0F, Vector2.Zero, 2.0F, SpriteEffects.None, 0F) Next infoBatch.EndBatch() 'Set the target that was previously active and render the new target on top of that: GraphicsDevice.SetRenderTarget(preTarget) preBatch.Draw(target_2, New Rectangle(_infoPosition + 80, 0, target_2.Width, target_2.Height), New Color(255, 255, 255, alpha)) End Sub ''' ''' Draws the amount of items to be tossed. ''' Private Sub DrawAmount() If _tossingItems Then Dim cItem As Item = Item.GetItemByID(_items(ItemIndex + PageIndex * 10).ItemID) Dim CanvasTexture As Texture2D CanvasTexture = TextureManager.GetTexture(TextureManager.GetTexture("GUI\Menus\Menu"), New Rectangle(0, 0, 48, 48)) Dim trashText As String = _tossValue & "/" & Core.Player.Inventory.GetItemAmount(cItem.ID) Dim offsetX As Integer = 100 Dim offsetY As Integer = Core.windowSize.Height - 390 Canvas.DrawImageBorder(CanvasTexture, 2, New Rectangle(CInt(Core.windowSize.Width / 2) + 180 + offsetX, 240 + offsetY, 128, 64)) Core.SpriteBatch.DrawString(FontManager.InGameFont, trashText, New Vector2(CInt(Core.windowSize.Width / 2) - (FontManager.InGameFont.MeasureString(trashText).X / 2) + 256 + offsetX, 276 + offsetY), Color.Black) End If End Sub ''' ''' Determines the x-offset of an item based on the value. ''' Private Function ComputeXOffset(ByVal itemPositionId As Integer) As Integer Dim i As Integer = itemPositionId 'Determine if we are in the left or right portion: Dim isLeft As Boolean = _itemColumnLeft >= i If isLeft Then Return _itemColumnLeftOffset Else Return _itemColumnRightOffset End If End Function ''' ''' Returns the texture rectangle that contains the tab image from GUI\Menus\Inventory. ''' ''' The tab index. Private Function GetTabImageRect(ByVal i As Integer) As Rectangle Select Case _visibleItemTypes(i) Case Items.ItemTypes.Standard Return New Rectangle(0, 16, 16, 16) Case Items.ItemTypes.Medicine Return New Rectangle(16, 16, 16, 16) Case Items.ItemTypes.Plants Return New Rectangle(0, 32, 16, 16) Case Items.ItemTypes.Pokéballs Return New Rectangle(48, 16, 16, 16) Case Items.ItemTypes.Machines Return New Rectangle(32, 16, 16, 16) Case Items.ItemTypes.Mail Return New Rectangle(16, 32, 16, 16) Case Items.ItemTypes.BattleItems Return New Rectangle(48, 32, 16, 16) Case Items.ItemTypes.KeyItems Return New Rectangle(32, 32, 16, 16) End Select End Function Public Overrides Sub Update() 'Updates the tab highlight: For index = 0 To _tabHighlight.Length - 1 If index <> _tabIndex Then If _tabHighlight(index) > 0 Then _tabHighlight(index) -= 15 If _tabHighlight(index) < 0 Then _tabHighlight(index) = 0 End If End If Else _tabHighlight(index) = 255 End If Next 'Update the message: If _messageDelay > 0F Then _messageDelay -= 0.1F If _messageDelay <= 0F Then _messageDelay = 0F End If End If If _closing Then ' When the interface is closing, only update the closing animation ' Once the interface is completely closed, set to the previous screen. If _interfaceFade > 0F Then _interfaceFade = MathHelper.Lerp(0, _interfaceFade, 0.8F) If _interfaceFade < 0F Then _interfaceFade = 0F End If End If If _enrollY > 0 Then _enrollY = MathHelper.Lerp(0, _enrollY, 0.8F) If _enrollY <= 0 Then _enrollY = 0 End If End If If _enrollY <= 2.0F Then 'TODO: Set the interface state to PlayerTemp. SetScreen(PreScreen) End If Else 'Update intro animation: Dim maxWindowHeight As Integer = 400 If _enrollY < maxWindowHeight Then _enrollY = MathHelper.Lerp(maxWindowHeight, _enrollY, 0.8F) If _enrollY >= maxWindowHeight Then _enrollY = maxWindowHeight End If End If If _interfaceFade < 1.0F Then _interfaceFade = MathHelper.Lerp(1.0F, _interfaceFade, 0.95F) If _interfaceFade > 1.0F Then _interfaceFade = 1.0F End If End If If _itemIntro < 1.0F Then _itemIntro += 0.05F If _itemIntro > 1.0F Then _itemIntro = 1.0F End If End If 'Control update: UpdateShakeAnimation() ' Input update: If TextBox.Showing = False And ChooseBox.Showing = False And PokemonImageView.Showing = False Then Dim isTabsSelected = _tabInControl UpdateTabs() If Not isTabsSelected Then If _isInfoShowing Then UpdateInfo() Else UpdateItems() End If End If End If 'Update the Dialogues: ChooseBox.Update() If ChooseBox.Showing = False Then TextBox.Update() End If If PokemonImageView.Showing = True Then PokemonImageView.Update() End If UpdateInfoAnimation() End If 'Update the toss amount indicator: If _tossingItems Then Dim cItem As Item = Item.GetItemByID(_items(ItemIndex + PageIndex * 10).ItemID) If Controls.Right(True, True, True, True) Then _tossValue += 1 End If If Controls.Left(True, True, True, True) Then _tossValue -= 1 End If _tossValue = CInt(MathHelper.Clamp(_tossValue, 1, Core.Player.Inventory.GetItemAmount(cItem.ID))) If Not TextBox.Showing Then If Controls.Accept Then Core.Player.Inventory.RemoveItem(cItem.ID, _tossValue) LoadItems() _tossingItems = False ElseIf Controls.Dismiss Then _tossingItems = False End If _tossValue = 1 End If End If End Sub Private Sub UpdateTabs() If Controls.Left(True, True, True, True, True, True) And _tabInControl Or ControllerHandler.ButtonPressed(Buttons.LeftShoulder) Then _tabIndex -= 1 If AllowedPages.Count > 0 And AllowedPages.Contains(_tabIndex) = False Then While AllowedPages.Contains(_tabIndex) = False _tabIndex -= 1 If _tabIndex < 0 Then _tabIndex = 7 ElseIf _tabIndex > 7 Then _tabIndex = 0 End If End While End If If _tabIndex < 0 Then _tabIndex = 7 ElseIf _tabIndex > 7 Then _tabIndex = 0 End If _itemIntro = 0F ResetAnimation() LoadItems() End If If Controls.Right(True, True, True, True, True, True) And _tabInControl Or ControllerHandler.ButtonPressed(Buttons.RightShoulder) Then _tabIndex += 1 If AllowedPages.Count > 0 And AllowedPages.Contains(_tabIndex) = False Then While AllowedPages.Contains(_tabIndex) = False _tabIndex += 1 If _tabIndex < 0 Then _tabIndex = 7 ElseIf _tabIndex > 7 Then _tabIndex = 0 End If End While End If If _tabIndex < 0 Then _tabIndex = 7 ElseIf _tabIndex > 7 Then _tabIndex = 0 End If _itemIntro = 0F ResetAnimation() LoadItems() End If If _tabInControl Then If Controls.Dismiss() And CanExit Then _closing = True End If If Controls.Accept() And _items.Length > 0 Then _tabInControl = False End If End If End Sub Private Sub UpdateItems() If Controls.Left(True, True, True, True, True, True) Then ItemIndex -= 2 If ItemIndex < 0 And PageIndex > 0 Then ItemIndex += 10 PageIndex -= 1 _itemIntro = 0F ResetAnimation() ElseIf ItemIndex < 0 And PageIndex = 0 Then If ItemIndex = -1 Then ItemIndex = 1 Else ItemIndex = 0 End If End If End If If Controls.Right(True, True, True, True, True, True) Then If ItemIndex + 2 + (PageIndex * 10) < _items.Length Then ItemIndex += 2 If ItemIndex > 9 Then ItemIndex -= 10 PageIndex += 1 _itemIntro = 0F ResetAnimation() End If End If End If If Controls.Up(True, True, False, True, True, True) Then ItemIndex -= 1 If ItemIndex < 0 And PageIndex > 0 Then ItemIndex += 10 PageIndex -= 1 _itemIntro = 0F ResetAnimation() ElseIf ItemIndex < 0 And PageIndex = 0 Then ItemIndex = 0 End If End If If Controls.Down(True, True, False, True, True, True) Then If ItemIndex + 1 + (PageIndex * 10) < _items.Length Then ItemIndex += 1 If ItemIndex > 9 Then ItemIndex -= 10 PageIndex += 1 _itemIntro = 0F ResetAnimation() End If End If End If If Controls.Accept() AndAlso _items.Length > 0 Then _infoItemOptionSelection = 0 _isInfoShowing = True SetInfoSettings() SetItemOptions() End If If Controls.Dismiss() Then _tabInControl = True End If End Sub Private Sub UpdateInfo() For i = 0 To _infoItemOptionSize.Length - 1 If i = _infoItemOptionSelection Then If _infoItemOptionSize(i) < 200 Then _infoItemOptionSize(i) += 20 If _infoItemOptionSize(i) >= 200 Then _infoItemOptionSize(i) = 200 End If End If Else If _infoItemOptionSize(i) > 0 Then _infoItemOptionSize(i) -= 20 If _infoItemOptionSize(i) <= 0 Then _infoItemOptionSize(i) = 0 End If End If End If Next If Controls.Up(True) Then _infoItemOptionSelection -= 1 If _infoItemOptionSelection < 0 Then _infoItemOptionSelection = _infoItemOptions.Count - 1 End If End If If Controls.Down(True) Then _infoItemOptionSelection += 1 If _infoItemOptionSelection > _infoItemOptions.Count - 1 Then _infoItemOptionSelection = 0 End If End If If Controls.Accept() Then SelectedItemOption() End If If Controls.Dismiss() Then CloseInfoScreen() End If End Sub Private Sub CloseInfoScreen() _infoSizeTarget = 0 _infoPositionTarget = GetInfoTargetPositionRollback() _itemColumnRightOffsetTarget = 0 _itemColumnLeftOffsetTarget = 0 _isInfoShowing = False End Sub Private Sub SelectedItemOption() If _infoItemOptionsNormal.Count > 0 Then Dim cItem As Item = Item.GetItemByID(_items(ItemIndex + PageIndex * 10).ItemID) Select Case _infoItemOptionsNormal(_infoItemOptionSelection) Case INFO_ITEM_OPTION_USE cItem.Use() Case INFO_ITEM_OPTION_GIVE Dim selScreen = New PartyScreen(Core.CurrentScreen) With {.Mode = ISelectionScreen.ScreenMode.Selection, .CanExit = True} AddHandler selScreen.SelectedObject, AddressOf GiveItemHandler Core.SetScreen(selScreen) Case INFO_ITEM_OPTION_TOSS TossItem(cItem) Case INFO_ITEM_OPTION_SELECT FireSelectionEvent(cItem.ID) CloseInfoScreen() _closing = True End Select End If End Sub Private Sub TossItem(ByVal cItem As Item) Dim text As String = "Are you sure you want to toss~this item?%Yes|No%" TextBox.Show(text, AddressOf Me.TossManyItems, False, False, TextBox.DefaultColor) End Sub Private Sub TossManyItems(ByVal result As Integer) If result = 0 Then TextBox.Show("Select the amount to toss.", {}) _tossingItems = True End If End Sub ''' ''' A handler method to convert the incoming object array. ''' Private Sub GiveItemHandler(ByVal params As Object()) GiveItem(CInt(params(0))) End Sub Private Sub GiveItem(ByVal PokeIndex As Integer) Dim cItem As Item = Item.GetItemByID(_items(ItemIndex + PageIndex * 10).ItemID) Dim Pokemon As Pokemon = Core.Player.Pokemons(PokeIndex) If Pokemon.IsEgg() = False Then Core.Player.Inventory.RemoveItem(cItem.ID, 1) Dim reItem As Item = Nothing If Not Pokemon.Item Is Nothing Then reItem = Pokemon.Item Core.Player.Inventory.AddItem(reItem.ID, 1) End If Pokemon.Item = Item.GetItemByID(cItem.ID) If reItem Is Nothing Then 'JSON Stuff 'ShowMessage(_translation.MESSAGE_GIVE_ITEM(Pokemon.GetDisplayName(), cItem.Name)) ShowMessage("Gave " & Pokemon.GetDisplayName() & " a " & cItem.Name & ".") Else 'JSON Stuff 'ShowMessage(_translation.MESSAGE_SWITCH_ITEM(Pokemon.GetDisplayName(), reItem.Name, cItem.Name)) ShowMessage("Switched " & Pokemon.GetDisplayName() & "'s " & reItem.Name & " with a " & cItem.Name & ".") End If LoadItems() If ItemIndex + PageIndex * 10 > _items.Count - 1 Then ItemIndex = 0 PageIndex = 0 CloseInfoScreen() End If Else 'JSON Stuff 'ShowMessage(_translation.MESSAGE_EGG_ERROR) ShowMessage("Eggs cannot hold items.") End If End Sub Private Sub ShowMessage(ByVal text As String) _messageDelay = CSng(text.Length / 1.75) _messageText = text End Sub ''' ''' Resets the item animation. ''' Private Sub ResetAnimation() _itemAnimation = New ItemAnimation() End Sub ''' ''' Updates the item shake animation. ''' Private Sub UpdateShakeAnimation() If _itemAnimation._shakeLeft = True Then _itemAnimation._shakeV -= 0.035F If _itemAnimation._shakeV <= -0.4F Then _itemAnimation._shakeCount -= 1 _itemAnimation._shakeLeft = False End If Else _itemAnimation._shakeV += 0.035F If _itemAnimation._shakeV >= 0.4F Then _itemAnimation._shakeCount -= 1 _itemAnimation._shakeLeft = True End If End If End Sub ''' ''' Reloads the temporary item list. ''' Private Sub LoadItems() _items = Core.Player.Inventory.Where(Function(x) Item.GetItemByID(x.ItemID).ItemType = _visibleItemTypes(_tabIndex)).ToArray() If _tabIndex = 4 Then 'TM/HM _items = (From i In _items Order By Item.GetItemByID(i.ItemID).SortValue Ascending).ToArray() Else _items = (From i In _items Order By Item.GetItemByID(i.ItemID).Name Ascending).ToArray() End If End Sub ''' ''' Sets the info interface state settings based on the selected item column. ''' Private Sub SetInfoSettings() Dim column As Integer = CInt(Math.Floor(ItemIndex / 2)) _infoSize = 0 _infoSizeTarget = 500 'Size is always 500. _itemColumnLeftOffset = 0 _itemColumnRightOffset = 0 Select Case column Case 0 _infoSide = 0 _infoPosition = column * 160 + 32 + 48 _infoPositionTarget = _infoPosition _itemColumnLeft = 0 _itemColumnLeftOffsetTarget = 0 _itemColumnRightOffsetTarget = 500 Case 1 _infoSide = 0 _infoPosition = column * 160 + 32 + 48 _infoPositionTarget = _infoPosition - 160 _itemColumnLeft = 1 _itemColumnLeftOffsetTarget = -160 _itemColumnRightOffsetTarget = 340 Case 2 _infoSide = 0 _infoPosition = column * 160 + 32 + 48 _infoPositionTarget = _infoPosition - 320 _itemColumnLeft = 2 _itemColumnLeftOffsetTarget = -320 _itemColumnRightOffsetTarget = 180 Case 3 _infoSide = 1 _infoPosition = column * 160 - 80 _infoPositionTarget = _infoPosition - 320 _itemColumnLeft = 2 _itemColumnLeftOffsetTarget = -320 _itemColumnRightOffsetTarget = 180 Case 4 _infoSide = 1 _infoPosition = column * 160 - 80 _infoPositionTarget = _infoPosition - 500 _itemColumnLeft = 3 _itemColumnLeftOffsetTarget = -500 _itemColumnRightOffsetTarget = 0 End Select End Sub Private Sub SetItemOptions() _infoItemOptions.Clear() _infoItemOptionsNormal.Clear() Dim cItem As Item = Item.GetItemByID(_items(ItemIndex + PageIndex * 10).ItemID) If _mode = ISelectionScreen.ScreenMode.Default Then If cItem.CanBeUsed Then 'JSON Stuff '_infoItemOptions.Add(_translation.INFO_ITEM_OPTION_USE) _infoItemOptions.Add("Use") _infoItemOptionsNormal.Add(INFO_ITEM_OPTION_USE) End If If cItem.CanBeHold Then 'JSON Stuff ' _infoItemOptions.Add(_translation.INFO_ITEM_OPTION_GIVE) _infoItemOptions.Add("Give") _infoItemOptionsNormal.Add(INFO_ITEM_OPTION_GIVE) End If If cItem.CanBeTossed Then 'JSON Stuff '_infoItemOptions.Add(_translation.INFO_ITEM_OPTION_TOSS) _infoItemOptions.Add("Toss") _infoItemOptionsNormal.Add(INFO_ITEM_OPTION_TOSS) End If ElseIf _mode = ISelectionScreen.ScreenMode.Selection Then 'JSON Stuff '_infoItemOptions.Add(_translation.INFO_ITEM_OPTION_SELECT) _infoItemOptions.Add("Select") _infoItemOptionsNormal.Add(INFO_ITEM_OPTION_SELECT) End If End Sub ''' ''' Gets the target position of the info box for the rollback animation. ''' Private Function GetInfoTargetPositionRollback() As Integer Dim column As Integer = CInt(Math.Floor(ItemIndex / 2)) Select Case column Case 0 Return column * 160 + 32 + 48 Case 1 Return column * 160 + 32 + 48 Case 2 Return column * 160 + 32 + 48 Case 3 Return column * 160 - 80 Case 4 Return column * 160 - 80 End Select Return 0 End Function Private Sub UpdateInfoAnimation() 'Make the size grow if needed: Dim tempInfoSize As Integer = _infoSize _infoSize = CInt(MathHelper.Lerp(_infoSize, _infoSizeTarget, 0.1F)) If tempInfoSize = _infoSize Then _infoSize = _infoSizeTarget End If 'Move the info position to its target: Dim tempInfoPosition As Integer = _infoPosition _infoPosition = CInt(MathHelper.Lerp(_infoPosition, _infoPositionTarget, 0.1F)) If tempInfoPosition = _infoPosition Then _infoPosition = _infoPositionTarget End If 'Move item offsets: Dim tempItemColumnLeftOffset As Integer = _itemColumnLeftOffset _itemColumnLeftOffset = CInt(MathHelper.Lerp(_itemColumnLeftOffset, _itemColumnLeftOffsetTarget, 0.1F)) If tempItemColumnLeftOffset = _itemColumnLeftOffset Then _itemColumnLeftOffset = _itemColumnLeftOffsetTarget End If Dim tempItemColumnRightOffset As Integer = _itemColumnRightOffset _itemColumnRightOffset = CInt(MathHelper.Lerp(_itemColumnRightOffset, _itemColumnRightOffsetTarget, 0.1F)) If tempItemColumnRightOffset = _itemColumnRightOffset Then _itemColumnRightOffset = _itemColumnRightOffsetTarget End If End Sub Private _mode As ISelectionScreen.ScreenMode = ISelectionScreen.ScreenMode.Default Private _canExit As Boolean = True Private _visibleItemTypes As Items.ItemTypes() Public Event SelectedObject(params() As Object) Implements ISelectionScreen.SelectedObject Private Sub FireSelectionEvent(ByVal itemId As Integer) RaiseEvent SelectedObject(New Object() {itemId}) End Sub ''' ''' The current mode of this screen. ''' Public Property Mode As ISelectionScreen.ScreenMode Implements ISelectionScreen.Mode Get Return _mode End Get Set(value As ISelectionScreen.ScreenMode) _mode = value End Set End Property ''' ''' If the user can quit the screen in selection mode without choosing an item. ''' Public Property CanExit As Boolean Implements ISelectionScreen.CanExit Get Return _canExit End Get Set(value As Boolean) _canExit = value End Set End Property ''' ''' Sets the visible item type tabs. ''' Public WriteOnly Property VisibleItemTypes As Items.ItemTypes() Set(value As Items.ItemTypes()) _visibleItemTypes = value End Set End Property End Class