Sorry your browser is not supported!

remstart
    Simulates the following typed array:

        type x
            name() as string
        endtype
        dim array() as x

remend

make lookup 1

for i = 0 to 5
    for j = 0 to 3
        SetName(i, j, generate string$(10) )
    next
next

` Scan through the lookup, in ascii sequence (which is the right order due to the way te key is built).
first lookup 1
while lookup is valid(1)
    split string  lookup current key$(1), "/"
    if get split word$(2) = "Name"
        i = val( get split word$(1) )
        j = val( get split word$(3) )
        print i, " - ", j, " - ", lookup current value$(1)
    endif
    next lookup 1
endwhile

wait key
end

function SetName(i as integer, j as integer, name as string)
    local Key as string
    Key = padleft$(str$(i), "0", 5) + "/Name/" + padleft$(str$(j), "0", 5)
    set lookup 1, Key, name
endfunction

Type MyType
 ` lots of variables
 Dim SomeArray1(100) `This doesn't work 
 Dim SomeArray2(100)
EndType

Dim TypeArray(100) As MyType

TypeArray(20).SomeArray2(100) = whatever

Type MyType
 ` lots of variables
EndType

Dim TypeArray(100) As MyType
Dim TypeArrayArrays(100, 2, 100)

TypeArrayArrays(20, 2, 100) = whatever
`20 is the TypeArray relation
`2 is the number of the array (SomeArray2 in the above example) 
`100 is the dimension of the array 

remstart
	Create an array with the following structure: {{L}FS}LS

	a[0][0][0] = integer
	a[0][1] = float
	a[0][2] = string
	a[1] = integer
	a[2] = string

remend

ID = Make_Typed_Array("{{L}FS}LS")

write_array(array(array(ID,0),0),0,10)	// a[0][0][0] = 10
write_array#(array(ID,0),1,123.456)		// a[0][1] = 123.456
write_array$(array(ID,0),2,"hello")		// a[0][2] = "hello"
write_array(ID,1,15)					// a[1] = 15
write_array$(ID,2,"world")				// a[2] = "world"


//Data from the root array
print memory size(ID)
for i=0 to memory size(ID)-1
	print i ," - " , peek byte(ID + i )
next i

print ""


//Printing all data
print array(array(array(id,0),0),0)
print array#(array(id,0),1)
print array$(array(id,0),2)
print array(id,1)
print array$(id,2)

print ""
print array$(array(id,0),2) , " " , array$(id,2)


wait key
end




Function Write_Array(ID as integer , Position as integer , Value as integer )
//Only integers
	Local nRet as integer
//Check if within bounds
	if ID + memory size(ID)> ID + 5* Position
//Check if same data type		
		if peek string(ID + 5* Position, 1 ) = "L"
			poke integer ID + 5* Position + 1, Value
			nRet = Value
		else
			nRet = -2
		endif
	else
		nRet = -1
	endif
	
endfunction nRet

Function Write_Array$( ID as integer , Position as integer , Value as string )
//Only strings
	Local nRet as integer
//Check if within bounds	
	if ID + memory size(ID)> ID + 5* Position
//Check if same data type	
		if peek string(ID + 5* Position, 1 ) = "S"
			free ID + 5* Position
			poke integer ID + 5* Position + 1,alloc string(Value)
		else
			nRet = -2
		endif
	else
		nRet = -1
	endif

endfunction
Function Write_Array#( ID as integer , Position as integer , Value as float )
//Only float
	Local nRet as integer
//Check if within bounds	
	if ID + memory size(ID)> ID + 5* Position
//Check if same data type		
		if peek string(ID + 5* Position, 1 ) = "F"
			poke float ID + 5* Position + 1,Value
		else
			nRet = -2
		endif
	else
		nRet = -1
	endif

endfunction

Function Write_Array_Dword(ID as integer , Position as integer , Value as Dword )
//Only dword
	Local nRet as integer
//Check if within bounds
	if ID + memory size(ID)> ID + 5* Position
//Check if same data type		
		if peek string(ID + 5* Position, 1 ) = "D"
			poke dword ID + 5* Position + 1, Value
			nRet = Value
		else
			nRet = -2
		endif
	else
		nRet = -1
	endif

endfunction

Function Write_Array_Boolean(ID as integer , Position as integer , Value as Boolean )
//Only boolean
	Local nRet as integer
//Check if within bounds
	if ID + memory size(ID)> ID + 5* Position
//Check if same data type		
		if peek string(ID + 5* Position, 1 ) = "B"
			if Value >0 then Value = 1
			poke byte ID + 5* Position + 1, Value
			nRet = Value
		else
			nRet = -2
		endif
	else
		nRet = -1
	endif

endfunction

Function Write_Array_Word(ID as integer , Position as integer , Value as Word )
//Only word
	Local nRet as integer
//Check if within bounds
	if ID + memory size(ID)> ID + 5* Position
//Check if same data type		
		if peek string(ID + 5* Position, 1 ) = "W"
			poke word ID + 5* Position + 1, Value
			nRet = Value
		else
			nRet = -2
		endif
	else
		nRet = -1
	endif

endfunction

Function Write_Array_DInteger(ID as integer , Position as integer , Value as Double Integer )
//Only double integers
	Local nRet as integer
//Check if within bounds
	if ID + memory size(ID)> ID + 5* Position
//Check if same data type		
		if peek string(ID + 5* Position, 1 ) = "R"
			poke double integer ID + 5* Position + 1, Value
			nRet = Value
		else
			nRet = -2
		endif
	else
		nRet = -1
	endif

endfunction

Function Write_Array_DFloat(ID as integer , Position as integer , Value as Double Float )
//Only double float
	Local nRet as integer
//Check if within bounds
	if ID + memory size(ID)> ID + 5* Position
//Check if same data type		
		if peek string(ID + 5* Position, 1 ) = "O"
			poke double float ID + 5* Position + 1, Value
			nRet = Value
		else
			nRet = -2
		endif
	else
		nRet = -1
	endif

endfunction

Function Write_Array_Byte(ID as integer , Position as integer , Value as Byte )
//Only byte
	Local nRet as integer
//Check if within bounds
	if ID + memory size(ID)> ID + 5* Position
//Check if same data type		
		if peek string(ID + 5* Position, 1 ) = "Y"
			poke byte ID + 5* Position + 1, Value
			nRet = Value
		else
			nRet = -2
		endif
	else
		nRet = -1
	endif

endfunction


Function Make_Typed_Array( cType as string )

//Quickly create an array providing the structure you desire
//Check the GET TYPE PATTERN$() function from DBPro to now valid characters
//Also, "{"  starts an array and "}" ends an array

	Local cPattern as string
	Local ID as integer
	//Support for TYPE
	cPattern = get type pattern$(cType,0)
	ID = alloc(0)
	if cPattern <> ""
		Array_Add(ID,cPattern)
	else
	ID=	Array_Add(ID,cType)
	endif
	
endfunction ID

Function Array_Add( ID as integer , cType as string )

//Adds a new "record" to the array. Arrays support any data type including other arrays from this functions

	Local nTempBank as integer
	Local nTempID,nTempID2 as integer
	Local index as integer
	Local cChar as string
	Local i,j as integer
	
	index = 0
		
	for i=1 to len(cType)
		//Get data type
		cChar = mid$(cType,i)
		
		if cChar = "}"
			dec index,1
		else
			nTempID = ID
			
			//Find in which array im currently at
			for j=0 to index - 1
				nTempID2 = nTempID + memory size(nTempID) - 5
				nTempID = peek integer( nTempID2+1 )
			next j
			
			//Resize memory
			if memory size(nTempID) > 1
				nTempID = realloc(nTempID , memory size(nTempID) + 5)
			else
				free nTempID
				nTempID = alloc(5)
			endif
			
			//Save new child memory address in father memory
			if index = 0 
				ID = nTempID
			else
				poke integer nTempID2+1,nTempID
			endif
						
			if cChar = "{"
				//Save child memory type and reserve a memory address
				inc index,1
				poke string nTempID + memory size(nTempID) - 5,"A",1
				poke integer nTempID + memory size(nTempID) - 4,alloc(0)
			else
				//Save data type and allocates memory
				nTempID = nTempID + memory size(nTempID) - 5
				poke string nTempID,cChar,1
				if find first char$("LFD",cChar)>0
					poke integer nTempID+1, alloc(4)
				else
					if find first char$("S",cChar)>0
						poke integer nTempID+1, alloc(4)
					else
						if find first char$("BY",cChar)>0
							poke integer nTempID+1, alloc(1)
						else
							if find first char$("W",cChar)>0
								poke integer nTempID+1, alloc(2)
							else
								if find first char$("OR",cChar)>0
									poke integer nTempID+1, alloc(8)
								endif
							endif
						endif
					endif
				endif
	
			endif
		endif
	
	next i
	
endfunction ID

Function Array( ID as integer , Position as integer )
//Only integer and array
	Local nRet as integer
//Check if within bounds
	if ID + memory size(ID)> ID + 5* Position
//Check if same data type
		if find first char$("LA",peek string(ID + 5* Position, 1 ))>0
			nRet = peek integer(ID + 5* Position + 1)
		else
			nRet = -2
		endif
	else
		nRet = -1
	endif

endfunction nRet

Function Array#( ID as integer , Position as integer )
//Only float
	Local nRet as float
//Check if within bounds
	if ID + memory size(ID)> ID + 5* Position
//Check if same data type
		if peek string(ID + 5* Position, 1 ) = "F"
			nRet = peek float(ID + 5* Position + 1)
		else
			nRet = -2
		endif
	else
		nRet = -1
	endif

endfunction nRet

Function Array$( ID as integer , Position as integer )
//Only string
	Local cRet as string
//Check if within bounds
	if ID + memory size(ID)> ID + 5* Position
//Check if same data type
		if peek string(ID + 5* Position, 1 ) = "S"
			cRet = peek string(peek integer(ID + 5* Position + 1))
		else
			cRet = "incorrect datatype"
		endif
	else
		cRet = "out of range"
	endif

endfunction cRet

Function Array_Boolean(ID as integer , Position as boolean )
//Only boolean
	Local nRet as boolean
//Check if within bounds
	if ID + memory size(ID)> ID + 5* Position
//Check if same data type
		if peek string(ID + 5* Position, 1 ) = "B"
			nRet = peek byte(ID + 5* Position + 1)
			if nRet>0 then nRet = 1
		else
			nRet = -2
		endif
	else
		nRet = -1
	endif

endfunction nRet

Function Array_Dword(ID as integer , Position as dword )
//Only dword
	Local nRet as Dword
//Check if within bounds
	if ID + memory size(ID)> ID + 5* Position
//Check if same data type
		if peek string(ID + 5* Position, 1 ) = "D"
			nRet = peek dword(ID + 5* Position + 1)
		else
			nRet = -2
		endif
	else
		nRet = -1
	endif

endfunction nRet

Function Array_Word(ID as integer , Position as word )
//Only word
	Local nRet as word
//Check if within bounds
	if ID + memory size(ID)> ID + 5* Position
//Check if same data type
		if peek string(ID + 5* Position, 1 ) = "W"
			nRet = peek word(ID + 5* Position + 1)
		else
			nRet = -2
		endif
	else
		nRet = -1
	endif

endfunction nRet

Function Array_DInteger(ID as integer , Position as double integer )
//Only double integer
	Local nRet as double integer
//Check if within bounds
	if ID + memory size(ID)> ID + 5* Position
//Check if same data type
		if peek string(ID + 5* Position, 1 ) = "R"
			nRet = peek double integer(ID + 5* Position + 1)
		else
			nRet = -2
		endif
	else
		nRet = -1
	endif

endfunction nRet

Function Array_DFloat(ID as integer , Position as double float )
//Only double float
	Local nRet as double float
//Check if within bounds
	if ID + memory size(ID)> ID + 5* Position
//Check if same data type
		if peek string(ID + 5* Position, 1 ) = "O"
			nRet = peek double float(ID + 5* Position + 1)
		else
			nRet = -2
		endif
	else
		nRet = -1
	endif

endfunction nRet

Function Array_Byte(ID as integer , Position as byte )
//Only byte
	Local nRet as Byte
//Check if within bounds
	if ID + memory size(ID)> ID + 5* Position
//Check if same data type
		if peek string(ID + 5* Position, 1 ) = "Y"
			nRet = peek byte(ID + 5* Position + 1)
		else
			nRet = -2
		endif
	else
		nRet = -1
	endif

endfunction nRet