Sorry your browser is not supported!

` create a 11x11 array
dim myArray(10, 10)

` Fill the array with random numbers
for x=0 to 10
    for y=0 to 10
        myArray(x, y) = rnd(255)
    next y
next x

` Resize the array
dim myArray(12, 12)

type MyArrayT
   x as integer
   y as integer
endtype

dim MyArray( 9 , 9 ) as MyArrayT

rem Size of array: (9+1) * (9+1) * (4+4) = 800 bytes

// simple array:
id = newArray()
for i=0 to 10
    pushArray( id, rnd(100) )
next i

// multidimensional array:
id = newArray()
for i=0 to 10
    pushArray( id, newArray() )
next i

// Fill with data
for i=0 to 10
    array = getArray( id, i )
    resizeArray( array, 100 )
    for j=0 to 100
        setArray( array, j, rnd(100) )
    next j
next i

// get the data
for i=0 to 10
    array = getArray( id, i )
    for j=0 to 100
        value = getArray( array, j )
    next j
next i

// for strings/floats/dwords you can use: setArray#, setArray$ and setArrayDword
// or: pushArray#, pushArray$, pushArrayDword

Core_Init_Array()

dim myArray(100)
id = newArray()
resizeArray(id, 100)

count = 100000

defaultArray = timer()
    for i=1 to count
        for j=0 to 100
            myArray(j) = rnd(100)
        next j
    next i
defaultArray = timer() - defaultArray

customArray = timer()
    for i=1 to count
        for j=0 to 100
            setArray(id, j, rnd(100))
        next j
    next i
customArray = timer() - customArray


print "Default array: ", defaultArray, " ms"
print "Custom array: ", customArray, " ms"

wait key

end

array = newArray()
    typeArray = newArray() : resizeArray(typeArray, 3)
    setArray(typeArray,      0, 1)
    setArray$(typeArray,     1, "test")
    setArray#(typeArray,     2, 3.5)
    setArrayDword(typeArray, 3, 10)
pushArray(array, typeArray)

Core_Init_Array()

size  = 100
count = 100000

dimDefaultArray = timer()
dim myArray(size)
dimDefaultArray = timer() - dimDefaultArray

print "Create default array: ", dimDefaultArray, " ms "

dimCustomArray = timer()
id = newArray()
resizeArray(id, size)
dimCustomArray = timer() - dimCustomArray

print "Create custom array: ", dimCustomArray, " ms"

defaultArray = timer()
    for i=1 to count
        for j=0 to size
            myArray(j) = j
        next j
    next i
defaultArray = timer() - defaultArray

print "Default array:            ", defaultArray, "       (", (defaultArray+0.0) / ((size+0.0) * (count+0.0)), "/item)"

customArray = timer()
    for i=1 to count
        for j=0 to size
            setArray(id, j, j)
        next j
    next i
customArray = timer() - customArray

print "Custom array:             ", customArray, "      (", (customArray+0.0) / ((size+0.0) * (count+0.0)), "/item)"

safeCustomArray = timer()
    for i=1 to count
        for j=0 to size
            safeSetArray(id, j, j)
        next j
    next i
safeCustomArray = timer() - safeCustomArray

print "Safe Custom array:        ", SafecustomArray, "     (", (SafecustomArray+0.0) / ((size+0.0) * (count+0.0)), "/item)"

defaultArrayGet = timer()
    for i=1 to count
        for j=0 to size
            value = myArray(j)
        next j
    next i
defaultArrayGet = timer() - defaultArrayGet

print "Default array (get):      ", defaultArrayGet, "       (", (defaultArrayGet+0.0) / ((size+0.0) * (count+0.0)), "/item)"

customArrayGet = timer()
    for i=1 to count
        for j=0 to size
            value = getArray(id, j)
        next j
    next i
customArrayGet = timer() - customArrayGet

print "Custom array (get):       ", customArrayGet, "      (", (customArrayGet+0.0) / ((size+0.0) * (count+0.0)), "/item)"

safeCustomArrayGet = timer()
    for i=1 to count
        for j=0 to size
            value = safeGetArray(id, j)
        next j
    next i
safeCustomArrayGet = timer() - safeCustomArrayGet

print "Safe Custom array (get):  ", SafecustomArrayGet, "     (", (SafecustomArrayGet+0.0) / ((size+0.0) * (count+0.0)), "/item)"

count = count * .1

pushDefaultArray = timer()
    for i=1 to count
        ` for j=0 to size
            array insert at bottom myArray()
            myArray() = j
        ` next j
    next i
pushDefaultArray = timer() - pushDefaultArray

print "Array insert at bottom:   ", pushDefaultArray, "      (", (pushDefaultArray+0.0) / ((count+0.0)), "/item)"

pushCustomArray = timer()
    for i=1 to count
        ` for j=0 to size
            pushArray(id, j)
        ` next j
    next i
pushCustomArray = timer() - pushCustomArray

print "Push array:               ", pushCustomArray, "       (", (pushCustomArray+0.0) / ((count+0.0)), "/item)"

deleteDefaultArray = timer()
    for i=1 to count
        array delete element myArray(), 0
    next i
deleteDefaultArray = timer() - deleteDefaultArray

print "Array Delete Element:     ", deleteDefaultArray, "      (", (deleteDefaultArray+0.0) / ((count+0.0)), "/item)"

deleteCustomArray = timer()
    for i=1 to count
        deleteArrayItem(id, 0)
    next i
deleteCustomArray = timer() - deleteCustomArray

print "Delete Array Item:        ", deleteCustomArray, "       (", (deleteCustomArray+0.0) / ((count+0.0)), "/item)"

` Delete arrays
deleteArray(id)
undim myArray()

wait key

end

Rem ------------------------------------------------------------------------------------------------------------------------
Rem  CUSTOM ARRAY SYSTEM
Rem ------------------------------------------------------------------------------------------------------------------------

Rem -----------------------------------------------------------
Rem  Array errors
Rem -----------------------------------------------------------
#Constant ARRAY_ERROR_OUTOFBOUNDS    "Array "+str$(id)+" is out of bounds at index "+str$(index)
#Constant ARRAY_ERROR_DOESNOTEXIST   "Array "+str$(id)+" does not exist"
#Constant ARRAY_ERROR_NOTASTRING     "Array value is not a STRING at index "+str$(index)+" in array "+str$(id)
#Constant ARRAY_ERROR_NOTAFLOAT      "Array value is not a FLOAT at index "+str$(index)+" in array "+str$(id)
#Constant ARRAY_ERROR_NOTANINTEGER   "Array value is not an INTEGER at index "+str$(index)+" in array "+str$(id)
#Constant ARRAY_ERROR_NOTADWORD      "Array value is not a DWORD at index "+str$(index)+" in array "+str$(id)

Rem -----------------------------------------------------------
Rem  Array type
Rem -----------------------------------------------------------
Type ArrayData
    exist      as boolean
    ptr        as dword
    count      as integer
    hasStrings as integer
endType

Function arrayError(arrayErrorMessage$)
    exit prompt arrayErrorMessage$, "Array error"
    end
endFunction

Rem -----------------------------------------------------------
Rem  Initialise the array system
Rem -----------------------------------------------------------
Function Core_Init_Array()
    
    Global Dim Arrays(-1)   as ArrayData
    Global     Arrays_Count as integer = -1
    
endFunction

Rem -----------------------------------------------------------
Rem  Returns a free array index
Rem -----------------------------------------------------------
Function FindFreeArray()
    
    index = -1
    count = array count(Arrays())
    
    for i=1 to count
        if Arrays(i).exist = 0
            index = i
            exit
        endif
    next i
    
    if index = -1
        array insert at bottom Arrays()
        index = count + 1
        if index = 0
            array insert at bottom Arrays()
            index = count + 2
        endif
        Arrays_Count = index
    endif
    
endFunction index

Rem -----------------------------------------------------------
Rem  Creates a new array
Rem -----------------------------------------------------------
Function newArray()
    index = FindFreeArray()
    Arrays(index).exist = 1
    Arrays(index).ptr   = alloc(1)
    Arrays(index).count = -1
    Arrays(index).hasStrings = 0
endFunction index

Rem -----------------------------------------------------------
Rem  Set/get an integer value
Rem -----------------------------------------------------------
Function safeSetArray(id, index, value)
    if arrayExist(id)=0 then arrayError(ARRAY_ERROR_DOESNOTEXIST) : ExitFunction
    count = Arrays(id).count
    if index < 0 then arrayError(ARRAY_ERROR_OUTOFBOUNDS) : Exitfunction
    if index > count then arrayError(ARRAY_ERROR_OUTOFBOUNDS) : Exitfunction
    setArray(id, index, value)
endFunction

Function setArray(id, index, value)
    ptr as dword : ptr = Arrays(id).ptr + index*5
    *ptr = value
    inc ptr, 4
    poke byte ptr, 1
endFunction

Function safeGetArray(id, index)
    if arrayExist(id)=0 then arrayError(ARRAY_ERROR_DOESNOTEXIST) : ExitFunction 0
    count = Arrays(id).count
    if index < 0 then arrayError(ARRAY_ERROR_OUTOFBOUNDS) : Exitfunction 0
    if index > count then arrayError(ARRAY_ERROR_OUTOFBOUNDS) : Exitfunction 0
    ptr as dword : ptr = Arrays(id).ptr + index*5
    if peek byte(ptr+4) <> 1 then arrayError(ARRAY_ERROR_NOTANINTEGER) : Exitfunction 0
    value = *ptr
endFunction value

Function getArray(id, index)
    ptr as dword : ptr = Arrays(id).ptr + index*5
    value = *ptr
endFunction value

Rem -----------------------------------------------------------
Rem  Set/get a float value
Rem -----------------------------------------------------------
Function safeSetArray#(id, index, value#)
    if arrayExist(id)=0 then arrayError(ARRAY_ERROR_DOESNOTEXIST) : ExitFunction
    count = Arrays(id).count
    if index < 0 then arrayError(ARRAY_ERROR_OUTOFBOUNDS) : Exitfunction
    if index > count then arrayError(ARRAY_ERROR_OUTOFBOUNDS) : Exitfunction
    setArray#(id, index, value#)
endFunction

Function setArray#(id, index, value#)
    ptr as dword : ptr = Arrays(id).ptr + index*5
    poke float ptr, value#
    poke byte ptr+4, 2
endFunction

Function safeGetArray#(id, index)
    if arrayExist(id)=0 then arrayError(ARRAY_ERROR_DOESNOTEXIST) : ExitFunction 0.0
    count = Arrays(id).count
    if index < 0 then arrayError(ARRAY_ERROR_OUTOFBOUNDS) : Exitfunction 0.0
    if index > count then arrayError(ARRAY_ERROR_OUTOFBOUNDS) : Exitfunction 0.0
    ptr as dword : ptr = Arrays(id).ptr + index*5
    if peek byte(ptr+4) <> 2 then arrayError(ARRAY_ERROR_NOTAFLOAT) : Exitfunction 0.0
    value# = peek float(ptr)
endFunction value#

Function getArray#(id, index)
    ptr as dword : ptr = Arrays(id).ptr + index*5
    value# = peek float(ptr)
endFunction value#

Rem -----------------------------------------------------------
Rem  Set/get a string value
Rem -----------------------------------------------------------
Function safeSetArray$(id, index, value$)
    if arrayExist(id)=0 then arrayError(ARRAY_ERROR_DOESNOTEXIST) : ExitFunction
    count = Arrays(id).count
    if index < 0 then arrayError(ARRAY_ERROR_OUTOFBOUNDS) : Exitfunction
    if index > count then arrayError(ARRAY_ERROR_OUTOFBOUNDS) : Exitfunction
    setArray$(id, index, value$)
endFunction

Function setArray$(id, index, value$)
    
    ` Free the old string
    ptr as dword : ptr = peek dword(Arrays(id).ptr + index*5)
    if ptr > 0
        free ptr
    endif
    
    ` Create the new string
    ptr = alloc string(value$)
    
    ` Store the new string
    _ptr as dword : _ptr = Arrays(id).ptr + index*5
    poke dword _ptr, ptr
    poke byte _ptr+4, 3
    
    Arrays(id).hasStrings = 1
    
endFunction

Function safeGetArray$(id, index)
    empty$ = ""
    if arrayExist(id)=0 then arrayError(ARRAY_ERROR_DOESNOTEXIST) : ExitFunction empty$
    count = Arrays(id).count
    if index < 0 then arrayError(ARRAY_ERROR_OUTOFBOUNDS) : Exitfunction empty$
    if index > count then arrayError(ARRAY_ERROR_OUTOFBOUNDS) : Exitfunction empty$
    ptr as dword : ptr = Arrays(id).ptr + index*5
    if peek byte(ptr+4) <> 3 then arrayError(ARRAY_ERROR_NOTASTRING) : Exitfunction empty$
    ptr = peek dword(ptr)
    value$ = peek string(ptr)
endFunction value$

Function getArray$(id, index)
    ptr as dword : ptr = Arrays(id).ptr + index*5
    ptr = peek dword(ptr)
    value$ = peek string(ptr)
endFunction value$

Rem -----------------------------------------------------------
Rem  Set/get a dword value
Rem -----------------------------------------------------------
Function safeSetArrayDWORD(id, index, value as dword)
    if arrayExist(id)=0 then arrayError(ARRAY_ERROR_DOESNOTEXIST) : ExitFunction
    if index < 0 then arrayError(ARRAY_ERROR_OUTOFBOUNDS) : Exitfunction
    if index > count then arrayError(ARRAY_ERROR_OUTOFBOUNDS) : Exitfunction
    setArray(id, index, value)
endFunction

Function setArrayDWORD(id, index, value as dword)
    ptr as dword : ptr = Arrays(id).ptr + index*5
    poke dword ptr, value
    poke byte ptr+4, 4
endFunction

Function safeGetArrayDWORD(id, index)
    if arrayExist(id)=0 then arrayError(ARRAY_ERROR_DOESNOTEXIST) : ExitFunction 0
    count = Arrays(id).count
    if index < 0 then arrayError(ARRAY_ERROR_OUTOFBOUNDS) : Exitfunction 0
    if index > count then arrayError(ARRAY_ERROR_OUTOFBOUNDS) : Exitfunction 0
    ptr as dword : ptr = Arrays(id).ptr + index*5
    if peek byte(ptr+4) <> 4 then arrayError(ARRAY_ERROR_NOTADWORD) : Exitfunction 0
    value as dword : value = peek dword(ptr)
endFunction value

Function getArrayDWORD(id, index)
    ptr as dword : ptr = Arrays(id).ptr + index*5
    value as dword : value = peek dword(ptr)
endFunction value

Rem -----------------------------------------------------------
Rem  Adds a new value at the and of the array
Rem -----------------------------------------------------------
Function safePushArray(id, value)
    if arrayExist(id)=0 then arrayError(ARRAY_ERROR_DOESNOTEXIST) : ExitFunction
    pushArray(id, value)
endFunction

Function pushArray(id, value)
    count = Arrays(id).count + 1
    resizeArray(id, count)
    setArray(id, count, value)
endFunction

Function safePushArray#(id, value#)
    if arrayExist(id)=0 then arrayError(ARRAY_ERROR_DOESNOTEXIST) : ExitFunction
    pushArray#(id, value#)
endFunction

Function pushArray#(id, value#)
    count = Arrays(id).count + 1
    resizeArray(id, count)
    setArray#(id, count, value#)
endFunction

Function safePushArray$(id, value$)
    if arrayExist(id)=0 then arrayError(ARRAY_ERROR_DOESNOTEXIST) : ExitFunction
    pushArray$(id, value$)
endFunction

Function pushArray$(id, value$)
    count = Arrays(id).count + 1
    resizeArray(id, count)
    setArray$(id, count, value$)
endFunction

Function safePushArrayDWORD(id, value as dword)
    if arrayExist(id)=0 then arrayError(ARRAY_ERROR_DOESNOTEXIST) : ExitFunction
    pushArrayDWORD(id, value)
endFunction

Function pushArrayDWORD(id, value as dword)
    count = Arrays(id).count + 1
    resizeArray(id, count)
    setArrayDWORD(id, count, value)
endFunction

Rem -----------------------------------------------------------
Rem  Returns the length of the array
Rem -----------------------------------------------------------
Function safeArrayCount(id)
    if arrayExist(id)=0 then arrayError(ARRAY_ERROR_DOESNOTEXIST) : ExitFunction 0
    count = Arrays(id).count
endFunction count

Function arrayCount(id)
    count = Arrays(id).count
endFunction count

Rem -----------------------------------------------------------
Rem  Deletes the array
Rem -----------------------------------------------------------
Function safeDeleteArray(id)
    if arrayExist(id)=0 then arrayError(ARRAY_ERROR_DOESNOTEXIST) : ExitFunction
    
    if Arrays(id).hasStrings
        count = Arrays(id).count
        ptr as dword : ptr = Arrays(id).ptr
        for i=0 to count
            
            ` Delete string
            if peek byte(ptr+4) = 3
                sPtr as dword
                sPtr = peek dword(ptr)
                free sPtr
            endif
            
        next i
    endif
        
    free Arrays(id).ptr
    Arrays(id).exist = 0
endFunction

Function deleteArray(id)
    if Arrays(id).hasStrings
        count = Arrays(id).count
        ptr as dword : ptr = Arrays(id).ptr
        for i=0 to count
            
            ` Delete string
            if peek byte(ptr+4) = 3
                sPtr as dword
                sPtr = peek dword(ptr)
                free sPtr
            endif
            
        next i
    endif
    free Arrays(id).ptr
    Arrays(id).exist = 0
endFunction

Rem -----------------------------------------------------------
Rem  Returns a 1 if the array exists
Rem -----------------------------------------------------------
Function arrayExist(id)
    if id < 1 then exitfunction 0
    if id > Arrays_Count then exitfunction 0
    if Arrays(id).exist = 0 then exitfunction 0
endFunction 1

Rem -----------------------------------------------------------
Rem  Resizes the array
Rem -----------------------------------------------------------
Function resizeArray(id, count)    
    
    cCount = arrayCount(id)
    
    if count <> cCount
        nPtr = alloc((count+1)*5)
        if count > cCount
            if cCount > -1
                copy memory nPtr, Arrays(id).ptr, (cCount+1)*5
            endif
            newSize = (count - cCount)*5
            fill memory nPtr + memory size(nptr)-newSize, 0, newSize
        else
            if count > -1
                copy memory nPtr, Arrays(id).ptr, (count+1)*5
            endif
        endif
        
        ` Delete strings
        if Arrays(id).hasStrings
            ptr as dword
            for i=count+1 to cCount
                
                ptr = Arrays(id).ptr + count*4
                
                if peek byte(ptr+4) = 3
                    sPtr as dword
                    sPtr = peek dword(ptr)
                    free sPtr
                endif
                
            next i
        endif
        
        free Arrays(id).ptr
        Arrays(id).ptr = nPtr
    endif
    
    Arrays(id).count = count
endFunction

Function safeResizeArray(id, count)

    if arrayExist(id)=0 then arrayError(ARRAY_ERROR_DOESNOTEXIST) : ExitFunction

    cCount = arrayCount(id)
    
    if count <> cCount
        
        nPtr = alloc((count+1)*5)
        
        if count > cCount
            if cCount > -1
                copy memory nPtr, Arrays(id).ptr, (cCount+1)*5
            endif
            newSize = (count - cCount)*5
            fill memory nPtr + memory size(nptr)-newSize, 0, newSize
        else
            if count > -1
                copy memory nPtr, Arrays(id).ptr, (count+1)*5
            endif
        endif
        
        if Arrays(id).hasStrings
            ` Delete strings
            ptr as dword
            for i=count+1 to cCount
                
                ptr = Arrays(id).ptr + count*4
                
                if peek byte(ptr+4) = 3
                    sPtr as dword
                    sPtr = peek dword(ptr)
                    free sPtr
                endif
                
            next i
        endif
        
        free Arrays(id).ptr
        
        Arrays(id).ptr = nPtr
    endif
    
    Arrays(id).count = count

endFunction

Rem -----------------------------------------------------------
Rem  Clears the array (all values will be set to 0)
Rem -----------------------------------------------------------
Function safeClearArray(id)
    if arrayExist(id)=0 then arrayError(ARRAY_ERROR_DOESNOTEXIST) : ExitFunction
    
    if Arrays(id).hasStrings
        count = Arrays(id).count
        ptr as dword : ptr = Arrays(id).ptr
        for i=0 to count
            
            ` Delete string
            if peek byte(ptr+4) = 3
                sPtr as dword
                sPtr = peek dword(ptr)
                free sPtr
            endif
            
        next i
    endif
    
    fill memory Arrays(id).ptr, 0, memory size(Arrays(id).ptr)
    
endFunction

Function clearArray(id)
    
    if Arrays(id).hasStrings
        count = Arrays(id).count
        ptr as dword : ptr = Arrays(id).ptr
        for i=0 to count
            
            ` Delete string
            if peek byte(ptr+4) = 3
                sPtr as dword
                sPtr = peek dword(ptr)
                free sPtr
            endif
            
        next i
    endif
    
    fill memory Arrays(id).ptr, 0, memory size(Arrays(id).ptr)
    
endFunction

Rem -----------------------------------------------------------
Rem  Removes an item from the array
Rem -----------------------------------------------------------
Function safeDeleteArrayItem(id, index)
    
    if arrayExist(id)=0 then arrayError(ARRAY_ERROR_DOESNOTEXIST) : ExitFunction
    count = Arrays(id).count
    if index < 0 then arrayError(ARRAY_ERROR_OUTOFBOUNDS) : Exitfunction
    if index > count then arrayError(ARRAY_ERROR_OUTOFBOUNDS) : Exitfunction
    
    deleteArrayItem(id, index)
    
endFunction


Function deleteArrayItem(id, index)
    
    count = Arrays(id).count
    
    if count > 0
    
        ptr as dword
        ptr = Arrays(id).ptr 
        
        nPtr as dword
        nPtr = alloc(memory size(ptr)-5)
        
        ` Delete string
        iPtr as dword
        iPtr = ptr + index*5
        if peek byte(iPtr+4) = 3
            sPtr as dword
            sPtr = peek dword(iPtr)
            free sPtr
        endif
        
        size1 = index*5
        if size1 > 0
            copy memory nPtr, ptr, size1
        endif
        
        size2 = memory size(ptr) - index*5 - 5
        if size2 > 0
            copy memory nPtr + size1, ptr + size1+5, size2
        endif
        
        free ptr
        
        Arrays(id).ptr   = nPtr
        Arrays(id).count = Arrays(id).count - 1
    
    else
        
        free Arrays(id).ptr
        Arrays(id).ptr = alloc(1)
        Arrays(id).count = -1
        
    endif
    
endFunction

type objectData
    limbs as integer
endType

object as objectData
object.limbs = newArray()

limb = 0
while limb exist(1, limb)

    limbData = newArray()
        pushArray#(limbData, limb offset x(1, limb))
        pushArray#(limbData, limb offset y(1, limb))
        pushArray#(limbData, limb offset z(1, limb))
    
    pushArray(object.limbs, limbData)

    inc limb
endwhile

print "Limb count: ", arrayCount(object.limbs)

dim UnitPath() as integer

dim UnitPath(1,1,1) as integer
UnitPath(1,0,0) = 10
UnitPath(1,0,1) = 11

dim UnitPath(2,1,1) as integer

print UnitPath(1,0,0)
print UnitPath(1,0,1)

wait key
end

dim UnitPath() as integer

dim UnitPath(10,1) as integer
for i=0 to 10
   UnitPath(i,1) = i 
next i

dim UnitPath(12,1) as integer

for i=0 to 10
   print UnitPath(i,1)
next i

wait key
end