Rem Project: mem_to_array_stucture1
Rem Created: Wednesday, January 18, 2023
Rem ***** Main Source File *****
sync on : sync rate 30 : sync 

#constant MAX_STRING 256 
type struct
	b as byte
	f as float
	s as string
endtype

recnuminfile = 2 ` -  number of records in file to read in
dim ary(recnuminfile-1) as struct

for i =0 to recnuminfile-1 : for l = 0 to MAX_STRING -1 : ary(i).s = ary(i).s + "@" : next l : next i

pary = get arrayptr(ary())
`pMEM=MakeMemoryFromFile("byte_data1.dat")
pMEM=MakeMemoryFromFile("byte_data2.dat")
`pMEM=MakeMemoryFromFile("struct2.dat")

print "pMEM: ";pMEM; " size: ";memory size(pMEM)

remstart
if file exist("memdump.txt")=1 then delete file "memdump.txt"
open to write 1,"memdump.txt"
	for adr = pMEM to pMEM + memory size(pMEM) - 1
		byt = peek byte(adr)
		write string 1,str$(adr)+" -> "+str$(byt)
	next adr
close file 1
remend

MakeArrayFromMemory(pary,pMEM)

for i = 0 to 1
print ary(i).b; " , ";ary(i).f;" , ";ary(i).s
next i

sync
wait key
SAFE_DELETE(pMEM)
undim ary()
message "finished correctly."
end

function SAFE_DELETE(ptr as DWORD )
	free ptr
	ptr = 0
endfunction

function MakeArrayFromMemory(arrayptr as dword ,memoryptr as dword )
	itemnum=0
	p=0
	pStart = memoryptr
	for index=0 to get arrayptr count(arrayptr)
		for item = 1 to get arrayptr field count (arrayptr)   
			inc itemnum
			aryityp$=FindStructItemType(arrayptr ,index, item)
			aryiptr = FindStructItem(arrayptr ,index, item)
			if aryityp$="Byte"
				poke byte aryiptr,peek byte(pStart)
				inc pStart 
			endif
	
			if aryityp$="Word" 
				poke word aryiptr,peek word(pStart)
				inc pStart,2
			endif
	
			if aryityp$="Integer" 
				poke integer aryiptr,peek integer(pStart)
				inc pStart,4
			endif
			
			if aryityp$="Float" 
				poke float aryiptr,peek float(pStart)
				inc pStart,4
			endif
			
			if aryityp$="Dword"
				poke dword aryiptr,peek dword(pStart)
				inc pStart,4
			endif
			
			if aryityp$="String"
				oldpStart=pStart
				pSlen = MemStrLen(pStart , 0 )
				inc pStart, pSlen + 1 
				poke string *aryiptr,peek string(oldpStart)
			endif
	
			if aryityp$="Double float" 
				poke double float aryiptr,peek double float(pStart)
				inc pStart, 8
			endif
	
			if aryityp$="Double integer" 
				poke double integer aryiptr,peek double integer(pStart)
				inc pStart, 8
			endif
	
		next item 
	next index
endfunction

function MakeMemoryFromFile(src$)
	fsz = file size(src$)
	mptr = alloc(fsz)
	fid = reserve free file()
	adr as dword
	byt as byte
	open to read fid,src$
		for adr = mptr to mptr + fsz - 1
			read byte fid,byt
			poke byte adr,byt
		next adr
	close file fid
	release reserved file fid
	msz = memory size(mptr)

	crlf = MemCountCRLF(mptr,msz)
	
	rm = crlf mod 2
	`print "rm: ";rm
	
	if rm > 0 
		cr = MemCountCR(mptr,msz)
		lf = MemCountLF(mptr,msz)
	endif
	
	`print "crlf: ";crlf; " cr: ";cr;" lf: ";lf

	if crlf > 0
		newmemsz = msz - crlf 
	endif
	
	byt as byte
	nbyt as byte
	newmptr = alloc(newmemsz)
	
	nptr as DWORD 
	nptr = newmptr
	
	mstart = mptr
	mend = mptr + msz - 1 
	
	for adr = mptr to mptr + msz - 1
		byt = peek byte (adr) 
		bpos = adr - mptr
		nbpos = nptr - newmptr
		if byt = 13
			lastbyt = byt
			poke byte nptr,0
			inc adr
		else 
			if byt = 10 and lastbyt = 13
				inc adr 
			else
				lastbyt =  0
				poke byte nptr,byt			
			endif
		endif
		nbyt = peek byte(nptr)
		inc nptr
	next adr

	for adr = newmptr to newmptr + newmemsz - 1
		byt = peek byte(adr)
		bpos = adr - newmptr
	next adr
	
	SAFE_DELETE(mptr)

endfunction newmptr

function MemCountCRLF(ptr,psz)
	byt as byte
	cr = 0 : lf = 0
	for adr = ptr to ptr + psz -1
		byt = peek byte(adr)
		if byt = 13
			inc cr
		endif
		
		if byt = 10
			inc lf
		endif
	next adr
	
	if cr = lf 
		cnt = cr
	else
		cnt = cr+lf
	endif
endfunction cnt

function MemCountCR(ptr,psz)
	byt as byte
	cr = 0 
	for adr = ptr to ptr + psz -1
		byt = peek byte(adr)
		if byt = 13
			inc cr
		endif
	next adr
	cnt = cr
endfunction cnt

function MemCountLF(ptr,psz)
	byt as byte
	lf = 0 
	for adr = ptr to ptr + psz -1
		byt = peek byte(adr)
		if byt = 10
			inc lf
		endif
	next adr
	cnt = lf
endfunction cnt

function MemStrLen(ptr as DWORD , marker as BYTE )
      if ptr =0 then exitfunction 0
      pStrLen as integer
      pStrLen = -1
      byt as byte
      byt = peek byte(ptr)
      p = -1
      while byt <> marker
            inc pStrLen
            inc p
            byt = peek byte(ptr+p)
      endwhile
endfunction pStrLen

function GetFieldType$(fmt$,field)
// vtype : 4=byte, 6=dword, 1=float, 2=string, no value type=0
//  i as integer         // L
//  f as float           // F
//  raw_name as string   // S  
//  isdup as boolean     // B
//  b as byte            // Y
//  w as word            // W
//  dw as dword          // D
//  df as double float   // O
//  di as double integer // R
      ft$=mid$(fmt$,field)          
      select ft$

      case "L"
            ret$="Integer"
      endcase
      case "F"
            ret$="Float"
      endcase
      case "S"
            ret$="String"
      endcase
      case "B"
            ret$="Boolean"
      endcase
      case "Y"
            ret$="Byte"
      endcase
      case "W"
            ret$="Word"
      endcase
      case "D"
            ret$="Dword"
      endcase
      case "O"
            ret$="Double float"
      endcase
      case "R"
            ret$="Double integer"
      endcase
      endselect

endfunction ret$

`notes : will only work if no other link array used to same ptr
function FindStructItem(ptr as DWORD ,index, item)
      found = 0
      ac = get arrayptr count(ptr)
      write string 1,"ptr: "+str$(ptr)
      avalfc = get arrayptr field count(ptr)
      for i = 0 to ac
        for ii = 1 to avalfc
            if i = index and ii = item
                off=get arrayptr field offset(ptr,ii)
                rptr = get arrayptr item ptr(ptr,i)+off 
                found = 1
                exit
            endif  
        next ii
        if found = 1 then exit
      next i
endfunction rptr

`notes : will only work if no other link array used to same ptr
function FindStructItemType(ptr as DWORD ,index, item)
      found = 0
      ac = get arrayptr count(ptr)
      avalfc = get arrayptr field count(ptr)
      fmt$ = get arrayptr format(ptr)
      for i = 0 to ac
            for ii = 1 to avalfc
              ftyp = get arrayptr field type(ptr,ii)
            if i = index and ii = item
                  ftyp$ = GetFieldType$(fmt$,ii)
                  found = 1
                  exit
            endif  
        next ii
        if found = 1 then exit
      next i
endfunction ftyp$