Author Topic: good way to implement an array of stacks/linked lists (for 2D tile-based game)? (Read 5147 times)

madscijr · « **on:** June 22, 2021, 03:16:21 pm »

I'm wondering how might we handle storing a variable number of objects at a certain (x,y) location in a tile-based game where the terrain is a simple 2-D array?
We could add a 3rd "Z" dimension, which would allow us to stack items, but most of the space would probably be unused, and there the number of objects a square could hold would be limited by the size of the third dimension.
I would want to preserve the "stacking order" of the objects on a given square, and be able to quickly read through the list of items, given an x,y coordinate, so I feel like a 2-D array of stacks would work or even linked lists.
Can anyone recommend a relatively efficient way to accomplish this QB or QB64, that is not too complicated?

SpriggsySpriggs · « **Reply #1 on:** June 22, 2021, 03:18:58 pm »

This is above my knowledge but I know @STxAxTIC has a library for linked lists that may be of some assistance to you. I don't know where the forum post for it is but maybe he can jump in and assist.

SMcNeill · « **Reply #2 on:** June 22, 2021, 03:28:41 pm »

Wouldn't the easiest way to do something like this be just:

DIM Objects(x, y) AS STRING * 10 'for a maximum of 10 items per tile

Object(10,10) = CHR$(1) 'Item 1 is on the bottom of the stack
Object(10,10) = Object(10,10) + CHR$(23) 'Item 23 is on top of it
Object(10,10) = Object(10,10) + CHR$(107) 'Item 107 is above that one
Object(10,10) = Object(10,10) + CHR$(114) 'And item 114 is rendered last and is the top of the stack
' And the next 6 characters are all blank

Putting them into your tile would be that simple, and getting the info back out would just be:

FOR x = 0 to x_tile_limit
FOR y = 0 to y_tile_limit
FOR z = 1 to 10
IF ASC(Object(x, y), z) <> 0 THEN
'Do whatever you do with that object
END IF
NEXT z, y, x

Petr · « **Reply #3 on:** June 22, 2021, 03:34:47 pm »

Easiest it is using TYPE. Just create usertype field structure. Something as this:

Code: QB64: [Select]

 
 
TYPE UserField
    texture AS LONG
    Dynamic_Value AS LONG
END TYPE
 
TYPE Array2D
    Grid AS UserField
    X_POS AS LONG
    Y_POS AS LONG
END TYPE
 
REDIM UserF(100, 100) AS Array2D
 
FOR x = 1 TO 100
    FOR y = 1 TO 100
 
        UserF(x, y).X_POS = x 'fill grid X and Y positions
        UserF(x, y).Y_POS = y
 
        UserF(x, y).Grid.texture = RND * 1000 '_LOADIMAGE....
        UserF(x, y).Grid.Dynamic_Value = RND * 75 '_SNDOPEN.....
 
    NEXT y
NEXT x
 
 

madscijr · « **Reply #4 on:** June 22, 2021, 04:18:52 pm »

Thanks everyone, I will give those various methods a look and let you know how it went!

madscijr · « **Reply #5 on:** June 28, 2021, 12:00:01 pm »

Quote from: SMcNeill on June 22, 2021, 03:28:41 pm

Wouldn't the easiest way to do something like this be just:
DIM Objects(x, y) AS STRING * 10 'for a maximum of 10 items per tile
...
' And the next 6 characters are all blank

Thanks for your suggestion.
What is the DIM AS STRING * 10 all about?
Does that mean the string is always 10 characters long, and any unused characters are automatically filled in with space?

So this is setting aside memory for (x_tile_limit, y_tile_limit, 10), and (x_tile_limit * y_tile_limit * 10) bytes are used even if there is nothing on any tile.
Wouldn't this be the same as using a 3-dimensional array DIM Objects (x_tile_limit, y_tile_limit, 10) ?

We could just do
DIM Objects(x_tile_limit, y_tile_limit) AS STRING

where each tile is limited to the size of the string,

and then to get the number of objects on the tile just do
iNumObjects = LEN(Objects(xPos, yPos)),

to POP, do
MyObject$ = RIGHT$(Objects(xPos, yPos), 1)
Objects(xPos, yPos) = LEFT$(Objects(xPos, yPos), LEN(Objects(xPos, yPos))-1)

and to PUSH, do
Objects(xPos, yPos) = Objects(xPos, yPos) + NewObject$

It's the simplest approach.

Thanks again

madscijr · « **Reply #6 on:** June 28, 2021, 12:02:29 pm »

Quote from: Petr on June 22, 2021, 03:34:47 pm

Easiest it is using TYPE. Just create usertype field structure.

Thanks for your reply. I don't see how this is a stack, where each cell or tile can hold multiple items (0 upto whatever limit)?

madscijr · « **Reply #7 on:** June 28, 2021, 01:01:39 pm »

The simple string method works - see method #3 in the code below. If anyone can think of a way to implement a 2-D array of stacks that performs better, let me know.

Code: QB64: [Select]

' OPTIONS
Option _Explicit
 
' GLOBAL DECLARATIONS a$=string, i%=integer, L&=long, s!=single, d#=double
Const FALSE = 0
Const TRUE = Not FALSE
 
' FOR Petr's suggestion #2:
Type UserField
    texture As Long
    Dynamic_Value As Long
End Type
Type Array2D
    Grid As UserField
    X_POS As Long
    Y_POS As Long
End Type
 
' INITIALIZE
Dim Shared ProgramPath$: ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared ProgramName$: ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
 
' RUN THE MAIN PROGRAM
main
 
' FINISH
System ' return control to the operating system
Print ProgramName$ + " finished."
End
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub main
    Dim in$: in$ = ""
    Do
        Cls
        Print ProgramName$
        Print
        Print "Test different ways to implement an array of stacks"
        Print
        Print "1. Method #1 = fixed length string"
        Print
        Print "2. Method #2 = user defined type"
        Print
        Print "3. Method #3 = simple string"
        Print
        Print "4. (TBD)"
        Print
        Print "What to do ('q' to exit)"
 
        Input in$: in$ = LCase$(Left$(in$, 1))
 
        If in$ = "1" Then
            ArrayOfStacks1
            _KeyClear: '_DELAY 1
 
        ElseIf in$ = "2" Then
            ArrayOfStacks2
            _KeyClear: '_DELAY 1
 
        ElseIf in$ = "3" Then
            ArrayOfStacks3
            _KeyClear: '_DELAY 1
 
        ElseIf in$ = "4" Then
            _KeyClear: '_DELAY 1
            Print "Under construction"
 
        End If
    Loop Until in$ = "q"
End Sub ' main
 
' /////////////////////////////////////////////////////////////////////////////
' Re: good way to implement an array of stacks/linked lists (for 2D tile-based game)?
' https://www.qb64.org/forum/index.php?topic=4008.0
 
' SMcNeill
' « Reply #2 on: Today at 03:28:41 PM »
 
' Wouldn't the easiest way to do something like this be just:
 
Sub ArrayOfStacks1
    Const x_tile_limit = 20
    Const y_tile_limit = 20
    Const z_stack_limit = 5
 
    'REDIM Objects(x_tile_limit, y_tile_limit) AS STRING * 10 'for a maximum of 10 items per tile
    ReDim Objects(x_tile_limit, y_tile_limit) As String * z_stack_limit ' for a maximum of z_stack_limit items per tile
    Dim xPos As Integer
    Dim yPos As Integer
    Dim zPos As Integer
    Dim in$
 
    Objects(10, 10) = Chr$(1) ' Item 1 is on the bottom of the stack
    Objects(10, 10) = Objects(10, 10) + Chr$(23) ' Item 23 is on top of it
    Objects(10, 10) = Objects(10, 10) + Chr$(107) ' Item 107 is above that one
    Objects(10, 10) = Objects(10, 10) + Chr$(114) ' And item 114 is rendered last and is the top of the stack
    ' And the next 6 characters are all blank
 
    ' Putting them into your tile would be that simple, and getting the info back out would just be:
 
    For xPos = 0 To 2 ' x_tile_limit
        For yPos = 0 To 2 ' y_tile_limit
            Print "(" + cstr$(xPos) + "," + cstr$(yPos) + ")"
            For zPos = 1 To z_stack_limit
                If Asc(Objects(xPos, yPos), zPos) <> 0 Then
                    ' Do whatever you do with that object
                    Print "    " + cstr$(zPos) + " = " + Chr$(34) + Mid$(Objects(xPos, yPos), zPos, 1) + Chr$(34)
                End If
            Next zPos
        Next yPos
    Next xPos
    'NEXT z, y, x
 
    Input "Press <ENTER> to continue"; in$
 
End Sub ' ArrayOfStacks1
 
' /////////////////////////////////////////////////////////////////////////////
' Re: good way to implement an array of stacks/linked lists (for 2D tile-based game)?
' https://www.qb64.org/forum/index.php?topic=4008.0
 
' Petr
' « Reply #3 on: Today at 03:34:47 PM »
 
' Easiest it is using TYPE. Just create usertype field structure. Something as this:
 
Sub ArrayOfStacks2
    ReDim UserF(100, 100) As Array2D
    Dim xPos As Integer
    Dim yPos As Integer
    Dim in$
 
    For xPos = 1 To 100
        For yPos = 1 To 100
            ' fill grid X and Y positions
            UserF(xPos, yPos).X_POS = xPos
            UserF(xPos, yPos).Y_POS = yPos
 
            UserF(xPos, yPos).Grid.texture = Rnd * 1000 ' _LOADIMAGE....
            UserF(xPos, yPos).Grid.Dynamic_Value = Rnd * 75 ' _SNDOPEN.....
        Next yPos
    Next xPos
 
    For xPos = 1 To 5
        For yPos = 1 To 5
            Print "(" + cstr$(xPos) + "," + cstr$(yPos) + ")"
            Print "    .X_POS=" + cstr$(UserF(xPos, yPos).X_POS)
            Print "    .Y_POS=" + cstr$(UserF(xPos, yPos).X_POS)
            Print "    .Grid.texture=" + cstr$(UserF(xPos, yPos).Grid.texture)
            Print "    .Grid.Dynamic_Value=" + cstr$(UserF(xPos, yPos).Grid.Dynamic_Value)
        Next yPos
    Next xPos
 
    Input "Press <ENTER> to continue"; in$
End Sub ' ArrayOfStacks2
 
' /////////////////////////////////////////////////////////////////////////////
 
' Simplest approach where each tile is limited to the size of the string,
' to get the number of objects on a tile, do
'     iNumObjects = LEN(Objects(xPos, yPos)),
 
Sub ArrayOfStacks3
    ReDim arrMap(10, 10) As String
    Dim xPos As Integer
    Dim yPos As Integer
    Dim iCount As Integer
    Dim iLoop As Integer
    Dim iChar As Integer
    Dim sNext As String
    Dim sLine As String
    Dim sRemoved As String
    Dim in$
 
    ' POPULATE MAP WITH A RANDOM # OF OBJECTS ON EACH TILE
    ' USING "PUSH" ROUTINE
    For xPos = 1 To 10
        For yPos = 1 To 10
            iCount = RandomNumber%(1, 20)
            If iCount < 6 Then
                For iLoop = 1 To iCount
                    iChar = RandomNumber%(65, 90)
                    DoPush arrMap(), xPos, yPos, Chr$(iChar)
                Next iLoop
            Else
                arrMap(xPos, yPos) = ""
            End If
        Next yPos
    Next xPos
 
    ' PRINT THE INITIAL MAP
    Print "CONTENTS BEFORE REMOVE:"
    sLine = ""
    For yPos = 1 To 10
        For xPos = 1 To 10
            ' WRAP OUTPUT TO 80 COLUMNS
            ' MAX SIZE EACH ENTRY = 16: (10,10)="ABCDE"
            '                           1234567890123456
            If Len(sLine) > 64 Then
                Print sLine
                sLine = ""
            End If
            If Len(arrMap(xPos, yPos)) > 0 Then
                sLine = sLine + "(" + cstr$(xPos) + "," + cstr$(yPos) + ")=" + Chr$(34) + arrMap(xPos, yPos) + Chr$(34) + " "
            End If
        Next xPos
    Next yPos
    Print sLine
    Input "Press <ENTER> to continue"; in$
 
    ' REMOVE ONE OBJECT OFF THE TOP OF EACH TILE
    ' USING "POP" FUNCTION
    Print
    Print "REMOVED ONE FROM THE TOP OF EACH:"
    sRemoved = ""
    sLine = ""
    For yPos = 1 To 10
        For xPos = 1 To 10
            If Len(sLine) > 64 Then
                Print sLine
                sLine = ""
            End If
            If Len(arrMap(xPos, yPos)) > 0 Then
                sNext = DoPop$(arrMap(), xPos, yPos)
                sRemoved = sRemoved + sNext
                sLine = sLine + "(" + cstr$(xPos) + "," + cstr$(yPos) + ")=" + Chr$(34) + arrMap(xPos, yPos) + Chr$(34) + " "
            End If
        Next xPos
    Next yPos
    Print sLine
 
    Print
    Print "ALL REMOVED:"
    sLine = ""
    For iLoop = 1 To Len(sRemoved)
        If Len(sLine) > 64 Then
            Print sLine
            sLine = ""
        End If
        sLine = sLine + IIFSTR$(iLoop > 1, ", ", "") + Mid$(sRemoved, iLoop, 1)
    Next iLoop
    Print sLine
    Input "Press <ENTER> to continue"; in$
 
End Sub ' ArrayOfStacks3
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub DoPush (arrTiles() As String, xPos As Integer, yPos As Integer, sObject As String)
    arrTiles(xPos, yPos) = arrTiles(xPos, yPos) + sObject
End Sub ' DoPush
 
' /////////////////////////////////////////////////////////////////////////////
 
Function DoPop$ (arrTiles() As String, xPos As Integer, yPos As Integer)
    Dim iLen As Integer
    iLen = Len(arrTiles(xPos, yPos))
    If iLen > 0 Then
        If iLen = 1 Then
            DoPop$ = arrTiles(xPos, yPos)
            arrTiles(xPos, yPos) = ""
        Else
            DoPop$ = Right$(arrTiles(xPos, yPos), 1)
            arrTiles(xPos, yPos) = Left$(arrTiles(xPos, yPos), Len(arrTiles(xPos, yPos)) - 1)
        End If
    Else
        DoPop$ = ""
    End If
End Function ' DoPop$
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub DumpAsciiValues
    Dim iLoop As Integer
    Dim sLine As String
    Dim in$
 
    sLine = ""
    For iLoop = 32 To 127
        If Len(sLine) > 72 Then
            Print sLine
            sLine = ""
        End If
        sLine = sLine + cstr$(iLoop) + "=" + Chr$(34) + Chr$(iLoop) + Chr$(34) + IIFSTR$(iLoop < 127, ",", "")
    Next iLoop
    Print sLine
 
    Input "Press <ENTER> to continue"; in$
End Sub ' DumpAsciiValues
 
' /////////////////////////////////////////////////////////////////////////////
' Convert a value to string and trim it (because normal Str$ adds spaces)
 
Function cstr$ (myValue)
    'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
    cstr$ = _Trim$(Str$(myValue))
End Function ' cstr$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IIF (Condition, IfTrue, IfFalse)
    If Condition Then IIF = IfTrue Else IIF = IfFalse
End Function
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IIFSTR$ (Condition, IfTrue$, IfFalse$)
    If Condition Then IIFSTR$ = IfTrue$ Else IIFSTR$ = IfFalse$
End Function
 
' /////////////////////////////////////////////////////////////////////////////
' Generate random value between Min and Max.
Function RandomNumber% (Min%, Max%)
    Dim NumSpread%
 
    ' SET RANDOM SEED
    'Randomize ' Initialize random-number generator.
    Randomize Timer
 
    ' GET RANDOM # Min%-Max%
    'RandomNumber = Int((Max * Rnd) + Min) ' generate number
 
    NumSpread% = (Max% - Min%) + 1
 
    RandomNumber% = Int(Rnd * NumSpread%) + Min% ' GET RANDOM # BETWEEN Max% AND Min%
 
End Function ' RandomNumber%
 

SMcNeill · « **Reply #8 on:** June 28, 2021, 04:59:39 pm »

If memory is a concern, then STRING isn’t the way to go. Every string variable in QB64 has quite a bit of overhead associated with it. (A pointer to the data, a variable to hold length of data, maybe some other stuff which I don’t remember.) If my memory isn’t failing (and it usually is), every STRING has an internal 32-byte data type that it maps to (qbs type).

So DIM x(1 TO 10) uses 320 bytes memory, on top of whatever data it holds.

Usually this isn’t a big deal, but a 2d array of some size could have a decent amount of overhead associated with it.

DIM tile (x, y, z) AS _BYTE could conceivably use less memory than DIM tile(x, y) AS STRING just from the amount of memory required to track all those pointers and lengths.

Edit -- 20 bytes, I think, if my math is correct:

struct qbs{
uint8 *chr;//a 32 bit pointer to the string's data
int32 len;//must be signed for comparisons against signed int32s
uint8 in_cmem;//set to 1 if in the conventional memory DBLOCK
uint16 *cmem_descriptor;
uint16 cmem_descriptor_offset;
uint32 listi;//the index in the list of strings that references it
uint8 tmp;//set to 1 if the string can be deleted immediately after being processed
uint32 tmplisti;//the index in the list of strings that references it
uint8 fixed;//fixed length string
uint8 readonly;//set to 1 if string is read only
qbs_field *field;
};

johannhowitzer · « **Reply #9 on:** June 28, 2021, 10:46:48 pm »

I would simply store a general stack of objects, and in that stack, store their x and y coordinates. This imposes no limit on each individual tile, only on the whole map, and unless you have a huge limit for the whole map, saves a lot of data space.

Each object can then carry its own attributes, or simply be an index referring to an array containing all the various objects and their preset attributes.

EDIT: Ok, now that I'm home from work, I can expand on this a little. You can have something like the following:

Code: QB64: [Select]

type entity_spec_structure
   ' stuff about entities in here
end type
dim shared entity_spec(100) as entity_spec_structure ' preset data for entities that can be on tiles in your map
 
type entity_structure
   i as integer ' index from entity_spec() represented by this entity
   x as integer ' position on the map
   y as integer
end type
dim shared entity(100) as entity_structure
dim shared entity_count as integer

Now you can add things to this stack, and then use the coordinates to draw the appropriate sprites, look through for a matching position if the player's trying to pick up an item from the tile they're standing on, etc. Doing collision becomes O(n^2) time complexity if you're doing pairwise comparisons, but you can add a pre-processing array back in if you want, it will again limit how many things can be on a given tile, but removes the need for pairwise:

Code: QB64: [Select]

dim shared map_objects([x], [y], [n]) as integer ' First two dimensions are coordinates, last carries the stack, value is the entity index
 
' Wipe the array first
for x = 1 to [map width]
   for y = 1 to [map height]
      for n = 1 to [tile object limit]
         map_objects(x, y, n) = false
      next n
   next y
next x
 
' Put each entity on its tile
for e = 1 to entity_count
   n = 1
   do until map_objects(entity(e).x, entity(e).y, n) = false
      if n > [tile object limit] then _continue
      n = n + 1
   loop
   map_objects(entity(n).x, entity(n).y, n) = e
next e

Now, when you go to do collision, you can run through the entities in index order, and only check the above pre-processed array at the relevant coordinates, until you run into one that is false. You're not storing the whole specifications of every object on the grid, just indices referring to them. This puts a pretty low upper bound on how much needs to be done every time collision is checked. Hope that makes sense.

madscijr · « **Reply #10 on:** June 29, 2021, 09:04:53 am »

Quote from: SMcNeill on June 28, 2021, 04:59:39 pm

If memory is a concern, then STRING isn’t the way to go.
...
DIM tile (x, y, z) AS _BYTE could conceivably use less memory

Memory isn't so much a concern as speed.
However a stack of _BYTE would be sufficient and preferable to a stack of string characters,
which I would want to convert to a numeric value anyway (an index against some array of objects in the game).

The most important thing is being able to qucikly index the stack of objects at a given x,y coordinate, and that the stack maintains its order.
I'm going to try implementing a simple stack of integers using an array and see how that looks.

madscijr · « **Reply #11 on:** June 29, 2021, 09:09:07 am »

Quote from: johannhowitzer on June 28, 2021, 10:46:48 pm

I would simply store a general stack of objects, and in that stack, store their x and y coordinates.

Thanks for your reply and taking the time to share that example, I'll give it a look.
The concern I have with this method, is that you have to loop through the whole stack testing the x and y for each item, to find all items for a given (x,y).
You talk about a pre-processed array, is that to speed up that process? I didn't quite follow it in your explanation, but I will understand better once I look at your code in the QB64 editor and can run it & play with it.
Thanks again!

SMcNeill · « **Reply #12 on:** June 29, 2021, 10:54:04 am »

Another way to think about this, is conceivably from the items perspective.

Let's say I have a map of 100x100 tiles. The vast majority of those are going to simply be "base tiles"; the floor, wall, grass, water, ect...

Now, above those tiles, I'm going to have the layers of objects which you're talking about -- table graphic, chair, creature, ect...

The 100 x 100 grid gives us 10,000 points of data, even if we track a blank number of objects imposed upon it, such as with DIM TileObject(100, 100) AS STRING, as you mentioned above.

For speed concerns, might it not be better to instead simply track the objects themselves upon the map?

TYPE ObjectType
item AS _BYTE (item id)
x AS _BYTE
y AS _BYTE
END TYPE

REDIM Objects(0) AS ObjectType

Then, if I place 100 items on the map (ignoring the vast majority of walls, water, and ceiling tiles), I'd only need to cycle through that list of 100 items from top to bottom, to place my objects onto the map. Object(1) might be a table. Object(2) might be a book at the same X/Y coordinates, so it renders on top of the table. Object(3) might be a coin sitting on top of the book...

I suppose the thing to be thinking about is if there's going to be less tiles to process for objects, or less objects to process than tiles. The answer to that question might affect the efficiency of your data structure significantly.

Cobalt · « **Reply #13 on:** June 29, 2021, 11:57:13 am »

knowing nothing about just what kind of game your working on all I could do is give you an example from my current project Phantasy Star.

Code: QB64: [Select]

TYPE TownTiles
 Id AS _UNSIGNED _BYTE
 Is_Walkable AS _BYTE
 Is_Animated AS _BYTE
 Is_NPC_Location AS _BYTE 'where the NPCs stand this links to the NPC array
 Is_Building AS _UNSIGNED _BYTE 'covers shops and houses and caves(in towns) and churches
 Is_Exit AS _BYTE
 Search_Item AS _BYTE 'is there something to find? Most of these require a Flag set too
 Dialogs AS INTEGER 'used with NPCs in Building for conversations
 Setting AS _BYTE 'building inside and npc image to use
END TYPE
 
TYPE NPC_Dialog
 Map AS _BYTE
 X AS _BYTE
 Y AS _BYTE
 Kind AS _BYTE 'standard dialog or special? Special requires item or flag
 Map_Sprite AS _BYTE 'map display sprite
 Scene_Setup AS _UNSIGNED _BYTE 'scene background and NPC sprite when entering dialog
 Dialog AS _BYTE 'link to array of dialog spoken by NPCs
END TYPE
 
DIM SHARED TownMap(9, 54, 39) AS TownTiles 
DIM SHARED NPC(127) as NPC_Dialog
 

So here you have the Town Array and Type, as well as the NPC Array and Type, 2 items needed for the map but kept separate for size and access ease(if only we had Arrays in UDTs :( ). so if you look at the TownTile Type you will see Is_NPC_Location, so while the townmap array knows where the npcs are it doesn't hold their actual information, just a value that points to the NPC array.
Now this approach works cause the NPCs in this game do not move. In Dragon Warrior the NPCs were mobile so the townmap arrays there had no information on them at all, it was all handled in the NPC data with extra collision functions to handle their locations.

So depending on what you need to store, static items or moving creatures, will determine how you want to implement things. If its just like items that are pre-generate when the program starts or placed down by the player during game play then a TYPE system that links to an array would probably be a good idea, along with a limit on the max number of items any tile can hold at any one time(say 127 or 255 to use _BYTE or _UNSIGNED _BYTE) However,
If its something that can change location like an NPC or Creature then you would be better off not storing that information with each tile but in a separate array for those things. And processing them separately with their own code.

and to help keep speed in check only process what can be seen, as with this example:

Code: QB64: [Select]

SUB Display_NPC (Ax%%, AY%%, Sx%, Sy%)
 'sx and sy are used when player moves to Scroll the screen
 'ax adn ay players current map x and y to shift npc locations
 Mx%% = Ax%% - 9 '-9 to center on player character
 My%% = AY%% - 7 '-7 to center(ish) on player character
 FOR i%% = 1 TO 10
  IF NPC(i%%).Map = P(0).Is_Intown THEN
   IF NPC(i%%).Map_Sprite = 6 THEN
    _PUTIMAGE (Sx% + (NPC(i%%).X - Mx%%) * 32, Sy% + (NPC(i%%).Y - My%%) * 32 - 30)-STEP(45, 45), Layer(7), Layer(1), (0 + 17 * NPC(i%%).Map_Sprite, 180)-STEP(23, 23)
   ELSE
    _PUTIMAGE (Sx% + (NPC(i%%).X - Mx%%) * 32, Sy% + (NPC(i%%).Y - My%%) * 32 - 30)-STEP(31, 45), Layer(7), Layer(1), (0 + 17 * NPC(i%%).Map_Sprite, 180)-STEP(15, 23)
   END IF
  END IF
 NEXT i%%
END SUB
 

now at the moment I only have 10 NPCs done, so I don't have any speed worries. You can see though that I have already implemented a control:
IF NPC(i%%).Map = P(0).Is_Intown THEN
So I am only processing things that are in the same town map as the player. I could take this even farther by only looking for things that are in the players view, as you can see the map is centered around the player. So if this was a huge map of 10s of thousands tiles with thousands of Objects to deal with you would certainly want to limit how many the program deals with at any one time. if your only going to have a few hundred objects globally then dont worry about it. In Dragon Warrior I only had, i think, 117 NPCs so I processed their movement and collision all the time when the player was in towns, while only displaying the ones on the current map, with out any speed issues and probably could have handled 3 or 4 times that number easily.

I know this isn't technically Bill's "Linked Lists" thing but its my view as where you use a value in one array to look at another (to look at another and so on if needed) where what is in that second array can change without affecting the first.

madscijr · « **Reply #14 on:** June 30, 2021, 05:36:11 pm »

A few of you had talked about storing a pointer in the map array to a second array,
so buidling on that and the string-based stack (method #3),
I came up with a working stack of UDTs - code below, see method #5!

The POP uses a soft delete, and PUSH recycles any previously deleted items hanging around,
which I think helps with performance (I foresee there being roughly an equal # of inserts/deletes in my game).

Thanks for your suggestions - any comments welcome.

Code: QB64: [Select]

' OPTIONS
Option _Explicit
 
' GLOBAL DECLARATIONS a$=string, i%=integer, L&=long, s!=single, d#=double
Const FALSE = 0
Const TRUE = Not FALSE
 
' FOR Petr's suggestion #2:
Type UserField
    texture As Long
    Dynamic_Value As Long
End Type
Type Array2D
    Grid As UserField
    X_POS As Long
    Y_POS As Long
End Type
 
' FOR ArrayOfStacks4
Type entity_spec_structure
    name As String
    value As Integer
End Type
Type entity_structure
    i As Integer ' index from entity_spec() represented by this entity
    x As Integer ' position on the map
    y As Integer
End Type
 
' FOR ArrayOfStacks5
Type StackNodeType
    name As String
    value As Integer
    NextIndex As Integer
    'IsDeleted AS INTEGER <- not needed but you can add this if you want a way to quickly test if a node is deleted
    'xPos AS INTEGER <- not needed but you can add this if you want a way to quickly get a node's x position on the map
    'yPos AS INTEGER <- not needed but you can add this if you want a way to quickly get a node's y position on the map
End Type
 
 
' INITIALIZE
Dim Shared ProgramPath$: ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared ProgramName$: ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
 
' RUN THE MAIN PROGRAM
main
 
' FINISH
System ' return control to the operating system
Print ProgramName$ + " finished."
End
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub main
    Dim in$: in$ = ""
    Do
        Cls
        Print ProgramName$
        Print
        Print "Test different ways to implement an array of stacks"
        Print
        Print "1. Method #1 = fixed length string"
        Print
        Print "2. Method #2 = user defined type"
        Print
        Print "3. Method #3 = simple string-based stack"
        Print
        Print "4. Method #4 = entity arrays(?) = not working"
        Print
        Print "5. Method #5 = array-based stack of objects (UDTs)"
        Print
        Print "What to do ('q' to exit)"
 
        Input in$: in$ = LCase$(Left$(in$, 1))
 
        If in$ = "1" Then
            ArrayOfStacks1
            _KeyClear: '_DELAY 1
 
        ElseIf in$ = "2" Then
            ArrayOfStacks2
            _KeyClear: '_DELAY 1
 
        ElseIf in$ = "3" Then
            ArrayOfStacks3
            _KeyClear: '_DELAY 1
 
        ElseIf in$ = "4" Then
            _KeyClear: '_DELAY 1
            Print "Under construction"
 
        ElseIf in$ = "5" Then
            ArrayOfStacks5
            _KeyClear: '_DELAY 1
 
        ElseIf in$ = "6" Then
            _KeyClear: '_DELAY 1
            Print "Under construction"
 
        End If
    Loop Until in$ = "q"
End Sub ' main
 
' /////////////////////////////////////////////////////////////////////////////
' Re: good way to implement an array of stacks/linked lists (for 2D tile-based game)?
' https://www.qb64.org/forum/index.php?topic=4008.0
 
' SMcNeill
' « Reply #2 on: Today at 03:28:41 PM »
 
' Wouldn't the easiest way to do something like this be just:
 
Sub ArrayOfStacks1
    Const x_tile_limit = 20
    Const y_tile_limit = 20
    Const z_stack_limit = 5
 
    'REDIM Objects(x_tile_limit, y_tile_limit) AS STRING * 10 'for a maximum of 10 items per tile
    ReDim Objects(x_tile_limit, y_tile_limit) As String * z_stack_limit ' for a maximum of z_stack_limit items per tile
    Dim xPos As Integer
    Dim yPos As Integer
    Dim zPos As Integer
    Dim in$
 
    Objects(10, 10) = Chr$(1) ' Item 1 is on the bottom of the stack
    Objects(10, 10) = Objects(10, 10) + Chr$(23) ' Item 23 is on top of it
    Objects(10, 10) = Objects(10, 10) + Chr$(107) ' Item 107 is above that one
    Objects(10, 10) = Objects(10, 10) + Chr$(114) ' And item 114 is rendered last and is the top of the stack
    ' And the next 6 characters are all blank
 
    ' Putting them into your tile would be that simple, and getting the info back out would just be:
 
    For xPos = 0 To 2 ' x_tile_limit
        For yPos = 0 To 2 ' y_tile_limit
            Print "(" + cstr$(xPos) + "," + cstr$(yPos) + ")"
            For zPos = 1 To z_stack_limit
                If Asc(Objects(xPos, yPos), zPos) <> 0 Then
                    ' Do whatever you do with that object
                    Print "    " + cstr$(zPos) + " = " + Chr$(34) + Mid$(Objects(xPos, yPos), zPos, 1) + Chr$(34)
                End If
            Next zPos
        Next yPos
    Next xPos
    'NEXT z, y, x
 
    Input "Press <ENTER> to continue"; in$
 
End Sub ' ArrayOfStacks1
 
' /////////////////////////////////////////////////////////////////////////////
' Re: good way to implement an array of stacks/linked lists (for 2D tile-based game)?
' https://www.qb64.org/forum/index.php?topic=4008.0
 
' Petr
' « Reply #3 on: Today at 03:34:47 PM »
 
' Easiest it is using TYPE. Just create usertype field structure. Something as this:
 
Sub ArrayOfStacks2
    ReDim UserF(100, 100) As Array2D
    Dim xPos As Integer
    Dim yPos As Integer
    Dim in$
 
    For xPos = 1 To 100
        For yPos = 1 To 100
            ' fill grid X and Y positions
            UserF(xPos, yPos).X_POS = xPos
            UserF(xPos, yPos).Y_POS = yPos
 
            UserF(xPos, yPos).Grid.texture = Rnd * 1000 ' _LOADIMAGE....
            UserF(xPos, yPos).Grid.Dynamic_Value = Rnd * 75 ' _SNDOPEN.....
        Next yPos
    Next xPos
 
    For xPos = 1 To 5
        For yPos = 1 To 5
            Print "(" + cstr$(xPos) + "," + cstr$(yPos) + ")"
            Print "    .X_POS=" + cstr$(UserF(xPos, yPos).X_POS)
            Print "    .Y_POS=" + cstr$(UserF(xPos, yPos).X_POS)
            Print "    .Grid.texture=" + cstr$(UserF(xPos, yPos).Grid.texture)
            Print "    .Grid.Dynamic_Value=" + cstr$(UserF(xPos, yPos).Grid.Dynamic_Value)
        Next yPos
    Next xPos
 
    Input "Press <ENTER> to continue"; in$
End Sub ' ArrayOfStacks2
 
' /////////////////////////////////////////////////////////////////////////////
 
' Simplest approach where each tile is limited to the size of the string,
' to get the number of objects on a tile, do
'     iNumObjects = LEN(Objects(xPos, yPos)),
 
Sub ArrayOfStacks3
    ReDim arrMap(10, 10) As String
    Dim xPos As Integer
    Dim yPos As Integer
    Dim iCount As Integer
    Dim iLoop As Integer
    Dim iChar As Integer
    Dim sNext As String
    Dim sLine As String
    Dim sRemoved As String
    Dim in$
 
    ' POPULATE MAP WITH A RANDOM # OF OBJECTS ON EACH TILE
    ' USING "PUSH" ROUTINE
    For xPos = 1 To 10
        For yPos = 1 To 10
            iCount = RandomNumber%(1, 20)
            If iCount < 6 Then
                For iLoop = 1 To iCount
                    iChar = RandomNumber%(65, 90)
                    DoPush3 arrMap(), xPos, yPos, Chr$(iChar)
                Next iLoop
            Else
                arrMap(xPos, yPos) = ""
            End If
        Next yPos
    Next xPos
 
    ' PRINT THE INITIAL MAP
    Print "CONTENTS BEFORE REMOVE:"
    sLine = ""
    For yPos = 1 To 10
        For xPos = 1 To 10
            ' WRAP OUTPUT TO 80 COLUMNS
            ' MAX SIZE EACH ENTRY = 16: (10,10)="ABCDE"
            '                           1234567890123456
            If Len(sLine) > 64 Then
                Print sLine
                sLine = ""
            End If
            If Len(arrMap(xPos, yPos)) > 0 Then
                sLine = sLine + "(" + cstr$(xPos) + "," + cstr$(yPos) + ")=" + Chr$(34) + arrMap(xPos, yPos) + Chr$(34) + " "
            End If
        Next xPos
    Next yPos
    Print sLine
    Input "Press <ENTER> to continue"; in$
 
    ' REMOVE ONE OBJECT OFF THE TOP OF EACH TILE
    ' USING "POP" FUNCTION
    Print
    Print "REMOVED ONE FROM THE TOP OF EACH:"
    sRemoved = ""
    sLine = ""
    For yPos = 1 To 10
        For xPos = 1 To 10
            If Len(sLine) > 64 Then
                Print sLine
                sLine = ""
            End If
            If Len(arrMap(xPos, yPos)) > 0 Then
                sNext = DoPop3$(arrMap(), xPos, yPos)
                sRemoved = sRemoved + sNext
                sLine = sLine + "(" + cstr$(xPos) + "," + cstr$(yPos) + ")=" + Chr$(34) + arrMap(xPos, yPos) + Chr$(34) + " "
            End If
        Next xPos
    Next yPos
    Print sLine
 
    Print
    Print "ALL REMOVED:"
    sLine = ""
    For iLoop = 1 To Len(sRemoved)
        If Len(sLine) > 64 Then
            Print sLine
            sLine = ""
        End If
        sLine = sLine + IIFSTR$(iLoop > 1, ", ", "") + Mid$(sRemoved, iLoop, 1)
    Next iLoop
    Print sLine
    Input "Press <ENTER> to continue"; in$
 
End Sub ' ArrayOfStacks3
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub DoPush3 (arrTiles() As String, xPos As Integer, yPos As Integer, sObject As String)
    arrTiles(xPos, yPos) = arrTiles(xPos, yPos) + sObject
End Sub ' DoPush3
 
' /////////////////////////////////////////////////////////////////////////////
 
Function DoPop3$ (arrTiles() As String, xPos As Integer, yPos As Integer)
    Dim iLen As Integer
    iLen = Len(arrTiles(xPos, yPos))
    If iLen > 0 Then
        If iLen = 1 Then
            DoPop3$ = arrTiles(xPos, yPos)
            arrTiles(xPos, yPos) = ""
        Else
            DoPop3$ = Right$(arrTiles(xPos, yPos), 1)
            arrTiles(xPos, yPos) = Left$(arrTiles(xPos, yPos), Len(arrTiles(xPos, yPos)) - 1)
        End If
    Else
        DoPop3$ = ""
    End If
End Function ' DoPop3$
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub DumpAsciiValues
    Dim iLoop As Integer
    Dim sLine As String
    Dim in$
 
    sLine = ""
    For iLoop = 32 To 127
        If Len(sLine) > 72 Then
            Print sLine
            sLine = ""
        End If
        sLine = sLine + cstr$(iLoop) + "=" + Chr$(34) + Chr$(iLoop) + Chr$(34) + IIFSTR$(iLoop < 127, ",", "")
    Next iLoop
    Print sLine
 
    Input "Press <ENTER> to continue"; in$
End Sub ' DumpAsciiValues
 
' /////////////////////////////////////////////////////////////////////////////
' Re: good way to implement an array of stacks/linked lists (for 2D tile-based game)?
' https://www.qb64.org/forum/index.php?topic=4008.0
 
' johannhowitzer
' « Reply #9 on: Yesterday at 10:46:48 PM »
 
' I would simply store a general stack of objects, and in that stack,
' store their x and y coordinates.
' This imposes no limit on each individual tile, only on the whole map,
' and unless you have a huge limit for the whole map, saves a lot of data
' space.
'
' Each object can then carry its own attributes, or simply be an index
' referring to an array containing all the various objects and their
' preset attributes.
'
' EDIT: Ok, now that I'm home from work, I can expand on this a little.
' You can have something like the following:
'
' Now you can add things to this stack, and then use the coordinates to draw
' the appropriate sprites, look through for a matching position if the
' player's trying to pick up an item from the tile they're standing on, etc.
' Doing collision becomes O(n^2) time complexity if you're doing pairwise
' comparisons, but you can add a pre-processing array back in if you want,
' it will again limit how many things can be on a given tile, but removes
' the need for pairwise:
'
' Now, when you go to do collision, you can run through the entities in
' index order, and only check the above pre-processed array at the relevant
' coordinates, until you run into one that is false.  You're not storing the
' whole specifications of every object on the grid, just indices referring to
' them. This puts a pretty low upper bound on how much needs to be done every
' time collision is checked.  Hope that makes sense.
 
' COMMENTS:
' This seems overly complicated. Do we really need entity(100)?
Sub ArrayOfStacks4
    Dim map_objects(10, 10, 10) As Integer ' First two dimensions are coordinates, last carries the stack, value is the entity index
    Dim entity_spec(100) As entity_spec_structure ' preset data for entities that can be on tiles in your map
    Dim entity(100) As entity_structure
    Dim entity_count As Integer
    Dim x As Integer
    Dim y As Integer
    Dim n As Integer
    Dim e As Integer
    Dim in$
 
    ' Wipe the array first
    For x = 1 To 10 ' [map width]
        For y = 1 To 10 ' [map height]
            For n = 1 To 10 ' [tile object limit]
                map_objects(x, y, n) = FALSE
            Next n
        Next y
    Next x
 
    ' Put each entity on its tile
    entity_count = 10 ' we will drop 10 of these
    n = 0
    For e = 1 To entity_count
        ' entity_spec_structure values:
        entity_spec(e).name = "entity #" + cstr$(e)
        entity_spec(e).value = RandomNumber%(0, 100)
 
        ' entity_structure values:
        n = n + 1
        x = RandomNumber%(1, 10)
        y = RandomNumber%(1, 10)
        entity(n).i = e
        entity(n).x = x
        entity(n).y = y
 
        ' add to map:
        map_objects(entity(n).x, entity(n).y, n) = e
    Next e
 
    ' Show results
    For y = 1 To 10 ' [map height]
        For x = 1 To 10 ' [map width]
            For n = 1 To 10 ' [tile object limit]
                If map_objects(x, y, n) <> FALSE Then
                    e = map_objects(entity(n).x, entity(n).y, n)
 
                End If
            Next n
        Next x
    Next y
 
    Input "Press <ENTER> to continue"; in$
End Sub ' ArrayOfStacks4
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub ArrayOfStacks5
    Dim arrMap(5, 5) As Integer
    ReDim arrStack(0) As StackNodeType ' index 0 holds next empty/deleted node
    Dim xPos As Integer
    Dim yPos As Integer
    Dim iCount As Integer
    Dim iLoop As Integer
    Dim sName As String
    Dim iValue As Integer
    Dim iTotal As Integer
    Dim MyIndex As Integer
    Dim NewTop As Integer
    Dim sChanged As String
    Dim sLine As String
    Dim iPrintCount As Integer
    Dim in$
 
    ' INITIALIZE STACK
    arrStack(0).NextIndex = 0 ' values > -1 points to next available node
    arrStack(0).name = "NextFree"
 
    ' POPULATE MAP WITH A RANDOM # OF OBJECTS ON EACH TILE
    ' USING "PUSH" ROUTINE
    iTotal = 0
    For xPos = 1 To 5
        For yPos = 1 To 5
            iCount = RandomNumber%(1, 20)
            If iCount < 4 Then
                MyIndex = 0
                For iLoop = 1 To iCount
                    iTotal = iTotal + 1
                    sName = "item" + cstr$(iTotal)
                    iValue = RandomNumber%(0, 100)
                    MyIndex = DoPush5%(arrStack(), MyIndex, sName, iValue)
                    arrMap(xPos, yPos) = MyIndex
                Next iLoop
            Else
                arrMap(xPos, yPos) = 0
            End If
        Next yPos
    Next xPos
 
    ' PRINT THE INITIAL MAP
    Print "CONTENTS BEFORE REMOVE:"
    For yPos = 1 To 5
        For xPos = 1 To 5
            If arrMap(xPos, yPos) > 0 Then
                MyIndex = arrMap(xPos, yPos)
                Print DumpStack5$(arrStack(), MyIndex, "arrMap(" + cstr$(yPos) + "," + cstr$(xPos) + "): ")
            End If
        Next xPos
    Next yPos
    Print DumpStack5$(arrStack(), 0, "Next Free: ")
    Print
    Input "Press <ENTER> to continue"; in$
    Print
 
    ' REMOVE ONE OBJECT OFF THE TOP OF EACH TILE
    ' USING "POP" FUNCTION
    sChanged = ""
    sLine = ""
    iPrintCount = 0
    For yPos = 1 To 5
        For xPos = 1 To 5
            ' WRAP OUTPUT TO 80 COLUMNS
            If Len(sLine) > 64 Then
                sChanged = sChanged + IIFSTR$(Len(sChanged) = 0, "", Chr$(10)) + "    " + sLine
                sLine = ""
                iPrintCount = 0
            End If
            If arrMap(xPos, yPos) > 0 Then
                MyIndex = arrMap(xPos, yPos)
                iPrintCount = iPrintCount + 1
 
                sLine = sLine + IIFSTR$(iPrintCount > 1, ", ", "")
                sLine = sLine + cstr$(MyIndex) + "=" + arrStack(MyIndex).name + ">"
                sLine = sLine + cstr$(arrStack(MyIndex).NextIndex)
 
                NewTop = DoPop5%(arrStack(), MyIndex)
                arrMap(xPos, yPos) = NewTop
            End If
        Next xPos
    Next yPos
    sChanged = sChanged + IIFSTR$(Len(sChanged) = 0, "", Chr$(10)) + "    " + sLine
 
    Print
    Print "REMOVED ONE FROM THE TOP OF EACH:"
    Print sChanged
    Print
    Input "Press <ENTER> to continue"; in$
    Print
 
    ' PRINT MAP AFTER ITEMS REMOVED
    Print "CONTENTS AFTER REMOVE:"
    For yPos = 1 To 5
        For xPos = 1 To 5
            If arrMap(xPos, yPos) > 0 Then
                Print DumpStack5$(arrStack(), arrMap(xPos, yPos), "arrMap(" + cstr$(yPos) + "," + cstr$(xPos) + "): ")
            End If
        Next xPos
    Next yPos
    Print DumpStack5$(arrStack(), 0, "Next Free: ")
    Print
    Input "Press <ENTER> to continue"; in$
    Print
 
    ' ADD ONE OBJECT TO THE TOP OF EACH TILE
    ' USING "PUSH" FUNCTION
    sChanged = ""
    sLine = ""
    For yPos = 1 To 5
        For xPos = 1 To 5
            ' WRAP OUTPUT TO 80 COLUMNS
            If Len(sLine) > 64 Then
                sChanged = sChanged + IIFSTR$(Len(sChanged) = 0, "", Chr$(10)) + "    " + sLine
                sLine = ""
            End If
            If arrMap(xPos, yPos) > 0 Then
                MyIndex = arrMap(xPos, yPos)
 
                iTotal = iTotal + 1
                sName = "item" + cstr$(iTotal)
                iValue = RandomNumber%(0, 100)
                MyIndex = DoPush5%(arrStack(), MyIndex, sName, iValue)
                arrMap(xPos, yPos) = MyIndex
 
                sLine = sLine + cstr$(MyIndex) + "=" + arrStack(MyIndex).name + ">"
                sLine = sLine + cstr$(arrStack(MyIndex).NextIndex) + ", "
            End If
        Next xPos
    Next yPos
    sChanged = sChanged + IIFSTR$(Len(sChanged) = 0, "", Chr$(10)) + "    " + sLine
 
    Print
    Print "ADDED ONE TO THE TOP OF EACH:"
    Print sChanged
    Print
    Input "Press <ENTER> to continue"; in$
    Print
 
    ' PRINT MAP AFTER ITEMS ADDED
    Print "CONTENTS AFTER ADDING:"
    For yPos = 1 To 5
        For xPos = 1 To 5
            If arrMap(xPos, yPos) > 0 Then
                Print DumpStack5$(arrStack(), arrMap(xPos, yPos), "arrMap(" + cstr$(yPos) + "," + cstr$(xPos) + "): ")
            End If
        Next xPos
    Next yPos
    Print DumpStack5$(arrStack(), 0, "Next Free: ")
    Print
    Input "Press <ENTER> to continue"; in$
 
End Sub ' ArrayOfStacks5
 
' /////////////////////////////////////////////////////////////////////////////
' RECEIVES:
' arrStack = array of nodes representing multiple stacks
' MyIndex = node to drop new element on top of
' sName = string value for new node
' iValue = numeric value for new node
 
' RETURNS:
' NextIndex = the new node's index in array arrStack
' (arrStack is updated by reference)
 
' HOW THE STACK WORKS:
'
' arrStack() holds multiple stacks, each "chain" has 1 or more node,
' where the top node's index is kept track of by whatever code is using this,
' for example a 2-D tilemap might holds the index of the top object at arrMap(x,y)
'
' Index 0 is used to track deleted nodes,
' because we don't delete nodes from the arrStack, just reuse them.
' When a node is "deleted", we set arrStack(0) to the index of the deleted node.
' When we delete subsequent nodes, each one's .nextIndex points to the next available
' deleted node in a "chain". When we reuse the next given node,
' we repoint arrStack(0) to the next one, and so arrStack(0).nextIndex always points
' to the next available node to be reused.
'
' If arrStack(0) = 0, there are no deleted nodes to be reused,
' then we append a new element to the array with REDIM _PRESERVE.
'
' If MyIndex = 0 then a new chain is created,
' else the new value is added to the top of item MyIndex,
' and the new item's .nextIndex is set to point to MyIndex,
' so we have arrStack(n).nextIndex always points to the next item in that item's chain.
 
' arrStack(0) is the head of the deleted/to be reused chain.
 
Function DoPush5% (arrStack() As StackNodeType, MyIndex As Integer, sName As String, iValue As Integer)
    Dim NextIndex As Integer
    Dim NextAfterIndex As Integer
 
    NextIndex = 0
    If MyIndex > 0 Then
        ' MAKE SURE WE HAVE THE ITEM MyIndex TO DROP ON TOP OF
        If UBound(arrStack) >= MyIndex Then
            ' DROP ON TOP OF ITEM MyIndex
 
            ' ADD NEW ITEM TO TOP OF CHAIN MyIndex
            NextAfterIndex = MyIndex
 
            ' ANY EMPTY?
            If arrStack(0).NextIndex > 0 Then
                ' reuse the empty one
                NextIndex = arrStack(0).NextIndex
 
                ' move next empty to next available
                arrStack(0).NextIndex = arrStack(NextIndex).NextIndex
            Else
                ' no empty, add a node
                ReDim _Preserve arrStack(UBound(arrStack) + 1) As StackNodeType
                NextIndex = UBound(arrStack)
            End If
 
        Else
            ' (ITEM MyIndex NOT FOUND, RETURN 0 INDICATING ERROR)
        End If
    Else
        ' NOTHING TO DROP ON TOP OF, ADD TO A NEW CHAIN
        NextAfterIndex = 0 ' this is the first one, no more
 
        ' MAKE SURE WE HAVE arrStack(0) WHICH HOLDS INDEX OF NEXT EMPTY NODE
        If UBound(arrStack) < 0 Then
            ' IF NOT FOUND THEN ADD IT
            ReDim arrStack(0) As StackNodeType
            arrStack(0).NextIndex = 0 ' 0 means no empty notes to reuse
        End If
 
        ' ANY EMPTY?
        If arrStack(0).NextIndex > 0 Then
            ' reuse the empty one
            NextIndex = arrStack(0).NextIndex
 
            ' move next empty to next available
            arrStack(0).NextIndex = arrStack(NextIndex).NextIndex
        Else
            ' no empty, add a node
            ReDim _Preserve arrStack(UBound(arrStack) + 1) As StackNodeType
            NextIndex = UBound(arrStack)
        End If
 
    End If
 
    ' ADD VALUES
    If NextIndex > 0 Then
        arrStack(NextIndex).NextIndex = NextAfterIndex
        arrStack(NextIndex).name = sName
        arrStack(NextIndex).value = iValue
    End If
 
    ' RETURN RESULT (ADDED INDEX, OR 0 FOR NONE/ERROR)
    DoPush5% = NextIndex
End Function ' DoPush5%
 
' /////////////////////////////////////////////////////////////////////////////
' RECEIVES:
' arrStack = array of nodes representing multiple stacks
' MyIndex = node to retrieve
 
' RETURNS:
' NextAfterIndex = index of new top node in the chain
' (0 indicates none left, -1 indicates MyIndex not found)
' (arrStack is updated by reference)
 
Function DoPop5% (arrStack() As StackNodeType, MyIndex As Integer)
    Dim NewTop As Integer
    'Dim NextIndex As Integer
 
    NewTop = 0
    If MyIndex > 0 Then
        If UBound(arrStack) >= MyIndex Then
            ' return the new top node (0 means none left)
            NewTop = arrStack(MyIndex).NextIndex
 
            ' do we have any deleted nodes?
            If arrStack(0).NextIndex > 0 Then
                ' insert current node at the top of the "deleted" chain
                arrStack(MyIndex).NextIndex = arrStack(0).NextIndex
            End If
 
            ' soft delete
            arrStack(0).NextIndex = MyIndex
        Else
            NewTop = -1
        End If
    Else
        NewTop = -1
    End If
 
    'print "removed " + cstr$(MyIndex) + ", returned " + cstr$(NewTop)
    DoPop5% = NewTop
End Function ' DoPop5%
 
' /////////////////////////////////////////////////////////////////////////////
' RECEIVES:
' arrStack = array of nodes representing multiple stacks
' MyIndex = first node in chain
'
' RETURNS:
' NextAfterIndex = index of new top node in the chain
' (0 indicates none left, -1 indicates MyIndex not found)
' (arrStack is updated by reference)
 
Function DumpStack5$ (arrStack() As StackNodeType, MyIndex1 As Integer, sHeadingText As String)
    Dim sResult As String
    Dim MyIndex As Integer
    Dim sNext As String
    Dim sLine As String
    Dim iPrintCount As Integer
    Dim bContinue As Integer
 
    sResult = ""
    MyIndex = MyIndex1 ' prevents any updates of parameter
    bContinue = TRUE
 
    sLine = sHeadingText
    iPrintCount = 0
    Do While bContinue
        If UBound(arrStack) >= MyIndex Then
            ' WRAP OUTPUT TO 80 COLUMNS
            If Len(sLine) > 64 Then
                sResult = sResult + IIFSTR$(Len(sResult) = 0, "", Chr$(10)) + "    " + sLine
                sLine = ""
                iPrintCount = 0
            End If
 
            sLine = sLine + IIFSTR$(iPrintCount = 0, "", ", ")
            sLine = sLine + cstr$(MyIndex) + "=" + arrStack(MyIndex).name + ">"
            sLine = sLine + cstr$(arrStack(MyIndex).NextIndex)
 
            iPrintCount = iPrintCount + 1
            MyIndex = arrStack(MyIndex).NextIndex
 
            ' QUIT WHEN WE REACH NextIndex = 0
            If MyIndex < 1 Then
                bContinue = FALSE
            End If
        Else
            Exit Do
        End If
    Loop
    sResult = sResult + IIFSTR$(Len(sResult) = 0, "", Chr$(10)) + "    " + sLine
 
    DumpStack5$ = sResult
End Function ' DumpStack5$
 
' /////////////////////////////////////////////////////////////////////////////
' RECEIVES:
' arrStack = array of nodes representing multiple stacks
' MyIndex = first node in chain
'
' RETURNS:
' NextAfterIndex = index of new top node in the chain
' (0 indicates none left, -1 indicates MyIndex not found)
' (arrStack is updated by reference)
 
Function DumpStack5b$ (arrStack() As StackNodeType, MyIndex1 As Integer)
    Dim sResult As String
    Dim MyIndex As Integer
    Dim sNext As String
 
    sResult = ""
    MyIndex = MyIndex1 ' prevents any updates of parameter
 
    Do While MyIndex > 0
        If UBound(arrStack) >= MyIndex Then
            sNext = ""
            sNext = sNext + cstr$(MyIndex) + "("
            sNext = sNext + "name=" + Chr$(34) + arrStack(MyIndex).name + Chr$(34)
            sNext = sNext + ", "
            sNext = sNext + "value=" + cstr$(arrStack(MyIndex).value)
            sNext = sNext + ", "
            sNext = sNext + "nextIndex=" + cstr$(arrStack(MyIndex).NextIndex)
            sNext = sNext + ")"
 
            sResult = sResult + IIFSTR$(Len(sResult) = 0, "", Chr$(10))
            sResult = sResult + "    " + sNext
 
            MyIndex = arrStack(MyIndex).NextIndex
        Else
            Exit Do
        End If
    Loop
 
    DumpStack5b$ = sResult
End Function ' DumpStack5b$
 
' /////////////////////////////////////////////////////////////////////////////
' Convert a value to string and trim it (because normal Str$ adds spaces)
 
Function cstr$ (myValue)
    'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
    cstr$ = _Trim$(Str$(myValue))
End Function ' cstr$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IIF (Condition, IfTrue, IfFalse)
    If Condition Then IIF = IfTrue Else IIF = IfFalse
End Function
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IIFSTR$ (Condition, IfTrue$, IfFalse$)
    If Condition Then IIFSTR$ = IfTrue$ Else IIFSTR$ = IfFalse$
End Function
 
' /////////////////////////////////////////////////////////////////////////////
' Generate random value between Min and Max.
Function RandomNumber% (Min%, Max%)
    Dim NumSpread%
 
    ' SET RANDOM SEED
    'Randomize ' Initialize random-number generator.
    Randomize Timer
 
    ' GET RANDOM # Min%-Max%
    'RandomNumber = Int((Max * Rnd) + Min) ' generate number
 
    NumSpread% = (Max% - Min%) + 1
 
    RandomNumber% = Int(Rnd * NumSpread%) + Min% ' GET RANDOM # BETWEEN Max% AND Min%
 
End Function ' RandomNumber%
 
' /////////////////////////////////////////////////////////////////////////////
' FROM: String Manipulation
' http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index_topic_5964-0/
'
'SUMMARY:
'   Purpose:  A library of custom functions that transform strings.
'   Author:   Dustinian Camburides (dustinian@gmail.com)
'   Platform: QB64 (www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there])
'   Revision: 1.6
'   Updated:  5/28/2012
 
'SUMMARY:
'[Replace$] replaces all instances of the [Find] sub-string with the [Add] sub-string within the [Text] string.
'INPUT:
'Text: The input string; the text that's being manipulated.
'Find: The specified sub-string; the string sought within the [Text] string.
'Add: The sub-string that's being added to the [Text] string.
 
Function Replace$ (Text1 As String, Find1 As String, Add1 As String)
    ' VARIABLES:
    Dim Text2 As String
    Dim Find2 As String
    Dim Add2 As String
    Dim lngLocation As Long ' The address of the [Find] substring within the [Text] string.
    Dim strBefore As String ' The characters before the string to be replaced.
    Dim strAfter As String ' The characters after the string to be replaced.
 
    ' INITIALIZE:
    ' MAKE COPIESSO THE ORIGINAL IS NOT MODIFIED (LIKE ByVal IN VBA)
    Text2 = Text1
    Find2 = Find1
    Add2 = Add1
 
    lngLocation = InStr(1, Text2, Find2)
 
    ' PROCESSING:
    ' While [Find2] appears in [Text2]...
    While lngLocation
        ' Extract all Text2 before the [Find2] substring:
        strBefore = Left$(Text2, lngLocation - 1)
 
        ' Extract all text after the [Find2] substring:
        strAfter = Right$(Text2, ((Len(Text2) - (lngLocation + Len(Find2) - 1))))
 
        ' Return the substring:
        Text2 = strBefore + Add2 + strAfter
 
        ' Locate the next instance of [Find2]:
        lngLocation = InStr(1, Text2, Find2)
 
        ' Next instance of [Find2]...
    Wend
 
    ' OUTPUT:
    Replace$ = Text2
End Function ' Replace$
 

News:

Author Topic: good way to implement an array of stacks/linked lists (for 2D tile-based game)? (Read 5147 times)