[EFF - should be any VBDX8] Instanced Chests

[Zeno]


* * *

**The skinny:** You can use this code to create chests which any player can open once. Every chest by default is closed and will Call PlayerOpenChest on the server when stepped on it. After having opened the chest, the chest will appear open to the player and have no function when stepped on (editable to a message or other function). You use the map editor to choose which chest to place, its contents, and then to place chests as tile attributes. Although this could basically be done in most of the existing event systems, I find it much more polished and easier for development to have it as a standalone.

**The _technical_ skinny:** Instanced chests creates a ChestOpen=false boolean per constant numchests per player. Placing the tile_type_chest attribute on any map tile saves the chest to the server. It also removes the attribute in the previous stored map,x,y location of that chest. When rendering, if there is an ChestOpen=false chest on the map it renders with one tile; when opened, another. When PlayerMove recognizes tile_type_chest, PlayerOpenChest is called if Player(Index).ChestOpen(tile.data1)=false. Chests data is put and got from their own chest#.dat files in their own \chests\ folder.

Much of this code deals with mimicking existing systems for data storage and transfer. You can very easily make these chests randomized and avoid using 2/3 of this code, notably all the creating, storing, saving, loading, and exchanging presets.

* * *

**Both Client- and Server-Side**

The first thing we are going to add is the variables we will need to store the information about our chests. In modTypes add:

>! ```
Public Chest(1 To MAX_CHESTS) As ChestRec
>! ```
```
Private Type ChestRec
Type As Long
Data1 As Long
Data2 As Long
map As Long
x As Byte
y As Byte
End Type 
```
Then at the end, right before your End Type in Type PlayerRec add the following line:
>! ```
ChestOpen(1 To MAX_CHESTS) As Boolean 'Chests
```

I have included five types of chests. We will store them, the link to chests from tiles, and our maximum index of chests in modConstants:

>! Add the following lines where you see fit. I recommend leaving the first as a chunk and placing the latter two with the rest of the MAX_ and TILE_TYPE constants, but this is just tidiness.
>! ```
'Chest constants
Public Const NumChests As Long = 300
```
>! ```
>! Public Const CHEST_TYPE_STAT As Byte = 0
Public Const CHEST_TYPE_ITEM As Byte = 1
Public Const CHEST_TYPE_GOLD As Byte = 2
Public Const CHEST_TYPE_EXP As Byte = 3
Public Const MAX_CHESTS As Long = 200
Public Const TILE_TYPE_CHEST As Byte = 17 'change 17 to be the last tile_type# +1
```
Now our enumerated constants related to packet handling. Head over to modEnumerations, and at the line before CMSG_COUNT add:
>! ```
>! CSendChest
```
And right before SMSG_COUNT add:
>! ```
>! SPlayerOpenChest
SUpdateChest
```

* * *

**Server-side**

Because we've created the variables for chests, if we want to permanently save what we put in them we'll need to update our modDatabase. 

>! ```
' ***********
' ** Chests **
' ***********
Sub SaveChests()
Dim i As Long
>! For i = 1 To MAX_CHESTS
Call SaveChest(i)
Next
>! End Sub
>! Sub SaveChest(ByVal ChestNum As Long)
Dim filename As String
Dim F As Long
filename = App.Path & "\data\Chests\Chest" & ChestNum & ".dat"
F = FreeFile
Open filename For Binary As #F
Put #F, , Chest(ChestNum)
Close #F
End Sub
>! Sub LoadChests()
Dim filename As String
Dim i As Long
Dim F As Long
Call CheckChests
>! For i = 1 To MAX_CHESTS
filename = App.Path & "\data\chests\chest" & i & ".dat"
F = FreeFile
Open filename For Binary As #F
Get #F, , Chest(i)
Close #F
Next
>! End Sub
>! Sub CheckChests()
Dim i As Long
>! For i = 1 To MAX_CHESTS
>! If Not FileExist("\Data\Chests\Chest" & i & ".dat") Then
Call SaveChest(i)
End If
>! Next
>! End Sub
>! Sub ClearChest(ByVal Index As Long)
Call ZeroMemory(ByVal VarPtr(Chest(Index)), LenB(Chest(Index)))
End Sub
>! Sub ClearChests()
Dim i As Long
>! For i = 1 To MAX_CHESTS
Call ClearChest(i)
Next
>! End Sub 
```

To finish off the saving and loading feature of chests, in modGeneral add:

>! in Sub InitServer
>! ```
ChkDir App.Path & "\Data\", "chests"
>! ```
in Sub ClearGameData
>! ```
Call SetStatus("Clearing chests...")
Call ClearChests 
```
and in Sub LoadGameData
>! ```
Call SetStatus("Loading chests...")
Call LoadChests 
```

Now that we've laid the data foundation for the chests, we can create the actual interaction with the chests:

>! In modPlayer sub PlayerMove anywhere in series with the similar if clauses add
>! ```
'Check to see if it's a chest
If .Type = TILE_TYPE_CHEST Then
PlayerOpenChest Index, .Data1
End If
>! ```
And then add this sub to modPlayer as well
>! ```
Sub PlayerOpenChest(ByVal Index As Long, ByVal ChestNum As Long)
Dim n As Long
If Not isPlaying(Index) Then Exit Sub

'Do nothing with chests if player has opened it. Change this to a larger if/then with the select case as an else for an effect when the chest has already been received.
If Player(Index).ChestOpen(ChestNum) = True Then Exit Sub

Select Case Chest(ChestNum).Type
Case CHEST_TYPE_GOLD
n = Chest(ChestNum).Data1 * ((100 + Player(Index).Level) / 100)
GiveInvItem Index, 1, n
PlayerMsg Index, "You found " & n & " gold in the chest!", Yellow
Case CHEST_TYPE_ITEM
GiveInvItem Index, Chest(ChestNum).Data1, Chest(ChestNum).Data2
PlayerMsg Index, "You found " & Item(Chest(ChestNum).Data1).Name & " in the chest!", Yellow
Case CHEST_TYPE_EXP
n = Chest(ChestNum).Data1 * (100 + rand(0, Chest(ChestNum).Data2)) / 100
SetPlayerExp Index, (GetPlayerExp(Index) + n)
PlayerMsg Index, "The chest seemed empty, or was it? You gain " & n & " experience!", Yellow
Case CHEST_TYPE_STAT
Player(Index).Points = Player(Index).Points + 1
PlayerMsg Index, "The chest seemed empty, or was it? You gained a stat point!", Yellow
End Select

Player(Index).ChestOpen(ChestNum) = True

SendPlayerOpenChest Index, ChestNum
>! End Sub
>! ```
And this in sub JoinGame, also modPlayer:
>! ```
Call SendChests(Index)
>! ```

The server has two more parts - now to add the packet handling:

>! In modServerTCP add these four subs anywhere:
>! ```
Sub SendPlayerOpenChests(ByVal Index As Long)
Dim i As Long
For i = 1 To MAX_CHESTS
If Player(Index).ChestOpen(i) = True Then SendPlayerOpenChest Index, i
Next
End Sub
>! Sub SendPlayerOpenChest(ByVal Index As Long, ByVal ChestNum As Long)
Dim buffer As clsBuffer

Set buffer = New clsBuffer

buffer.WriteLong SPlayerOpenChest
buffer.WriteLong ChestNum

SendDataTo Index, buffer.ToArray()

Set buffer = Nothing
End Sub
>! ```
>! ```
>! Sub SendUpdateChestTo(ByVal Index As Long, ByVal ChestNum As Long)
    Dim buffer As clsBuffer
>!     Set buffer = New clsBuffer

    buffer.WriteLong SUpdateChest
    buffer.WriteLong ChestNum
    buffer.WriteLong Chest(ChestNum).Type
    buffer.WriteLong Chest(ChestNum).Data1
    buffer.WriteLong Chest(ChestNum).Data2
buffer.WriteLong Chest(ChestNum).Map
buffer.WriteByte Chest(ChestNum).x
buffer.WriteByte Chest(ChestNum).y

    SendDataTo Index, buffer.ToArray()

    Set buffer = Nothing
End Sub
>! Sub SendUpdateChestToAll(ByVal ChestNum As Long)
    Dim buffer As clsBuffer
>!     Set buffer = New clsBuffer

    buffer.WriteLong SUpdateChest
    buffer.WriteLong ChestNum
    buffer.WriteLong Chest(ChestNum).Type
    buffer.WriteLong Chest(ChestNum).Data1
    buffer.WriteLong Chest(ChestNum).Data2
buffer.WriteLong Chest(ChestNum).Map
buffer.WriteByte Chest(ChestNum).x
buffer.WriteByte Chest(ChestNum).y

    SendDataToAll buffer.ToArray()

    Set buffer = Nothing
End Sub
```
>!  
>! In modHandleData add anywhere:
>! ```
Sub HandleSaveChest(ByVal Index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
Dim buffer As clsBuffer, n As Long
>! ' Prevent hacking
If GetPlayerAccess(Index) < ADMIN_MAPPER Then
Exit Sub
End If

Set buffer = New clsBuffer
buffer.WriteBytes data()

n = buffer.ReadLong
If n < 1 Or n > MAX_CHESTS Then Exit Sub

>! ```
'Remove previous instance
    If Chest(n).map > 0 Then map(Chest(n).map).Tile(Chest(n).x, Chest(n).y).Type = 0
>! 'Update chest Chest(n).Type = buffer.ReadLong Chest(n).Data1 = buffer.ReadLong Chest(n).Data2 = buffer.ReadLong
>! Chest(n).Map = buffer.ReadLong Chest(n).x = buffer.ReadByte Chest(n).y = buffer.ReadByte Set buffer = Nothing Call SendUpdateChestToAll(n) Call SaveChest(n) Call AddLog(GetPlayerName(Index) & " saving Chest #" & n & ".", ADMIN_LOG) End Sub
>! And anywhere in modHandleData sub InitMessages add:
>! ```
HandleDataSub(CSendChest) = GetAddress(AddressOf HandleSaveChest)
```

* * *

**Client-side**.

in modGlobals add
>! ```
Public EditorChestType As Byte
>! ```

in modGameEditors
>! Anywhere in Sub MapEditorInit
>! ```
'set chest array
frmEditor_Map.cmbChestIndex.Clear
For i = 1 To MAX_CHESTS
frmEditor_Map.cmbChestIndex.AddItem "Chest: " & i
Next
>! ```
And within the With Map.Tile in subMapEditorMouseDown
>!                 If frmEditor_Map.optChest.value Then
                'Data1 has to go first because the renderer likes to jump in and give RTE9
                    .data1 = frmEditor_Map.cmbChestIndex.ListIndex + 1
                    .Type = TILE_TYPE_CHEST
                    .Data2 = 0
                    .Data3 = 0
                    .Data4 = ""
                    'Map data must be sent to the server so that any old chest could be have the tile_type removed
                    With Chest(.data1)
                        .Map = Player(MyIndex).Map
                        .x = CurX
                        .y = CurY
                    End With
                    SendChest (.data1)
                End If

Now for the graphics, in modGraphics:

>! ```
Public Sub DrawChest(ByVal x As Long, ByVal y As Long, ByVal Opened As Boolean)
Dim rec As RECT
Dim i As Long
>! ' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo ErrorHandler

If Opened = False Then
RenderTexture Tex_Tileset(108), ConvertMapX(x * PIC_X), ConvertMapY(y * PIC_Y), 0, 96, 32, 32, 32, 32
Else
RenderTexture Tex_Tileset(108), ConvertMapX(x * PIC_X), ConvertMapY(y * PIC_Y), 128, 96, 32, 32, 32, 32
End If

' Error handler
Exit Sub
ErrorHandler:
HandleError "DrawChest", "modGraphics", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
>! ```
And first thing in the y-based render in sub Render_Graphics:
>! ```
For x = 0 To Map.MaxX
If Map.Tile(x, y).Type = TILE_TYPE_CHEST Then
If Player(MyIndex).ChestOpen(Map.Tile(x, y).data1) = False Then
DrawChest x, y, False
Else
DrawChest x, y, True
End If
End If
Next
>! ```

Now the packet handling of the client:

>! In modHandleData Sub InitMessages add:
>! ```
HandleDataSub(SPlayerOpenChest) = GetAddress(AddressOf HandlePlayerOpenChest)
HandleDataSub(SUpdateChest) = GetAddress(AddressOf HandleUpdateChest)
>! ```
and then add these two subs anywhere in that module:
>! ```
Private Sub HandlePlayerOpenChest(ByVal Index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
Dim i As Long
Dim buffer As clsBuffer
>! ' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo ErrorHandler

Set buffer = New clsBuffer
buffer.WriteBytes data()

i = buffer.ReadLong
Player(Index).ChestOpen(i) = True

' Error handler
Exit Sub
ErrorHandler:
HandleError "HandlePlayerOpenChest", "modHandleData", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
>! ```
>! ```
>! Private Sub HandleUpdateChest(ByVal Index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
Dim n As Long
Dim buffer As clsBuffer
>!     ' If debug mode, handle error then exit out
    If Options.Debug = 1 Then On Error GoTo ErrorHandler

    Set buffer = New clsBuffer
    buffer.WriteBytes data()

    n = buffer.ReadLong
    Chest(n).Type = buffer.ReadLong
    Chest(n).data1 = buffer.ReadLong
    Chest(n).Data2 = buffer.ReadLong
    Chest(n).Map = buffer.ReadLong
    Chest(n).x = buffer.ReadByte
    Chest(n).y = buffer.ReadByte
>!     ' Error handler
    Exit Sub
ErrorHandler:
    HandleError "HandleUpdateChest", "modHandleData", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub
```
>!  
>! And now add this anywhere in modClientTCP
>! ```
Public Sub SendChest(ByVal Index As Long)
Dim buffer As clsBuffer
>! ' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo ErrorHandler

Set buffer = New clsBuffer

buffer.WriteLong CSendChest
buffer.WriteLong Index
buffer.WriteLong Chest(Index).Type
buffer.WriteLong Chest(Index).data1
buffer.WriteLong Chest(Index).Data2
buffer.WriteLong Chest(Index).Map
buffer.WriteByte Chest(Index).x
buffer.WriteByte Chest(Index).y

SendData buffer.ToArray()
Set buffer = Nothing

' Error handler
Exit Sub
ErrorHandler:
HandleError "SendChest", "modClientTCP", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
```

Now do a bit of form work in frmEditor_Map:

>! As you can see, I've got a couple other chest types that you don't have. Don't use those unless you also happen to have jexp and cards.
>! 
>! And add the following code into frmEditor_Map:
>!
>! ```
Private Sub cmbChestIndex_Click()
Dim n As Long 'prevent rte9
n = cmbChestIndex.ListIndex + 1
optChestType(Chest(n).Type).value = True
If Chest(n).data1 > 0 Then txtChestData1.text = str(Chest(n).data1)
If Chest(n).Data2 > 0 Then txtChestData2.text = str(Chest(n).Data2)
End Sub
>! Private Sub cmdChestCancel_Click()
picAttributes.Visible = False
fraChest.Visible = False
End Sub
>! Private Sub cmdChestOK_Click()
Dim n As Long
n = cmbChestIndex.ListIndex + 1
If n < 1 Or n > MAX_CHESTS Then Exit Sub
If Options.Debug = 1 Then On Error GoTo ErrorHandler
Chest(n).Type = EditorChestType
Chest(n).data1 = Val(txtChestData1.text)
Chest(n).Data2 = Val(txtChestData2.text)
fraChest.Visible = False
picAttributes.Visible = False
>! ErrorHandler:
HandleError "cmdChestOK_Click", "frmEditor_Map", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
>! Private Sub optChest_Click()
picAttributes.Visible = True
fraChest.Visible = True
End Sub
>! Private Sub optChestType_Click(Index As Integer)
EditorChestType = Index
End Sub
>! ```

And that should be it! Works for me and hopefully I didn't skip anything.

For DX7 users, the switch between Render and Blt isn't too bad. Using the same logic of the if statement in DrawChest, make a BltChest sub and look at how other procedures use blitting.

The graphics (tileset, x, and y values) for the two tiles for the chest in DrawChest just happen to be working numbers for me. You may need to change these to suit your tileset. The tileset value is its numeric filename. You can get the x,y of a tile easily by:

* open your tileset in Paint
* hover over a pixel on the tile you're looking at
* Divide the x coordinate and y coordinate values by 32
* drop the remainder (always round down) to get your x,y value for the tileset

Have fun. Happy dungeon digging.

Edit: Fixed a couple little things.

[abhi2011]

This can be done with the Event System. But since this would be comparatively faster I am gonna go with this.

[Zeno]

> Although this could basically be done in most of the existing event systems, I find it much more polished and easier for development to have it as a standalone.

> This can be done with the Event System. But since this would be comparatively faster I am gonna go with this.

Basically, yeah haha. I'd recommend the event system for anyone wanting only a couple chests. I'm not sure if you could make the tile different depending on who is looking at it. Either way, it quickly becomes very inefficient to create a script for every chest!

[abhi2011]

> Basically, yeah haha. I'd recommend the event system for anyone wanting only a couple chests. I'm not sure if you could make the tile different depending on who is looking at it. Either way, it quickly becomes very inefficient to create a script for every chest!

For the tile, you could make a var like chest opened or something. And just render accordingly. (If thats what you mean.)

[Zeno]

Yeah, I'm just unsure whether the events system can alter renders, other than shared values for sprites. Don't really know a lot about it… vb6 is easier than event system imo.

[abhi2011]

> Yeah, I'm just unsure whether the events system can alter renders, other than shared values for sprites. Don't really know a lot about it… vb6 is easier than event system imo.

I actually meant for coding. But yes, vb6 > event system.