[EO] Zelda like grass cut system

[kibbelz]

I made this a few years back, I never use it so thats why i am releasing it for the eclipse comunity. What it does is as the topic says. it slashes through the grass and sometimes you can find items.

Client Side:

Form work:
In frmeditor_map add a new option called "OptGrass" and on "fraMapItem" add a new checkbox called "ChkItem" and make its visible = false.

Now double click on OptGrass and add in this code:
```
    ClearAttributeDialogue
    picAttributes.Visible = True
    fraMapItem.Visible = True
    scrlMapItem.Max = MAX_ITEMS
    scrlMapItem.Value = 1
    lblMapItem.Caption = Trim$(Item(scrlMapItem.Value).Name) & " x" & scrlMapItemValue.Value
    EditorMap_BltMapItem
    ChkItem.Visible = True
```
Also find this sub:Private Sub optItem_Click() and at the bottom of the sub add:
```
ChkItem.Visible = False
```
Now double click on ChkItem and add:
```
GItem = ChkItem.Value
```
Now at the bottom of ModGlobals add:
```
'used for grass
Public GItem As Long

'Key/Grass Timer
Public kgtime As Long
Public kgx As Long
Public kgy As Long
```
Then find:
```
                ' slide
                If frmEditor_Map.optSlide.Value Then
                    .Type = TILE_TYPE_SLIDE
                    .Data1 = MapEditorSlideDir
                    .Data2 = 0
                    .Data3 = 0
                End If
```
Add underneath:

```
                'grass
                If frmEditor_Map.OptGrass.Value Then
                    .Type = TILE_TYPE_GRASS
                    .Data1 = GItem
                    .Data2 = ItemEditorNum
                    .Data3 = ItemEditorValue
                End If
```
Then find:
```
                            Case TILE_TYPE_SLIDE
                                DrawText TexthDC, tX, tY, "S", QBColor(BrightCyan)
```
Add underneath:

```
                            Case TILE_TYPE_GRASS
                                DrawText TexthDC, tX, tY, "GS", QBColor(BrightGreen)
```
Then go into ModConstants and find:
```
Public Const TILE_TYPE_SLIDE As Byte = 14
```
Add underneath:
```
Public Const TILE_TYPE_GRASS As Byte = 15
```
Then into sub bltmaptile and replace it with:

```
Public Sub BltMapTile(ByVal x As Long, ByVal Y As Long)
Dim rec As DxVBLib.RECT
Dim i As Long

    ' If debug mode, handle error then exit out
    If Options.Debug = 1 Then On Error GoTo errorhandler

    With Map.Tile(x, Y)
        For i = MapLayer.Ground To MapLayer.Mask2
            'If the door or grass isnt open then draw tile
            If TempTile(x, Y).DoorOpen = NO Or 0 Then
                ' skip tile?
                If (.Layer(i).Tileset > 0 And .Layer(i).Tileset <= NumTileSets) And (.Layer(i).x > 0 Or .Layer(i).Y > 0) Then
                    ' sort out rec
                    rec.top = .Layer(i).Y * PIC_Y
                    rec.Bottom = rec.top + PIC_Y
                    rec.Left = .Layer(i).x * PIC_X
                    rec.Right = rec.Left + PIC_X
                    ' render
                    Call Engine_BltFast(ConvertMapX(x * PIC_X), ConvertMapY(Y * PIC_Y), DDS_Tileset(.Layer(i).Tileset), rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
                End If
            Else
                'If Map layer ground or mask 2 still draw it
                If i = MapLayer.Mask2 Or MapLayer.Ground Then
                    'Skip tile
                    If (.Layer(i).Tileset > 0 And .Layer(i).Tileset <= NumTileSets) And (.Layer(i).x > 0 Or .Layer(i).Y > 0) Then
                        ' sort out rec
                        rec.top = .Layer(i).Y * PIC_Y
                        rec.Bottom = rec.top + PIC_Y
                        rec.Left = .Layer(i).x * PIC_X
                        rec.Right = rec.Left + PIC_X
                        ' render
                        Call Engine_BltFast(ConvertMapX(x * PIC_X), ConvertMapY(Y * PIC_Y), DDS_Tileset(.Layer(i).Tileset), rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
                        Exit Sub
                    End If
                End If

                kgx = x
                kgy = Y
                TempTile(x, Y).DoorTimer = GetTickCount
            End If
        Next
    End With

    ' Error handler
    Exit Sub

errorhandler:
    HandleError "BltMapTile", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub
```
Now go into modenumerations and add to the right place:
```
SGrass
```
Then into ModHandleData add in the right place:
```
HandleDataSub(SGrass) = GetAddress(AddressOf HandleGrass)
```
Then at the very bottom of ModHandleData add:
```
Private Sub HandleGrass(ByVal Index As Long, ByRef Data() As Byte, ByVal EditorIndex As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
Dim Buffer As clsBuffer
Dim x As Long
Dim Y As Long
Dim v As Long

    Set Buffer = New clsBuffer
    Buffer.WriteBytes Data()

        x = Buffer.ReadLong
        Y = Buffer.ReadLong
        v = Buffer.ReadLong

    If v = 1 Then
        TempTile(x, Y).DoorOpen = YES
    Else
        TempTile(x, Y).DoorOpen = NO
    End If

    Set Buffer = Nothing
End Sub
```
Now to the server:

In ModConstants find:
```
Public Const TILE_TYPE_SLIDE As Byte = 14
```
Add underneath:
```
Public Const TILE_TYPE_GRASS As Byte = 15
```
Then find Sub HandleAttack and just before it calls checkresource add:
```
CheckGrass Index, x, y
```
And then at the bottom of ModPlayer add:
```
Sub CheckGrass(ByVal Index As Long, ByVal x As Long, ByVal y As Long)
Dim i As Long
    If Map(GetPlayerMap(Index)).Tile(x, y).Type = TILE_TYPE_GRASS Then

        If Map(GetPlayerMap(Index)).Tile(x, y).Data1 > 0 Then
            Call SpawnItem(Map(GetPlayerMap(Index)).Tile(x, y).Data2, Map(GetPlayerMap(Index)).Tile(x, y).Data3, GetPlayerMap(Index), x, y)
        End If

        Call SendAnimation(GetPlayerMap(Index), 1, x, y)

        TempTile(GetPlayerMap(Index)).DoorOpen(x, y) = NO
        TempTile(GetPlayerMap(Index)).DoorTimer = GetTickCount

        For i = 1 To MAX_PLAYERS
            If GetPlayerMap(i) = GetPlayerMap(Index) Then
                Call SendGrass(i, x, y, 1)
            End If
        Next

    End If

End Sub
```
Then at the bottom of ModServerTCP add:
```
Sub SendGrass(ByVal Index As Long, ByVal x As Long, ByVal y As Long, ByVal s As Long)
Dim Buffer As clsBuffer

    Set Buffer = New clsBuffer
    Buffer.WriteLong SGrass
    Buffer.WriteLong x
    Buffer.WriteLong y
    Buffer.WriteLong s
    SendDataTo Index, Buffer.ToArray()
    Set Buffer = Nothing
End Sub
```
And finally in Modenumerations add in the right place:
```
SGrass
```
I beive that is it, If i have missed anything out post.

Note: The current cutting animation is 1 and the layer that becomes invisible is mask.

[Fragment]

Looks good, however, i dont see the reason you would use this over (instead of) the resource system as it does the same. unless i am missing something.

[kibbelz]

This does not go over the resource system. It just goes before the call. It runs both depending on the map attribute.

[shado360]

I think he meant "instead of."

[kibbelz]

Well he can change it to the resource system idk. Just be happy with what you have :/ i made this like a year ago.

[Justn]

Is it possible to make it where a player can't walk on the grass until its cut or would that require a whole different kind of map attribute and nothing to do with this tutorial?

[viciousdead]

@Justn:

> Is it possible to make it where a player can't walk on the grass until its cut or would that require a whole different kind of map attribute and nothing to do with this tutorial?

Agreed with Justn, that would be a nice addition to this feature. /Personal Opinion

Also, I like this. (:

[adr990]

Yes and it's very easy to do so. :P

I suggest figuring this out yourself.

Just look  for a code in EO that makes the player block (already told to much eh) , and the rest should be easy enough to figure yourself also.

Tutorials ain't make to just copy and paste and let others customize the code to your needs.

Unless you think the code actually has a problem, you should do things like this yourself.

Adr990

Hint:
You don't add another attribute for this, just change the code of kibbelz.

[Justn]

ok thanks for the help man I was just wondering if it was possible without messing up his code.. will work on it now =)

[Justn]

Ok I think I figured out the blocking thing but I'm confused about how I define the variable For ChkItem?

[SpiceyWolf]

how would i go about making this so if you cut the grass when its not there another item doesnt spawn?

[judoka]

Is there any possibility to send more than 3 datas to the server?
```
                'grass
                If frmEditor_Map.OptGrass.Value Then
                    .Type = TILE_TYPE_GRASS
                    .Data1 = GItem
                    .Data2 = ItemEditorNum
                    .Data3 = ItemEditorValue
                End If

```I wanna do that:
```
                'grass
                If frmEditor_Map.OptGrass.Value Then
                    .Type = TILE_TYPE_GRASS
                    .Data1 = GItem
                    .Data2 = ItemEditorNum
                    .Data3 = ItemEditorValueMax
                    .Data4 = ItemEditorValueMin
                End If

```I tried to do that but… the map was wrong (the tiles went crazy)..

[Thunderbird]

Could someone confirm if this system works or not? (in EO 2.0)

[kibbelz]

it should.

[SpiceyWolf]

it does but u might as well use resource… it does the same thing and with this u can stand in front of it and keep cutting when nothing is there and it will still drop items

[kibbelz]

@SpiceyWolf:

> it does but u might as well use resource… it does the same thing and with this u can stand in front of it and keep cutting when nothing is there and it will still drop items

As i said, i made this over a year ago and I know this code isn't very good. I will not fix any bugs you find and since you don't like it piss off, there is no point in you posting here and wasting my time.

@SpiceyWolf:

> u

Don't write chat speak on forums, it is a foul language and it shows how crap your writing skills are.

[SpiceyWolf]

i wasnt waisting "your" time… i was telling someone about the bugs so if they dislike then ur not waisting THEIR time

[Ruins of Hell]

@kibbelz:

> As i said, i made this over a year ago and I know this code isn't very good. I will not fix any bugs you find and since you don't like it piss off, there is no point in you posting here and wasting my time.

If you're going to insult someone: get some basis. No point in trying to make people use something that has no value. If there are bugs, fix them. Don't yell at someone who simply points them out.