Hi,
this topic has been covered several times here I guess (even once by myself), but however, I just wrote a new code (way easier than my first one... not using pointers and stuff, since you do not actually need it), which is relatively fast (~1-2 times slower than dbp-native arrays) and provides the possibility to use primitive ID-based arrays (currently just for integer and float-values).
The principle is quite simple: Since it just works with one-dimensional static arrays (no changes in size allowed), they are simply stored in one dynamic DBP-array. That means, if you create a new "AID-Array" (aid for "ID-based Arrays"... 'ida' or 'idba' just sounded strange), a fixed amount of elements is being added to the DBP-internal array.
set display mode 800,600,32
set window on
set text font "Arial"
set text size 14
print "Initializing ID-based Array-functions..."
print
aid_init()
rem Int-Array
print "- Int-Array -"
myArray = aid_int(10)
rem Write some random values
aid_set(myArray,0,0)
for i = 1 to 10
aid_set(myArray,i,aid_get(myArray,i-1)+i)
next i
rem Read and Print
for i = 0 to 10
print i, ". ", aid_get(myArray,i)
next i
print "Press a key to continue..."
wait key
print
rem Float-Array
print "- Float-Array -"
myFloats = aid_float(5)
aid_setf(myFloats,0,1.0)
for i = 1 to 5
aid_setf(myFloats,i,aid_getF(myFloats,i-1)*3.1415926)
next i
for i = 0 to 5
print i, ". ", aid_getF(myFloats,i)
next i
print "Press a key to continue..."
wait key
print
rem Speed-Test
print
print "Speedtest incoming (might take a few seconds...)" : sync
print
print "1. Integer"
size = 10000000
rem DBP
dim MyInts(size)
t = timer()
for i = 0 to size
MyInts(i) = 1
tmp = MyInts(i)
next i
t1 = timer()-t
print "DBP-Time: ", t1
rem AID
MyInts2 = aid_int(size)
t = timer()
for i = 0 to size
aid_set(MyInts2,i,1)
tmp = aid_get(MyInts2,i)
next i
t2 = timer()-t
print "AID-Time: ", t2
print "AID slows by factor: ", str$(t2/(1.0*t1),3)
print "Press a key to continue..."
wait key
print
print "2. Float"
size = 10000000
rem DBP
dim MyFlts(size) as float
t = timer()
for i = 0 to size
MyFlts(i) = 1.0
tmp = MyFlts(i)
next i
t1 = timer()-t
print "DBP-Time: ", t1
rem AID
MyFlts2 = aid_float(size)
t = timer()
for i = 0 to size
aid_setF(MyFlts2,i,1.0)
tmp = aid_getF(MyFlts2,i)
next i
t2 = timer()-t
print "AID-Time: ", t2
print "AID slows by factor: ", str$(t2/(1.0*t1),3)
print "Press a key to end..."
wait key
end
function aid_init()
global aid_ArraySize as integer = 0
dim aid_Array(0) as integer
global aid_fArraySize as integer = 0
dim aid_fArray(0) as float
endfunction
function aid_int(size)
ID = aid_ArraySize+2
inc aid_ArraySize, size+2
array insert at bottom aid_Array(), size+2
aid_Array(ID-1) = size
endfunction ID
function aid_float(size)
ID = aid_fArraySize+2
inc aid_fArraySize, size+2
array insert at bottom aid_fArray(), size+2
aid_fArray(ID-1) = size
endfunction ID
function aid_set(ID,pos,value)
rem /AID_DEBUG\
if pos > aid_Array(ID-1) or pos < 0 then aid_SizeError(ID,pos,aid_Array(ID-1))
rem \AID_DEBUG/
aid_Array(ID+pos) = value
endfunction
function aid_get(ID,pos)
rem /AID_DEBUG\
if pos > aid_Array(ID-1) or pos < 0 then aid_SizeError(ID,pos,aid_Array(ID-1))
rem \AID_DEBUG/
v = aid_Array(ID+pos)
endfunction v
function aid_setf(ID,pos,value#)
rem /AID_DEBUG\
if pos > aid_fArray(ID-1) or pos < 0 then aid_SizeError(ID,pos,aid_fArray(ID-1))
rem \AID_DEBUG/
aid_fArray(ID+pos) = value#
endfunction
function aid_getf(ID,pos)
rem /AID_DEBUG\
if pos > aid_fArray(ID-1) or pos < 0 then aid_SizeError(ID,pos,aid_fArray(ID-1))
rem \AID_DEBUG/
v# = aid_fArray(ID+pos)
endfunction v#
function aid_getsize(ID)
size = aid_Array(ID-1)
endfunction size
function aid_getSizeF(ID)
size = aid_Array(ID-1)
endfunction size
function aid_error(s$)
exit prompt s$, "aid_Error"
end
endfunction
function aid_SizeError(ID,pos,size)
aid_error("aid-Error: Array index out of bounds (pos " + str$(pos) +" in array <"+str$(ID)+"> illegal - range 1-"+str$(aid_Array(ID))+" allowed)")
endfunction
Just comment out the Debugging-lines in the 4 set/get-functions to speed it up (but possibly create strange errors, so better just remove these lines when you are absolutely sure that there are no bugs).
Wellll... I'm not that sure if somebody is going to use it anyway. If someone does however, use/modify/whatever the code as you want (I hate restrictions
). That's all I guess - have fun.
