Sorry your browser is not supported!

Rem Project: Return_Mesh_ColorRGB_v0.1
Rem Created: Tuesday, October 26, 2021
Rem BOTR 2021
Rem Stripped down version of DBOFastReader 0.47
Rem which converts DBO to .X/OBJ (animated and static objects)
Rem ***** Main Source File *****
sync on : sync rate 30 : sync

`constants
#constant appver "return mesh color example 0.1"
#constant BYTEMAX 							256
#constant DBOBLOCK_ROOT_FRAME 				1			// rule = Must = 101 (DBOBLOCK_FRAME_NAME) 
#constant DBOBLOCK_FRAME_NAME 				101			// Rule 1 - Names must be dwCodeSize = pBlock + 4
#constant DBOBLOCK_FRAME_MESH 				103			// Rule x - pBlock must be = 111 (DBOBLOCK_MESH_FVF)
#constant DBOBLOCK_MESH_FVF 				111			// Rule 2 - Size must be = DWORD (4)
#constant DBOBLOCK_MESH_FVFSIZE 			112			// Rule 2 - Size must be = DWORD (4)
#constant DBOBLOCK_MESH_USEMATERIAL 		125			// Rule 5 - Size must be = 0 or 1 (boolean flag =1 Yes 0 =No)
#constant DBOBLOCK_MESH_MATERIAL 			126			// Rule 6 - Size must be = 68 e.g. 4x4float + 1 float
` END CONSTANTS

// DBO structure related types
type frametype
	id as integer // frame id - parent ID
	ismesh as boolean
endtype

// for mesh, actual data will be stored in separate arrays for multiple values 
// but mesh id will be stored as a linking value
type meshtype
	frameid as integer // frame id - link
	id as integer // mesh id
	fvf as integer
	fvfsize as integer
	usematerial as boolean
	diffusecol as dword
endtype

type meshptrtype
	id as integer // mesh id
	subid as integer // sub object id e.g. multimaterials ID
	ptr as dword  // pointer start of vertex data
	size as dword // size of vertex data 
endtype

` END STRUCTURES

`globals
global RootSize AS DWORD
global dwCodePTR AS DWORD
global bnkptr AS DWORD
global bnksize AS DWORD
global frameCount
frameCount=-1 // this will force the DBO root frame to start at 0 and not 1
global meshCount
global materialCount

srcdbo$=opendialog("Select a DBO file?","DBO format|*.dbo",0,"")

`validate DBO file to see if genuine or fake DBO
dwLength AS DWORD 
pszString as STRING 
dwVersion AS DWORD 
dwReserved1 AS DWORD 
dwReserved2 AS DWORD 

dwCode AS DWORD
dwCodeSize AS DWORD
pBuffer as BYTE
pData as BYTE
pData = -1 // not sure to use 0 as it's a value and I can't use NULL as DBPro don't understand NULL

if file exist(srcdbo$) <> 1 then end
bnkid = reserve free bank()
make bank from file bnkid,srcdbo$
bnkptr = get bank ptr(bnkid)
bnksize = get bank size(bnkid)

// dbo header
dwCodePTR = bnkptr+0
dwLength = *dwCodePTR
inc dwCodePTR , 4 
pszString = peek string(dwCodePTR,dwLength) 
if pszString <> "MAGICDBO"
	warningmessage "is not a genuine DBO file!"
	DeleteReleaseBank(bnkid)
	end
else
	`message "This is a genuine DBO file!"
endif
inc dwCodePTR , dwLength
dwVersion = *dwCodePTR
inc dwCodePTR , 4
dwReserved1 = *dwCodePTR
inc dwCodePTR , 4
dwReserved2 = *dwCodePTR
inc dwCodePTR , 4

isRoot as boolean
isRoot = GetRootFrame()
if isRoot =0
	warningmessage "No root frame found in DBO, exiting!"
	DeleteReleaseBank(bnkid)
	end
endif

// initialise DBO structure arrays
dim frames() as frametype // frames
dim mesh() as meshtype // mesh
dim meshmatptr() as meshptrtype // mesh ptr to material data

// Read in DBO data , Frame, Mesh, Bone etc
// stripped down for this example
GetAllFrames()

print "frames: ";array count(frames()) // frames
print "mesh: ";array count(mesh()) // mesh
print "meshmatptr: ";array count(meshmatptr())  // mesh ptr to material data

`for m = 0 to array count(mesh())
`	print "diffuse color for mesh "+str$(mesh(m).id)+" : "+str$(mesh(m).diffusecol)
`	print "r: "+str$(rgbr(mesh(m).diffusecol))+" g: "+str$(rgbg(mesh(m).diffusecol))+" b: "+str$(rgbb(mesh(m).diffusecol))+" a: "+str$(rgba(mesh(m).diffusecol))
`next m

meshid=1
meshcol as dword
meshcol=GetMeshColour(meshid)
print "diffuse color for mesh "+str$(meshid)+" : "+str$(meshcol)
print "r: "+str$(rgbr(meshcol))+" g: "+str$(rgbg(meshcol))+" b: "+str$(rgbb(meshcol))+" a: "+str$(rgba(meshcol))
sync
wait key
end

// uses relative string end position based on number of chars to copy from start position e.g. spos = 8 , charnum = 8
// i.e. it calculates the string end position based on start position and the number of chars to copy
function Substr(s$, spos, chars)
   l = len(s$)
   epos = spos + chars-1 // end position equals the start char position plus number of chars minus 1
   for c = 1 to l
	 if c=spos
	 	r$=mid$(s$,c)
	 else
	 	 if c>spos and c<=epos 
			r$=r$+mid$(s$,c)
		 endif
	 endif
   next c
endfunction r$

function bin2dec(src$)
	if len(src$) <=0 or len(src$)>8 then exitfunction 0
	dim binary$(7)
	for i=len(src$) to 1 step -1
    	binary$(len(src$)-i)=mid$(src$,i)
    	bn$=bn$+mid$(src$,i,1)
	next i
	decval=0
	
	for b=0 to 7
    	if binary$(b)="1"
        	inc decval,2^b
    	endif      
	next b
	undim binary$()
endfunction decval

function mkdword(byte1,byte2,byte3,byte4,msb)
    if msb <0 or msb>1 then exitfunction
    if msb=0
    	dw = (byte1) || (byte2 << 8) || (byte3 << 16) || (byte4 << 24)
    else
    	if msb=1
    		dw = (byte4) || (byte3 << 8) || (byte2 << 16) || (byte1 << 24)
		endif
	endif
endfunction dw

function DeleteReleaseBank(id)
	if bank exist(id) 
		delete bank id
		release reserved bank id
	endif
endfunction

function GetRootFrame()
	retbool as boolean 
	retbool = 0	
	dwCode AS DWORD
	dwCodeSize AS DWORD
	
	dwCode = 0
	dwCodeSize = 0
	
	dwCode = *dwCodePTR 		
	dwCodeSizePTR = dwCodePTR+4
	dwCodeSize = *dwCodeSizePTR
	mempos = dwCodePTR - bnkptr
	if (dwCode = DBOBLOCK_ROOT_FRAME and mempos=24) 
		RootSize = dwCodeSize
		retbool = 1	
	endif

endfunction retbool

` stripped down to bare minimum for this example
function GetAllFrames()
	dwCode AS DWORD
	dwCodeSize AS DWORD
	pDataPTR AS DWORD
	
	dwCode = 0
	dwCodeSize = 0
	
	dwCode = *dwCodePTR 		
	dwCodeSizePTR = dwCodePTR+4
	dwCodeSize = *dwCodeSizePTR
	
	mempos = dwCodePTR - bnkptr
	startPTR = bnkptr

	for dwAddr = startPTR to startPTR+bnksize	

		dwCode = *dwAddr 		
		dwCodeSizePTR = dwAddr+4
		dwCodeSize = *dwCodeSizePTR
		mempos = dwAddr - bnkptr
		
		select dwCode
		case DBOBLOCK_FRAME_NAME :
			pDataPTR = dwAddr+8
			pData = *pDataPTR
			if dwCodeSize = pData + 4 and pData <=BYTEMAX
				value$=""
				inc frameCount
				array insert at bottom(frames())
				frames().id = frameCount
				frames().ismesh=0
			endif 
		endcase

		case DBOBLOCK_FRAME_MESH
			pDataPTR = dwAddr+8
			pData = *pDataPTR
			checkvalidPTR = dwAddr+12
			checkvalidData = *checkvalidPTR
			if pData = DBOBLOCK_MESH_FVF and checkvalidData = 4
				dwCodePTR = dwAddr
				inc meshCount
				frames().ismesh=1
				GetFrameMeshData(dwCodeSize)
			endif 
		endcase
		
		endselect
	next dwAddr
endfunction 

DBOFRAMEMESH:

function GetFrameMeshData(meshblocksize)
	dwCode AS DWORD
	dwCodeSize AS DWORD
	pDataPTR AS DWORD
	
	dwCode = 0
	dwCodeSize = 0
		mempos = dwCodePTR - bnkptr
		startPTR = dwCodePTR
		for dwAddr = startPTR to startPTR+meshblocksize
			dwCode = *dwAddr 		
			dwCodeSizePTR = dwAddr+4
			dwCodeSize = *dwCodeSizePTR
			pData = -1
			value$=""
		
			select dwCode
		
			case DBOBLOCK_MESH_FVF :
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				if dwCodeSize = 4
					fvf=pData
					array insert at bottom mesh()
					mesh().id = meshCount
				endif 
			endcase

			case DBOBLOCK_MESH_USEMATERIAL :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if dwCodeSize = 1 or dwCodeSize = 0 
					mesh().usematerial = dwCodeSize
				endif 
			endcase 
			
			case DBOBLOCK_MESH_MATERIAL :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if dwCodeSize = 68 and mesh().usematerial=1
					array insert at bottom meshmatptr()
					meshmatptr().id=meshCount
					meshmatptr().ptr=pDataPTR
					meshmatptr().size=dwCodeSize
				endif 
			endcase 
			endselect

		next dwAddr

endfunction 

function GetMeshColour(meshid)
	msh = array count(mesh()) // mesh
	mshmat = array count(meshmatptr()) // mesh ptr to material data

	// loop through each mesh
	if msh =-1 then exitfunction -1
	for m=0 to msh
		for mm= 0 to mshmat
			if mesh(m).id = meshmatptr(mm).id and mesh(m).id=meshid
				tptr=meshmatptr(mm).ptr
				tsize=meshmatptr(mm).size
				idx=-1
				for i = 0 to tsize-4 step 4
					inc idx
					valuef#=peek float(tptr+i)
					`note DBO stores RGBA as BGRA
					if idx = 0 then mmcolB#=valuef# // Blue
					if idx = 1 then mmcolG#=valuef# // Green
					if idx = 2 then mmcolR#=valuef# // Red
					if idx = 3 then mmcolA#=valuef# // Alpha
				next i
							
				b1 as byte
				b2 as byte
				b3 as byte
				b4 as byte

				`note DBO stores RGBA as BGRA
				b1=mmcolR#*255.0 // Blue
				b2=mmcolG#*255.0 // Green
				b3=mmcolB#*255.0 // Red
				b4=mmcolA#*255.0 // Alpha
											
				col as dword
				col = mkdword(b1,b2,b3,b4,0) 
				endif
		next mm
		mesh(m).diffusecol=col
	next m
endfunction col

Rem Project: Return_Mesh_ColorRGB_v0.1
Rem Created: Tuesday, October 26, 2021
Rem BOTR 2021
Rem Stripped down version of DBOFastReader 0.47
Rem which converts DBO to .X/OBJ (animated and static objects)
Rem ***** Main Source File *****
sync on : sync rate 30 : sync

`constants
#constant appver "return mesh color example 0.1"
#constant BYTEMAX 							256
#constant DBOBLOCK_ROOT_FRAME 				1			// rule = Must = 101 (DBOBLOCK_FRAME_NAME) 
#constant DBOBLOCK_FRAME_NAME 				101			// Rule 1 - Names must be dwCodeSize = pBlock + 4
#constant DBOBLOCK_FRAME_MESH 				103			// Rule x - pBlock must be = 111 (DBOBLOCK_MESH_FVF)
#constant DBOBLOCK_MESH_FVF 				111			// Rule 2 - Size must be = DWORD (4)
#constant DBOBLOCK_MESH_FVFSIZE 			112			// Rule 2 - Size must be = DWORD (4)
#constant DBOBLOCK_MESH_USEMATERIAL 		125			// Rule 5 - Size must be = 0 or 1 (boolean flag =1 Yes 0 =No)
#constant DBOBLOCK_MESH_MATERIAL 			126			// Rule 6 - Size must be = 68 e.g. 4x4float + 1 float
#constant DBOBLOCK_MESH_USEMULTIMAT 		123			// Rule 5 - Size must be = 0 or 1 (boolean flag =1 Yes 0 =No)
#constant DBOBLOCK_MESH_MULTIMATCOUNT 		124			// Rule 2 - Size must be = DWORD (4) - docs say size should be 1 --incorrect??
#constant DBOBLOCK_MESH_MULTIMAT 			139			// Docs point to Multi MAts - 128 so code will either be 161 (Name) or something else????
#constant DBOBLOCK_MULTIMAT_NAME 			161			// Rule 1 - Names must be dwCodeSize = pBlock + 4
#constant DBOBLOCK_MULTIMAT_MATERIAL 		162			// Size must be 68 --Contains a reference to a mesh material.??
#constant DBOBLOCK_MULTIMAT_START 			163			// Rule 2 - Size must be = DWORD (4)
#constant DBOBLOCK_MULTIMAT_COUNT 			164			// Rule 2 - Size must be = DWORD (4)
#constant DBOBLOCK_MULTIMAT_POLY 			165			// Rule 2 - Size must be = DWORD (4)

` END CONSTANTS

// DBO structure related types
type frametype
	id as integer // frame id - parent ID
	ismesh as boolean
endtype

// for mesh, actual data will be stored in separate arrays for multiple values 
// but mesh id will be stored as a linking value
type meshtype
	frameid as integer // frame id - link
	id as integer // mesh id
	fvf as integer
	fvfsize as integer
	usematerial as boolean
	multimatcount as integer
	diffusecol as dword
endtype

type meshptrtype
	id as integer // mesh id
	subid as integer // sub object id e.g. multimaterials ID
	ptr as dword  // pointer start of vertex data
	size as dword // size of vertex data 
endtype

type meshmaterialstype
	id as integer     // mesh id
	mmatid as integer // multimaterial id	
	name as string    // multimaterial name
	start as integer // multimaterial start
	count as integer // multimaterial count
	poly as integer // multimaterial poly
endtype

` END STRUCTURES

`globals
global RootSize AS DWORD
global dwCodePTR AS DWORD
global bnkptr AS DWORD
global bnksize AS DWORD
global frameCount
frameCount=-1 // this will force the DBO root frame to start at 0 and not 1
global meshCount
global materialCount

srcdbo$=opendialog("Select a DBO file?","DBO format|*.dbo",0,"")

if srcdbo$ ="" then end

`validate DBO file to see if genuine or fake DBO
dwLength AS DWORD 
pszString as STRING 
dwVersion AS DWORD 
dwReserved1 AS DWORD 
dwReserved2 AS DWORD 

dwCode AS DWORD
dwCodeSize AS DWORD
pBuffer as BYTE
pData as BYTE
pData = -1 // not sure to use 0 as it's a value and I can't use NULL as DBPro don't understand NULL

if file exist(srcdbo$) <> 1 then end
bnkid = reserve free bank()
make bank from file bnkid,srcdbo$
bnkptr = get bank ptr(bnkid)
bnksize = get bank size(bnkid)

// dbo header
dwCodePTR = bnkptr+0
dwLength = *dwCodePTR
inc dwCodePTR , 4 
pszString = peek string(dwCodePTR,dwLength) 
if pszString <> "MAGICDBO"
	warningmessage "is not a genuine DBO file!"
	DeleteReleaseBank(bnkid)
	end
else
	`message "This is a genuine DBO file!"
endif
inc dwCodePTR , dwLength
dwVersion = *dwCodePTR
inc dwCodePTR , 4
dwReserved1 = *dwCodePTR
inc dwCodePTR , 4
dwReserved2 = *dwCodePTR
inc dwCodePTR , 4

isRoot as boolean
isRoot = GetRootFrame()
if isRoot =0
	warningmessage "No root frame found in DBO, exiting!"
	DeleteReleaseBank(bnkid)
	end
endif

// initialise DBO structure arrays
dim frames() as frametype // frames
dim mesh() as meshtype // mesh
dim meshmatptr() as meshptrtype // mesh ptr to material data
dim meshmultimaterials() as meshmaterialstype //mesh multimaterials
dim meshmultimatptr() as meshptrtype // ptr to mesh multimaterial data

// Read in DBO data , Frame, Mesh, Bone etc
// stripped down for this example
GetAllFrames()

print "frames: ";array count(frames())+1 // frames
print "mesh: ";array count(mesh())+1 // mesh
print "meshmatptr: ";array count(meshmatptr())+1  // mesh ptr to material data
print "meshmulimaterials: ";array count(meshmultimaterials())+1  //mesh multimaterials
print "meshmultimatptr: ";array count(meshmultimatptr())+1  // ptr to mesh multimaterial data

meshcol as dword

do
cls
print "frames: ";array count(frames())+1 // frames
print "mesh: ";array count(mesh())+1 // mesh
print "meshmatptr: ";array count(meshmatptr())+1  // mesh ptr to material data
print "meshmulimaterials: ";array count(meshmultimaterials())+1  //mesh multimaterials
print "meshmultimatptr: ";array count(meshmultimatptr())+1  // ptr to mesh multimaterial data
for m = 0 to array count(mesh())
	meshcol=GetMeshRGBA(mesh(m).id)
	print "diffuse color for mesh "+str$(mesh(m).id)+" : "+str$(meshcol)
	print "r: "+str$(rgbr(meshcol))+" g: "+str$(rgbg(meshcol))+" b: "+str$(rgbb(meshcol))+" a: "+str$(rgba(meshcol))
next m
sync
loop

end

// uses relative string end position based on number of chars to copy from start position e.g. spos = 8 , charnum = 8
// i.e. it calculates the string end position based on start position and the number of chars to copy
function Substr(s$, spos, chars)
   l = len(s$)
   epos = spos + chars-1 // end position equals the start char position plus number of chars minus 1
   for c = 1 to l
	 if c=spos
	 	r$=mid$(s$,c)
	 else
	 	 if c>spos and c<=epos 
			r$=r$+mid$(s$,c)
		 endif
	 endif
   next c
endfunction r$

function bin2dec(src$)
	if len(src$) <=0 or len(src$)>8 then exitfunction 0
	dim binary$(7)
	for i=len(src$) to 1 step -1
    	binary$(len(src$)-i)=mid$(src$,i)
    	bn$=bn$+mid$(src$,i,1)
	next i
	decval=0
	
	for b=0 to 7
    	if binary$(b)="1"
        	inc decval,2^b
    	endif      
	next b
	undim binary$()
endfunction decval

function mkdword(byte1,byte2,byte3,byte4,msb)
    if msb <0 or msb>1 then exitfunction
    if msb=0
    	dw = (byte1) || (byte2 << 8) || (byte3 << 16) || (byte4 << 24)
    else
    	if msb=1
    		dw = (byte4) || (byte3 << 8) || (byte2 << 16) || (byte1 << 24)
		endif
	endif
endfunction dw

function DeleteReleaseBank(id)
	if bank exist(id) 
		delete bank id
		release reserved bank id
	endif
endfunction

function GetRootFrame()
	retbool as boolean 
	retbool = 0	
	dwCode AS DWORD
	dwCodeSize AS DWORD
	
	dwCode = 0
	dwCodeSize = 0
	
	dwCode = *dwCodePTR 		
	dwCodeSizePTR = dwCodePTR+4
	dwCodeSize = *dwCodeSizePTR
	mempos = dwCodePTR - bnkptr
	if (dwCode = DBOBLOCK_ROOT_FRAME and mempos=24) 
		RootSize = dwCodeSize
		retbool = 1	
	endif

endfunction retbool

` stripped down to bare minimum for this example
function GetAllFrames()
	dwCode AS DWORD
	dwCodeSize AS DWORD
	pDataPTR AS DWORD
	
	dwCode = 0
	dwCodeSize = 0
	
	dwCode = *dwCodePTR 		
	dwCodeSizePTR = dwCodePTR+4
	dwCodeSize = *dwCodeSizePTR
	
	mempos = dwCodePTR - bnkptr
	startPTR = bnkptr

	for dwAddr = startPTR to startPTR+bnksize	

		dwCode = *dwAddr 		
		dwCodeSizePTR = dwAddr+4
		dwCodeSize = *dwCodeSizePTR
		mempos = dwAddr - bnkptr
		
		select dwCode
		case DBOBLOCK_FRAME_NAME :
			pDataPTR = dwAddr+8
			pData = *pDataPTR
			if dwCodeSize = pData + 4 and pData <=BYTEMAX
				value$=""
				inc frameCount
				array insert at bottom(frames())
				frames().id = frameCount
				frames().ismesh=0
			endif 
		endcase

		case DBOBLOCK_FRAME_MESH
			pDataPTR = dwAddr+8
			pData = *pDataPTR
			checkvalidPTR = dwAddr+12
			checkvalidData = *checkvalidPTR
			if pData = DBOBLOCK_MESH_FVF and checkvalidData = 4
				dwCodePTR = dwAddr
				inc meshCount
				frames().ismesh=1
				GetFrameMeshData(dwCodeSize)
			endif 
		endcase
		
		endselect
	next dwAddr
endfunction 

DBOFRAMEMESH:

function GetFrameMeshData(meshblocksize)
	dwCode AS DWORD
	dwCodeSize AS DWORD
	pDataPTR AS DWORD
	
	dwCode = 0
	dwCodeSize = 0
		mempos = dwCodePTR - bnkptr
		startPTR = dwCodePTR
		for dwAddr = startPTR to startPTR+meshblocksize
			dwCode = *dwAddr 		
			dwCodeSizePTR = dwAddr+4
			dwCodeSize = *dwCodeSizePTR
			pData = -1
			value$=""
		
			select dwCode
		
			case DBOBLOCK_MESH_FVF :
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				if dwCodeSize = 4
					fvf=pData
					array insert at bottom mesh()
					mesh().id = meshCount
				endif 
			endcase

			case DBOBLOCK_MESH_USEMATERIAL :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if dwCodeSize = 1 or dwCodeSize = 0 
					mesh().usematerial = dwCodeSize
				endif 
			endcase 
			
			case DBOBLOCK_MESH_MATERIAL :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if dwCodeSize = 68 and mesh().usematerial=1
					array insert at bottom meshmatptr()
					meshmatptr().id=meshCount
					meshmatptr().ptr=pDataPTR
					meshmatptr().size=dwCodeSize
				endif 
			endcase 

			case DBOBLOCK_MESH_USEMULTIMAT :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if dwCodeSize = 1 or dwCodeSize = 0 
				endif 
			endcase 

			case DBOBLOCK_MESH_MULTIMATCOUNT :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if dwCodeSize = 4 
					mesh().multimatcount=pData
				endif 
			endcase 

			case DBOBLOCK_MESH_MULTIMAT :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if pData = DBOBLOCK_MULTIMAT_NAME 
					dwCodePTR = dwAddr			
					GetMeshMaterialsData(dwCodeSize)
				endif 
			endcase 

			endselect

		next dwAddr

endfunction 

function GetMeshMaterialsData(materialsblocksize)
	dwCode AS DWORD
	dwCodeSize AS DWORD
	pDataPTR AS DWORD
	
	dwCode = 0
	dwCodeSize = 0
		startPTR = dwCodePTR
		for dwAddr = startPTR to startPTR+materialsblocksize
			dwCode = *dwAddr 		
			dwCodeSizePTR = dwAddr+4
			dwCodeSize = *dwCodeSizePTR
			pData = -1
			value$=""
		
			select dwCode

			case DBOBLOCK_MULTIMAT_NAME :
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				if dwCodeSize = pData + 4 and pData <=255
					value$=""
					if pData > 0
						value$=peek string(dwAddr+12,pData)
					else
						value$=""
					endif
					inc materialCount 
					array insert at bottom(meshmultimaterials())
					meshmultimaterials().id = meshCount
					meshmultimaterials().mmatid=materialCount
					meshmultimaterials().name = value$
				endif 
			endcase

			case DBOBLOCK_MULTIMAT_MATERIAL :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if dwCodeSize = 68
					array insert at bottom meshmultimatptr()
					meshmultimatptr().id=meshCount
					meshmultimatptr().subid=materialCount // link this with meshmultimaterials().mmatid - generic name used i.e. subid
					meshmultimatptr().ptr=pDataPTR
					meshmultimatptr().size=dwCodeSize
				endif 
			endcase 

			case DBOBLOCK_MULTIMAT_START :
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				if dwCodeSize = 4
					meshmultimaterials().start = pData
				endif 
			endcase

			case DBOBLOCK_MULTIMAT_COUNT :
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				if dwCodeSize = 4
					meshmultimaterials().count = pData
				endif 
			endcase

			case DBOBLOCK_MULTIMAT_POLY :
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				if dwCodeSize = 4
					meshmultimaterials().poly = pData
				endif 
			endcase

			endselect

		next dwAddr
endfunction 

function GetMeshRGBA(meshid)
	msh = array count(mesh()) // mesh
	mshmat = array count(meshmatptr()) // mesh ptr to material data
	mshmmat = array count(meshmultimaterials()) // mesh ptr to multimaterial data

	// loop through each mesh
	if msh =-1 then exitfunction -1
	for m=0 to msh
	if mshmat > -1 
		for mm= 0 to mshmat
			if mesh(m).id = meshmatptr(mm).id and mesh(m).id=meshid
				tptr=meshmatptr(mm).ptr
				tsize=meshmatptr(mm).size
				idx=-1
				for i = 0 to tsize-4 step 4
					inc idx
					valuef#=peek float(tptr+i)
					`note DBO stores RGBA as BGRA
					if idx = 0 then mmcolB#=valuef# // Blue
					if idx = 1 then mmcolG#=valuef# // Green
					if idx = 2 then mmcolR#=valuef# // Red
					if idx = 3 then mmcolA#=valuef# // Alpha
				next i
							
				b1 as byte
				b2 as byte
				b3 as byte
				b4 as byte

				`note DBO stores RGBA as BGRA
				b1=mmcolR#*255.0 // Blue
				b2=mmcolG#*255.0 // Green
				b3=mmcolB#*255.0 // Red
				b4=mmcolA#*255.0 // Alpha
											
				col as dword
				col = mkdword(b1,b2,b3,b4,0) 
			endif
		next mm
	endif
	
	if mshmmat > -1 		
		for mt=0 to mshmmat
			if mesh(m).id = meshmultimaterials(mt).id
				for mm= 0 to mshmmat
					if mesh(m).id = meshmultimatptr(mm).id and meshmultimatptr(mm).subid=meshmultimaterials(mt).id and mesh(m).id=meshid
						tptr=meshmultimatptr(mm).ptr
						tsize=meshmultimatptr(mm).size
						idx=-1
						for i = 0 to tsize-4 step 4
							inc idx
							valuef#=peek float(tptr+i)
							`note DBO stores RGBA as BGRA
							if idx = 0 then mmcolB#=valuef# // Blue
							if idx = 1 then mmcolG#=valuef# // Green
							if idx = 2 then mmcolR#=valuef# // Red
							if idx = 3 then mmcolA#=valuef# // Alpha
						next i
						b1 as byte
						b2 as byte
						b3 as byte
						b4 as byte
			
						`note DBO stores RGBA as BGRA
						b1=mmcolR#*255.0 // Blue
						b2=mmcolG#*255.0 // Green
						b3=mmcolB#*255.0 // Red
						b4=mmcolA#*255.0 // Alpha
														
						col as dword
						col = mkdword(b1,b2,b3,b4,0) 
					endif
				next mm
			endif
		next mt
	endif
	
	mesh(m).diffusecol=col
	next m
endfunction col

Rem Project: Return_Mesh_ColorRGB_v0.1
Rem Created: Tuesday, October 26, 2021
Rem BOTR 2021
Rem Stripped down version of DBOFastReader 0.47
Rem which converts DBO to .X/OBJ (animated and static objects)
Rem ***** Main Source File *****
sync on : sync rate 30 : sync

`constants
#constant appver "return mesh color example 0.1"
#constant BYTEMAX 							256
#constant DBOBLOCK_ROOT_FRAME 				1			// rule = Must = 101 (DBOBLOCK_FRAME_NAME) 
#constant DBOBLOCK_FRAME_NAME 				101			// Rule 1 - Names must be dwCodeSize = pBlock + 4
#constant DBOBLOCK_FRAME_MESH 				103			// Rule x - pBlock must be = 111 (DBOBLOCK_MESH_FVF)
#constant DBOBLOCK_MESH_FVF 				111			// Rule 2 - Size must be = DWORD (4)
#constant DBOBLOCK_MESH_FVFSIZE 			112			// Rule 2 - Size must be = DWORD (4)
#constant DBOBLOCK_MESH_USEMATERIAL 		125			// Rule 5 - Size must be = 0 or 1 (boolean flag =1 Yes 0 =No)
#constant DBOBLOCK_MESH_MATERIAL 			126			// Rule 6 - Size must be = 68 e.g. 4x4float + 1 float
#constant DBOBLOCK_MESH_USEMULTIMAT 		123			// Rule 5 - Size must be = 0 or 1 (boolean flag =1 Yes 0 =No)
#constant DBOBLOCK_MESH_MULTIMATCOUNT 		124			// Rule 2 - Size must be = DWORD (4) - docs say size should be 1 --incorrect??
#constant DBOBLOCK_MESH_MULTIMAT 			139			// Docs point to Multi MAts - 128 so code will either be 161 (Name) or something else????
#constant DBOBLOCK_MULTIMAT_NAME 			161			// Rule 1 - Names must be dwCodeSize = pBlock + 4
#constant DBOBLOCK_MULTIMAT_MATERIAL 		162			// Size must be 68 --Contains a reference to a mesh material.??
#constant DBOBLOCK_MULTIMAT_START 			163			// Rule 2 - Size must be = DWORD (4)
#constant DBOBLOCK_MULTIMAT_COUNT 			164			// Rule 2 - Size must be = DWORD (4)
#constant DBOBLOCK_MULTIMAT_POLY 			165			// Rule 2 - Size must be = DWORD (4)

` END CONSTANTS

// DBO structure related types
type frametype
	id as integer // frame id - parent ID
	ismesh as boolean
endtype

// for mesh, actual data will be stored in separate arrays for multiple values 
// but mesh id will be stored as a linking value
type meshtype
	frameid as integer // frame id - link
	id as integer // mesh id
	fvf as integer
	fvfsize as integer
	usematerial as boolean
	multimatcount as integer
	diffusecol as dword
endtype

type meshptrtype
	id as integer // mesh id
	subid as integer // sub object id e.g. multimaterials ID
	ptr as dword  // pointer start of vertex data
	size as dword // size of vertex data 
endtype

type meshmaterialstype
	id as integer     // mesh id
	mmatid as integer // multimaterial id	
	name as string    // multimaterial name
	start as integer // multimaterial start
	count as integer // multimaterial count
	poly as integer // multimaterial poly
endtype

` END STRUCTURES

`globals
global RootSize AS DWORD
global dwCodePTR AS DWORD
global bnkptr AS DWORD
global bnksize AS DWORD
global frameCount
frameCount=-1 // this will force the DBO root frame to start at 0 and not 1
global meshCount
global materialCount

srcdbo$=opendialog("Select a DBO file?","DBO format|*.dbo",0,"")

if srcdbo$ ="" then end

`validate DBO file to see if genuine or fake DBO
dwLength AS DWORD 
pszString as STRING 
dwVersion AS DWORD 
dwReserved1 AS DWORD 
dwReserved2 AS DWORD 

dwCode AS DWORD
dwCodeSize AS DWORD
pBuffer as BYTE
pData as BYTE
pData = -1 // not sure to use 0 as it's a value and I can't use NULL as DBPro don't understand NULL

if file exist(srcdbo$) <> 1 then end
bnkid = reserve free bank()
make bank from file bnkid,srcdbo$
bnkptr = get bank ptr(bnkid)
bnksize = get bank size(bnkid)

// dbo header
dwCodePTR = bnkptr+0
dwLength = *dwCodePTR
inc dwCodePTR , 4 
pszString = peek string(dwCodePTR,dwLength) 
if pszString <> "MAGICDBO"
	warningmessage "is not a genuine DBO file!"
	DeleteReleaseBank(bnkid)
	end
else
	`message "This is a genuine DBO file!"
endif
inc dwCodePTR , dwLength
dwVersion = *dwCodePTR
inc dwCodePTR , 4
dwReserved1 = *dwCodePTR
inc dwCodePTR , 4
dwReserved2 = *dwCodePTR
inc dwCodePTR , 4

isRoot as boolean
isRoot = GetRootFrame()
if isRoot =0
	warningmessage "No root frame found in DBO, exiting!"
	DeleteReleaseBank(bnkid)
	end
endif

// initialise DBO structure arrays
dim frames() as frametype // frames
dim mesh() as meshtype // mesh
dim meshmatptr() as meshptrtype // mesh ptr to material data
dim meshmultimaterials() as meshmaterialstype //mesh multimaterials
dim meshmultimatptr() as meshptrtype // ptr to mesh multimaterial data

// Read in DBO data , Frame, Mesh, Bone etc
// stripped down for this example
GetAllFrames()

print "frames: ";array count(frames())+1 // frames
print "mesh: ";array count(mesh())+1 // mesh
print "meshmatptr: ";array count(meshmatptr())+1  // mesh ptr to material data
print "meshmulimaterials: ";array count(meshmultimaterials())+1  //mesh multimaterials
print "meshmultimatptr: ";array count(meshmultimatptr())+1  // ptr to mesh multimaterial data

meshcol as dword

do
cls
print "frames: ";array count(frames())+1 // frames
print "mesh: ";array count(mesh())+1 // mesh
print "meshmatptr: ";array count(meshmatptr())+1  // mesh ptr to material data
print "meshmulimaterials: ";array count(meshmultimaterials())+1  //mesh multimaterials
print "meshmultimatptr: ";array count(meshmultimatptr())+1  // ptr to mesh multimaterial data
for m = 0 to array count(mesh())
	meshcol=GetMeshRGBA(mesh(m).id)
	print "diffuse color for mesh "+str$(mesh(m).id)+" : "+str$(meshcol)
	print "r: "+str$(rgbr(meshcol))+" g: "+str$(rgbg(meshcol))+" b: "+str$(rgbb(meshcol))+" a: "+str$(rgba(meshcol))
next m
sync
loop

end

// uses relative string end position based on number of chars to copy from start position e.g. spos = 8 , charnum = 8
// i.e. it calculates the string end position based on start position and the number of chars to copy
function Substr(s$, spos, chars)
   l = len(s$)
   epos = spos + chars-1 // end position equals the start char position plus number of chars minus 1
   for c = 1 to l
	 if c=spos
	 	r$=mid$(s$,c)
	 else
	 	 if c>spos and c<=epos 
			r$=r$+mid$(s$,c)
		 endif
	 endif
   next c
endfunction r$

function bin2dec(src$)
	if len(src$) <=0 or len(src$)>8 then exitfunction 0
	dim binary$(7)
	for i=len(src$) to 1 step -1
    	binary$(len(src$)-i)=mid$(src$,i)
    	bn$=bn$+mid$(src$,i,1)
	next i
	decval=0
	
	for b=0 to 7
    	if binary$(b)="1"
        	inc decval,2^b
    	endif      
	next b
	undim binary$()
endfunction decval

function mkdword(byte1,byte2,byte3,byte4,msb)
    if msb <0 or msb>1 then exitfunction
    if msb=0
    	dw = (byte1) || (byte2 << 8) || (byte3 << 16) || (byte4 << 24)
    else
    	if msb=1
    		dw = (byte4) || (byte3 << 8) || (byte2 << 16) || (byte1 << 24)
		endif
	endif
endfunction dw

function DeleteReleaseBank(id)
	if bank exist(id) 
		delete bank id
		release reserved bank id
	endif
endfunction

function GetRootFrame()
	retbool as boolean 
	retbool = 0	
	dwCode AS DWORD
	dwCodeSize AS DWORD
	
	dwCode = 0
	dwCodeSize = 0
	
	dwCode = *dwCodePTR 		
	dwCodeSizePTR = dwCodePTR+4
	dwCodeSize = *dwCodeSizePTR
	mempos = dwCodePTR - bnkptr
	if (dwCode = DBOBLOCK_ROOT_FRAME and mempos=24) 
		RootSize = dwCodeSize
		retbool = 1	
	endif

endfunction retbool

` stripped down to bare minimum for this example
function GetAllFrames()
	dwCode AS DWORD
	dwCodeSize AS DWORD
	pDataPTR AS DWORD
	
	dwCode = 0
	dwCodeSize = 0
	
	dwCode = *dwCodePTR 		
	dwCodeSizePTR = dwCodePTR+4
	dwCodeSize = *dwCodeSizePTR
	
	mempos = dwCodePTR - bnkptr
	startPTR = bnkptr

	for dwAddr = startPTR to startPTR+bnksize	

		dwCode = *dwAddr 		
		dwCodeSizePTR = dwAddr+4
		dwCodeSize = *dwCodeSizePTR
		mempos = dwAddr - bnkptr
		
		select dwCode
		case DBOBLOCK_FRAME_NAME :
			pDataPTR = dwAddr+8
			pData = *pDataPTR
			if dwCodeSize = pData + 4 and pData <=BYTEMAX
				value$=""
				inc frameCount
				array insert at bottom(frames())
				frames().id = frameCount
				frames().ismesh=0
			endif 
		endcase

		case DBOBLOCK_FRAME_MESH
			pDataPTR = dwAddr+8
			pData = *pDataPTR
			checkvalidPTR = dwAddr+12
			checkvalidData = *checkvalidPTR
			if pData = DBOBLOCK_MESH_FVF and checkvalidData = 4
				dwCodePTR = dwAddr
				inc meshCount
				frames().ismesh=1
				GetFrameMeshData(dwCodeSize)
			endif 
		endcase
		
		endselect
	next dwAddr
endfunction 

DBOFRAMEMESH:

function GetFrameMeshData(meshblocksize)
	dwCode AS DWORD
	dwCodeSize AS DWORD
	pDataPTR AS DWORD
	
	dwCode = 0
	dwCodeSize = 0
		mempos = dwCodePTR - bnkptr
		startPTR = dwCodePTR
		for dwAddr = startPTR to startPTR+meshblocksize
			dwCode = *dwAddr 		
			dwCodeSizePTR = dwAddr+4
			dwCodeSize = *dwCodeSizePTR
			pData = -1
			value$=""
		
			select dwCode
		
			case DBOBLOCK_MESH_FVF :
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				if dwCodeSize = 4
					fvf=pData
					array insert at bottom mesh()
					mesh().id = meshCount
				endif 
			endcase

			case DBOBLOCK_MESH_USEMATERIAL :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if dwCodeSize = 1 or dwCodeSize = 0 
					mesh().usematerial = dwCodeSize
				endif 
			endcase 
			
			case DBOBLOCK_MESH_MATERIAL :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if dwCodeSize = 68 and mesh().usematerial=1
					array insert at bottom meshmatptr()
					meshmatptr().id=meshCount
					meshmatptr().ptr=pDataPTR
					meshmatptr().size=dwCodeSize
				endif 
			endcase 

			case DBOBLOCK_MESH_USEMULTIMAT :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if dwCodeSize = 1 or dwCodeSize = 0 
				endif 
			endcase 

			case DBOBLOCK_MESH_MULTIMATCOUNT :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if dwCodeSize = 4 
					mesh().multimatcount=pData
				endif 
			endcase 

			case DBOBLOCK_MESH_MULTIMAT :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if pData = DBOBLOCK_MULTIMAT_NAME 
					dwCodePTR = dwAddr			
					GetMeshMaterialsData(dwCodeSize)
				endif 
			endcase 

			endselect

		next dwAddr

endfunction 

function GetMeshMaterialsData(materialsblocksize)
	dwCode AS DWORD
	dwCodeSize AS DWORD
	pDataPTR AS DWORD
	
	dwCode = 0
	dwCodeSize = 0
		startPTR = dwCodePTR
		for dwAddr = startPTR to startPTR+materialsblocksize
			dwCode = *dwAddr 		
			dwCodeSizePTR = dwAddr+4
			dwCodeSize = *dwCodeSizePTR
			pData = -1
			value$=""
		
			select dwCode

			case DBOBLOCK_MULTIMAT_NAME :
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				if dwCodeSize = pData + 4 and pData <=255
					value$=""
					if pData > 0
						value$=peek string(dwAddr+12,pData)
					else
						value$=""
					endif
					inc materialCount 
					array insert at bottom(meshmultimaterials())
					meshmultimaterials().id = meshCount
					meshmultimaterials().mmatid=materialCount
					meshmultimaterials().name = value$
				endif 
			endcase

			case DBOBLOCK_MULTIMAT_MATERIAL :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if dwCodeSize = 68
					array insert at bottom meshmultimatptr()
					meshmultimatptr().id=meshCount
					meshmultimatptr().subid=materialCount // link this with meshmultimaterials().mmatid - generic name used i.e. subid
					meshmultimatptr().ptr=pDataPTR
					meshmultimatptr().size=dwCodeSize
				endif 
			endcase 

			case DBOBLOCK_MULTIMAT_START :
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				if dwCodeSize = 4
					meshmultimaterials().start = pData
				endif 
			endcase

			case DBOBLOCK_MULTIMAT_COUNT :
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				if dwCodeSize = 4
					meshmultimaterials().count = pData
				endif 
			endcase

			case DBOBLOCK_MULTIMAT_POLY :
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				if dwCodeSize = 4
					meshmultimaterials().poly = pData
				endif 
			endcase

			endselect

		next dwAddr
endfunction 

function GetMeshRGBA(meshid)
	msh = array count(mesh()) // mesh
	mshmat = array count(meshmatptr()) // mesh ptr to material data
	mshmmat = array count(meshmultimaterials()) // mesh ptr to multimaterial data

	// loop through each mesh
	if msh =-1 then exitfunction -1
	for m=0 to msh
	if mshmat > -1 
		for mm= 0 to mshmat
			if mesh(m).id = meshmatptr(mm).id and mesh(m).id=meshid
				tptr=meshmatptr(mm).ptr
				tsize=meshmatptr(mm).size
				idx=-1
				for i = 0 to tsize-4 step 4
					inc idx
					valuef#=peek float(tptr+i)
					`note DBO stores RGBA as BGRA
					if idx = 0 then mmcolB#=valuef# // Blue
					if idx = 1 then mmcolG#=valuef# // Green
					if idx = 2 then mmcolR#=valuef# // Red
					if idx = 3 then mmcolA#=valuef# // Alpha
				next i
							
				b1 as byte
				b2 as byte
				b3 as byte
				b4 as byte

				`note DBO stores RGBA as BGRA
				b1=mmcolR#*255.0 // Blue
				b2=mmcolG#*255.0 // Green
				b3=mmcolB#*255.0 // Red
				b4=mmcolA#*255.0 // Alpha
											
				col as dword
				col = mkdword(b1,b2,b3,b4,0) 
			endif
		next mm
	endif
	
	if mshmmat > -1 		
		for mt=0 to mshmmat
			if mesh(m).id = meshmultimaterials(mt).id
				for mm= 0 to mshmmat
					if mesh(m).id = meshmultimatptr(mm).id and meshmultimatptr(mm).subid=meshmultimaterials(mt).id and mesh(m).id=meshid
						tptr=meshmultimatptr(mm).ptr
						tsize=meshmultimatptr(mm).size
						idx=-1
						for i = 0 to tsize-4 step 4
							inc idx
							valuef#=peek float(tptr+i)
							`note DBO stores RGBA as BGRA
							if idx = 0 then mmcolB#=valuef# // Blue
							if idx = 1 then mmcolG#=valuef# // Green
							if idx = 2 then mmcolR#=valuef# // Red
							if idx = 3 then mmcolA#=valuef# // Alpha
						next i
						b1 as byte
						b2 as byte
						b3 as byte
						b4 as byte
			
						`note DBO stores RGBA as BGRA
						b1=mmcolR#*255.0 // Blue
						b2=mmcolG#*255.0 // Green
						b3=mmcolB#*255.0 // Red
						b4=mmcolA#*255.0 // Alpha
														
						col as dword
						col = mkdword(b1,b2,b3,b4,0) 
					endif
				next mm
			endif
		next mt
	endif
	
	mesh(m).diffusecol=col
	next m
endfunction col

Rem Project: Return_Mesh_ColorRGB_v0.2
Rem Created: Saturday, October 30, 2021
Rem BOTR 2021
Rem Stripped down version of DBOFastReader 0.47
Rem which converts DBO to .X/OBJ (animated and static objects)
Rem This code Get / Sets Object mesh / multiple mesh color (diffuse)
Rem Requires IanM Matrix1Utils plugin-thanks IanM
Rem ***** Main Source File *****
sync on : sync rate 30 : sync
`constants
gosub INIT_CONSTANTS
`type
gosub INIT_TYPES
`globals
gosub INIT_GLOBALS

`easy user dbo selection
src$=opendialog("Select a DBO file?","DBO format|*.dbo|DirectX format|*.x",0,"")

if src$ ="" then end

`retain just the filename text without extension
shortfilename$=GetFileShort$(src$)

`if file selected was a direct x file, load and convert to .dbo then delete object
srcext$=extract fileext$(src$)
if upper$(srcext$)=".X" 
	load object src$,1
	outdbo$=shortfilename$+".dbo"
	deletefile(outdbo$)
	save object outdbo$,1
	delete object 1
	src$=outdbo$
endif

`validate DBO file to see if genuine or fake DBO
dwLength AS DWORD
pszString as STRING 
dwVersion AS DWORD 
dwReserved1 AS DWORD 
dwReserved2 AS DWORD 

dwCode AS DWORD
dwCodeSize AS DWORD
pBuffer as BYTE
pData as BYTE
pData = -1 // not sure to use 0 as it's a value and I can't use NULL as DBPro don't understand NULL

if file exist(src$) <> 1 then end
bnkid = reserve free bank()
make bank from file bnkid,src$
bnkptr = get bank ptr(bnkid)
bnksize = get bank size(bnkid)
objid=reserve free object()
make object from pointer objid,bnkptr

// dbo header
dwCodePTR = bnkptr+0
dwLength = *dwCodePTR
inc dwCodePTR , 4 
pszString = peek string(dwCodePTR,dwLength) 
if pszString <> "MAGICDBO"
	warningmessage "is not a genuine DBO file!"
	DeleteReleaseBank(bnkid)
	end
else
	`message "This is a genuine DBO file!"
endif
inc dwCodePTR , dwLength
dwVersion = *dwCodePTR
inc dwCodePTR , 4
dwReserved1 = *dwCodePTR
inc dwCodePTR , 4
dwReserved2 = *dwCodePTR
inc dwCodePTR , 4

isRoot as boolean
isRoot = GetRootFrame()
if isRoot =0
	warningmessage "No root frame found in DBO, exiting!"
	DeleteReleaseBank(bnkid)
	end
endif

// initialise DBO structure arrays
dim frames() as frametype // frames
dim mesh() as meshtype // mesh
dim meshmatptr() as meshptrtype // mesh ptr to material data
dim meshmultimaterials() as meshmaterialstype //mesh multimaterials
dim meshmultimatptr() as meshptrtype // ptr to mesh multimaterial data

// Read in DBO data , Frame, Mesh, Bone etc
// stripped down for this example
GetAllFrames()

meshcol as dword
print "Number of frames: ";array count(frames())+1 // frames
print "Number of meshes: ";array count(mesh())+1 // mesh
print "meshmatptr: ";array count(meshmatptr())+1  // mesh ptr to material data
print "meshmulimaterials: ";array count(meshmultimaterials())+1  //mesh multimaterials
print "meshmultimatptr: ";array count(meshmultimatptr())+1  // ptr to mesh multimaterial data
for m = 0 to array count(mesh())
	meshcol=GetMeshRGBA(mesh(m).id)
	print "diffuse color for mesh "+str$(mesh(m).id)+" : "+str$(meshcol)
	print "r: "+str$(rgbr(meshcol))+" g: "+str$(rgbg(meshcol))+" b: "+str$(rgbb(meshcol))+" a: "+str$(rgba(meshcol))
next m


` change each mesh (assuming there are 3 here-update to suit) to a different color
RGBAval1 as dword
RGBAval2 as dword
RGBAval3 as dword
RGBAval1=rgb(rnd(255),rnd(255),rnd(255))
RGBAval2=rgb(rnd(255),rnd(255),rnd(255))
RGBAval3=rgb(rnd(255),rnd(255),rnd(255))
for m = 0 to array count(mesh())
	if mesh(m).id=1 then SetMeshRGBA(mesh(m).id,RGBAval1)
	if mesh(m).id=2 then SetMeshRGBA(mesh(m).id,RGBAval2)
	if mesh(m).id=3 then SetMeshRGBA(mesh(m).id,RGBAval3)
next m

`create a 2nd object using modified material info and save out to file 
make object from pointer 2,bnkptr
outdbo$=shortfilename$+"_modified_diffuse.dbo"
DeleteFile(outdbo$)
save object shortfilename$+"_modified_diffuse.dbo",2

`display the modified content
print
for m = 0 to array count(mesh())
	meshcol=GetMeshRGBA(mesh(m).id)
	print "Modified object:"
	print "diffuse color for mesh "+str$(mesh(m).id)+" : "+str$(meshcol)
	print "r: "+str$(rgbr(meshcol))+" g: "+str$(rgbg(meshcol))+" b: "+str$(rgbb(meshcol))+" a: "+str$(rgba(meshcol))
next m

sync
wait key

` cleanup
release reserved object objid
delete object objid
release reserved bank bnkid
delete bank bnkid
end

function DeleteFile(f$)
	if file exist(f$)=1 then delete file f$
endfunction

function GetFileShort$(src$) 
	longfilename$=src$
	shortfilename$=extract filename$(longfilename$)
	shortfilenameext$=extract fileext$(longfilename$)
	shortfilenameextlen  = fast len (shortfilenameext$)
	shortfilename$ = fast left$(shortfilename$,fast len (shortfilename$)-shortfilenameextlen) 
endfunction shortfilename$

// uses relative string end position based on number of chars to copy from start position e.g. spos = 8 , charnum = 8
// i.e. it calculates the string end position based on start position and the number of chars to copy
function Substr(s$, spos, chars)
   l = len(s$)
   epos = spos + chars-1 // end position equals the start char position plus number of chars minus 1
   for c = 1 to l
	 if c=spos
	 	r$=mid$(s$,c)
	 else
	 	 if c>spos and c<=epos 
			r$=r$+mid$(s$,c)
		 endif
	 endif
   next c
endfunction r$

function bin2dec(src$)
	if len(src$) <=0 or len(src$)>8 then exitfunction 0
	dim binary$(7)
	for i=len(src$) to 1 step -1
    	binary$(len(src$)-i)=mid$(src$,i)
    	bn$=bn$+mid$(src$,i,1)
	next i
	decval=0
	
	for b=0 to 7
    	if binary$(b)="1"
        	inc decval,2^b
    	endif      
	next b
	undim binary$()
endfunction decval

function mkdword(byte1,byte2,byte3,byte4,msb)
    if msb <0 or msb>1 then exitfunction
    if msb=0
    	dw = (byte1) || (byte2 << 8) || (byte3 << 16) || (byte4 << 24)
    else
    	if msb=1
    		dw = (byte4) || (byte3 << 8) || (byte2 << 16) || (byte1 << 24)
		endif
	endif
endfunction dw

function DeleteReleaseBank(id)
	if bank exist(id) 
		delete bank id
		release reserved bank id
	endif
endfunction

function GetRootFrame()
	retbool as boolean 
	retbool = 0	
	dwCode AS DWORD
	dwCodeSize AS DWORD
	
	dwCode = 0
	dwCodeSize = 0
	
	dwCode = *dwCodePTR 		
	dwCodeSizePTR = dwCodePTR+4
	dwCodeSize = *dwCodeSizePTR
	mempos = dwCodePTR - bnkptr
	if (dwCode = DBOBLOCK_ROOT_FRAME and mempos=24) 
		RootSize = dwCodeSize
		retbool = 1	
	endif

endfunction retbool

` stripped down to bare minimum for this example
function GetAllFrames()
	dwCode AS DWORD
	dwCodeSize AS DWORD
	pDataPTR AS DWORD
	
	dwCode = 0
	dwCodeSize = 0
	
	dwCode = *dwCodePTR 		
	dwCodeSizePTR = dwCodePTR+4
	dwCodeSize = *dwCodeSizePTR
	
	mempos = dwCodePTR - bnkptr
	startPTR = bnkptr

	for dwAddr = startPTR to startPTR+bnksize	

		dwCode = *dwAddr 		
		dwCodeSizePTR = dwAddr+4
		dwCodeSize = *dwCodeSizePTR
		mempos = dwAddr - bnkptr
		
		select dwCode
		case DBOBLOCK_FRAME_NAME :
			pDataPTR = dwAddr+8
			pData = *pDataPTR
			if dwCodeSize = pData + 4 and pData <=BYTEMAX
				value$=""
				inc frameCount
				array insert at bottom(frames())
				frames().id = frameCount
				frames().ismesh=0
			endif 
		endcase

		case DBOBLOCK_FRAME_MESH
			pDataPTR = dwAddr+8
			pData = *pDataPTR
			checkvalidPTR = dwAddr+12
			checkvalidData = *checkvalidPTR
			if pData = DBOBLOCK_MESH_FVF and checkvalidData = 4
				dwCodePTR = dwAddr
				inc meshCount
				frames().ismesh=1
				GetFrameMeshData(dwCodeSize)
			endif 
		endcase
		
		endselect
	next dwAddr
endfunction 

DBOFRAMEMESH:

function GetFrameMeshData(meshblocksize)
	dwCode AS DWORD
	dwCodeSize AS DWORD
	pDataPTR AS DWORD
	
	dwCode = 0
	dwCodeSize = 0
		mempos = dwCodePTR - bnkptr
		startPTR = dwCodePTR
		for dwAddr = startPTR to startPTR+meshblocksize
			dwCode = *dwAddr 		
			dwCodeSizePTR = dwAddr+4
			dwCodeSize = *dwCodeSizePTR
			pData = -1
			value$=""
		
			select dwCode
		
			case DBOBLOCK_MESH_FVF :
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				if dwCodeSize = 4
					fvf=pData
					array insert at bottom mesh()
					mesh().id = meshCount
				endif 
			endcase

			case DBOBLOCK_MESH_USEMATERIAL :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if dwCodeSize = 1 or dwCodeSize = 0 
					mesh().usematerial = dwCodeSize
				endif 
			endcase 
			
			case DBOBLOCK_MESH_MATERIAL :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if dwCodeSize = 68 and mesh().usematerial=1
					array insert at bottom meshmatptr()
					meshmatptr().id=meshCount
					meshmatptr().ptr=pDataPTR
					meshmatptr().size=dwCodeSize
				endif 
			endcase 

			case DBOBLOCK_MESH_USEMULTIMAT :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if dwCodeSize = 1 or dwCodeSize = 0 
				endif 
			endcase 

			case DBOBLOCK_MESH_MULTIMATCOUNT :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if dwCodeSize = 4 
					mesh().multimatcount=pData
				endif 
			endcase 

			case DBOBLOCK_MESH_MULTIMAT :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if pData = DBOBLOCK_MULTIMAT_NAME 
					dwCodePTR = dwAddr			
					GetMeshMaterialsData(dwCodeSize)
				endif 
			endcase 

			endselect

		next dwAddr

endfunction 

function GetMeshMaterialsData(materialsblocksize)
	dwCode AS DWORD
	dwCodeSize AS DWORD
	pDataPTR AS DWORD
	
	dwCode = 0
	dwCodeSize = 0
		startPTR = dwCodePTR
		for dwAddr = startPTR to startPTR+materialsblocksize
			dwCode = *dwAddr 		
			dwCodeSizePTR = dwAddr+4
			dwCodeSize = *dwCodeSizePTR
			pData = -1
			value$=""
		
			select dwCode

			case DBOBLOCK_MULTIMAT_NAME :
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				if dwCodeSize = pData + 4 and pData <=255
					value$=""
					if pData > 0
						value$=peek string(dwAddr+12,pData)
					else
						value$=""
					endif
					inc materialCount 
					array insert at bottom(meshmultimaterials())
					meshmultimaterials().id = meshCount
					meshmultimaterials().mmatid=materialCount
					`meshmultimaterials().name = value$
				endif 
			endcase

			case DBOBLOCK_MULTIMAT_MATERIAL :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if dwCodeSize = 68
					array insert at bottom meshmultimatptr()
					meshmultimatptr().id=meshCount
					meshmultimatptr().subid=materialCount // link this with meshmultimaterials().mmatid - generic name used i.e. subid
					meshmultimatptr().ptr=pDataPTR
					meshmultimatptr().size=dwCodeSize
				endif 
			endcase 
			endselect

		next dwAddr
endfunction 

function GetMeshRGBA(meshid)
	msh = array count(mesh()) // mesh
	mshmat = array count(meshmatptr()) // mesh ptr to material data
	mshmmat = array count(meshmultimaterials()) // mesh ptr to multimaterial data

	// loop through each mesh
	if msh =-1 then exitfunction -1
	for m=0 to msh
	if mshmat > -1 
		for mm= 0 to mshmat
			if mesh(m).id = meshmatptr(mm).id and mesh(m).id=meshid
				tptr=meshmatptr(mm).ptr
				tsize=meshmatptr(mm).size
				idx=-1
				for i = 0 to tsize-4 step 4
					inc idx
					valuef#=peek float(tptr+i)
					`note DBO stores RGBA as BGRA
					if idx = 0 then mmcolB#=valuef# // Blue
					if idx = 1 then mmcolG#=valuef# // Green
					if idx = 2 then mmcolR#=valuef# // Red
					if idx = 3 then mmcolA#=valuef# // Alpha
				next i
							
				b1 as byte
				b2 as byte
				b3 as byte
				b4 as byte

				`note DBO stores RGBA as BGRA
				b1=mmcolR#*255.0 // Blue
				b2=mmcolG#*255.0 // Green
				b3=mmcolB#*255.0 // Red
				b4=mmcolA#*255.0 // Alpha
											
				col as dword
				col = mkdword(b1,b2,b3,b4,0) 
			endif
		next mm
	endif
	
	if mshmmat > -1 		
		for mt=0 to mshmmat
			if mesh(m).id = meshmultimaterials(mt).id
				for mm= 0 to mshmmat
					if mesh(m).id = meshmultimatptr(mm).id and meshmultimatptr(mm).subid=meshmultimaterials(mt).id and mesh(m).id=meshid
						tptr=meshmultimatptr(mm).ptr
						tsize=meshmultimatptr(mm).size
						idx=-1
						for i = 0 to tsize-4 step 4
							inc idx
							valuef#=peek float(tptr+i)
							`note DBO stores RGBA as BGRA
							if idx = 0 then mmcolB#=valuef# // Blue
							if idx = 1 then mmcolG#=valuef# // Green
							if idx = 2 then mmcolR#=valuef# // Red
							if idx = 3 then mmcolA#=valuef# // Alpha
						next i
						b1 as byte
						b2 as byte
						b3 as byte
						b4 as byte
			
						`note DBO stores RGBA as BGRA
						b1=mmcolR#*255.0 // Blue
						b2=mmcolG#*255.0 // Green
						b3=mmcolB#*255.0 // Red
						b4=mmcolA#*255.0 // Alpha
														
						col as dword
						col = mkdword(b1,b2,b3,b4,0) 
					endif
				next mm
			endif
		next mt
	endif
	
	mesh(m).diffusecol=col
	next m
endfunction col

function SetMeshRGBA(meshid,RGBAval as dword)
	msh = array count(mesh()) // mesh
	mshmat = array count(meshmatptr()) // mesh ptr to material data
	mshmmat = array count(meshmultimaterials()) // mesh ptr to multimaterial data

	// loop through each mesh
	if msh =-1 then exitfunction 
	for m=0 to msh
	if mshmat > -1 
		for mm= 0 to mshmat
			if mesh(m).id = meshmatptr(mm).id and mesh(m).id=meshid
				tptr=meshmatptr(mm).ptr
				tsize=meshmatptr(mm).size
				idx=-1
				for i = 0 to tsize-4 step 4
					inc idx
					`note DBO stores RGBA as BGRA
					
					if idx = 0
						valuebf#=rgbb(RGBAval)/255.0 
						poke float tptr,valuebf#  // Blue
					endif
					
					if idx = 1 
						valuegf#=rgbg(RGBAval)/255.0 
						poke float tptr+4,valuegf# // Green
					endif
					
					if idx = 2 
						valuerf#=rgbr(RGBAval)/255.0 
						poke float tptr+8,valuerf# // Red
					endif
					
					if idx = 3 
						valueaf#=rgba(RGBAval)/255.0 
						poke float tptr+12,valueaf# // Alpha
					endif
				next i
			endif
		next mm
	endif
	
	if mshmmat > -1 		
		for mt=0 to mshmmat
			if mesh(m).id = meshmultimaterials(mt).id
				for mm= 0 to mshmmat
					if mesh(m).id = meshmultimatptr(mm).id and meshmultimatptr(mm).subid=meshmultimaterials(mt).id and mesh(m).id=meshid
						tptr=meshmultimatptr(mm).ptr
						tsize=meshmultimatptr(mm).size
						idx=-1
						for i = 0 to tsize-4 step 4
							inc idx
							`note DBO stores RGBA as BGRA
							if idx = 0
								valuebf#=rgbb(RGBAval)/255.0 
								poke float tptr,valuebf#  // Blue
							endif
							
							if idx = 1 
								valuegf#=rgbg(RGBAval)/255.0 
								poke float tptr+4,valuegf# // Green
							endif
							
							if idx = 2 
								valuerf#=rgbr(RGBAval)/255.0 
								poke float tptr+8,valuerf# // Red
							endif
							
							if idx = 3 
								valueaf#=rgba(RGBAval)/255.0 
								poke float tptr+12,valueaf# // Alpha
							endif
						next i
					endif
				next mm
			endif
		next mt
	endif
	
	`mesh(m).diffusecol=col
	next m
endfunction 



INIT_CONSTANTS:
#constant appver "return mesh color example 0.1"
#constant BYTEMAX 							256
#constant DBOBLOCK_ROOT_FRAME 				1			// rule = Must = 101 (DBOBLOCK_FRAME_NAME) 
#constant DBOBLOCK_FRAME_NAME 				101			// Rule 1 - Names must be dwCodeSize = pBlock + 4
#constant DBOBLOCK_FRAME_MESH 				103			// Rule x - pBlock must be = 111 (DBOBLOCK_MESH_FVF)
#constant DBOBLOCK_MESH_FVF 				111			// Rule 2 - Size must be = DWORD (4)
#constant DBOBLOCK_MESH_FVFSIZE 			112			// Rule 2 - Size must be = DWORD (4)
#constant DBOBLOCK_MESH_USEMATERIAL 		125			// Rule 5 - Size must be = 0 or 1 (boolean flag =1 Yes 0 =No)
#constant DBOBLOCK_MESH_MATERIAL 			126			// Rule 6 - Size must be = 68 e.g. 4x4float + 1 float
#constant DBOBLOCK_MESH_USEMULTIMAT 		123			// Rule 5 - Size must be = 0 or 1 (boolean flag =1 Yes 0 =No)
#constant DBOBLOCK_MESH_MULTIMATCOUNT 		124			// Rule 2 - Size must be = DWORD (4) - docs say size should be 1 --incorrect??
#constant DBOBLOCK_MESH_MULTIMAT 			139			// Docs point to Multi MAts - 128 so code will either be 161 (Name) or something else????
#constant DBOBLOCK_MULTIMAT_NAME 			161			// Rule 1 - Names must be dwCodeSize = pBlock + 4
#constant DBOBLOCK_MULTIMAT_MATERIAL 		162			// Size must be 68 --Contains a reference to a mesh material.??

` END CONSTANTS
return

INIT_TYPES:
// DBO structure related types
type frametype
	id as integer // frame id - parent ID
	ismesh as boolean
endtype

// for mesh, actual data will be stored in separate arrays for multiple values 
// but mesh id will be stored as a linking value
type meshtype
	frameid as integer // frame id - link
	id as integer // mesh id
	fvf as integer
	fvfsize as integer
	usematerial as boolean
	multimatcount as integer
	diffusecol as dword
endtype

type meshptrtype
	id as integer // mesh id
	subid as integer // sub object id e.g. multimaterials ID
	ptr as dword  // pointer start of vertex data
	size as dword // size of vertex data 
endtype

type meshmaterialstype
	id as integer     // mesh id
	mmatid as integer // multimaterial id	
endtype
return

` END STRUCTURES

INIT_GLOBALS:
global RootSize AS DWORD
global dwCodePTR AS DWORD
global bnkptr AS DWORD
global bnksize AS DWORD
global frameCount
frameCount=-1 // this will force the DBO root frame to start at 0 and not 1
global meshCount
global materialCount

return

` END GLOBALS

Rem Project: Return_Mesh_ColorRGB_v0.3
Rem Created: Mondday, November 1, 2021
Rem BOTR 2021
Rem Stripped down version of DBOFastReader 0.47
Rem which converts DBO to .X/OBJ (animated and static objects)
Rem This code Get / Sets Object mesh / multiple mesh color (diffuse)
Rem Requires IanM Matrix1Utils plugin-thanks IanM
Rem ***** Main Source File *****
sync on : sync rate 30 : sync
`constants
gosub INIT_CONSTANTS
`type
gosub INIT_TYPES
`globals
gosub INIT_GLOBALS

`easy user dbo selection
src$=opendialog("Select a DBO file?","DBO format|*.dbo|DirectX format|*.x",0,"")

if src$ ="" then end

`retain just the filename text without extension
shortfilename$=GetFileShort$(src$)

`if file selected was a direct x file, load and convert to .dbo then delete object
srcext$=extract fileext$(src$)
if upper$(srcext$)=".X" 
	load object src$,1
	outdbo$=shortfilename$+".dbo"
	deletefile(outdbo$)
	save object outdbo$,1
	delete object 1
	src$=outdbo$
endif

`validate DBO file to see if genuine or fake DBO
dwLength AS DWORD
pszString as STRING 
dwVersion AS DWORD 
dwReserved1 AS DWORD 
dwReserved2 AS DWORD 

dwCode AS DWORD
dwCodeSize AS DWORD
pBuffer as BYTE
pData as BYTE
pData = -1 // not sure to use 0 as it's a value and I can't use NULL as DBPro don't understand NULL

if file exist(src$) <> 1 then end

`temp load object to check fvf size - needs to be at 338 - if 274 or less convert model to fvf 338
objid=reserve free object()
load object src$,objid

perform checklist for object limbs objid
limbs=checklist quantity()
fvf=0
for l=0 to limbs-1
	if get limb fvf(1,l)>fvf then fvf=get limb fvf(objid,l)
next l
if fvf <=274 
	convert object fvf objid,338
	`dummy in a temp image for texturing each limb mesh
	`this force in the materials for each mesh 
	`but we need to save the new object and read in again with new fvf 
	box 0,0,1,1,rgb(255,0,0),rgb(255,0,0),rgb(255,0,0),rgb(255,0,0)
	get image 1,0,0,1,1
	im=1
	for l=0 to limbs-1
		if get limb fvf(1,l)>0 then texture limb 1,l,im
	next l

	srcpath$=extract filepath$(src$)
	`srcfile$=extract filename$(src$)
	
	rename file src$,srcpath$+shortfilename$+"_274_orig.dbo"
	outdbo$=srcpath$+shortfilename$+"_338_mod.dbo"
	deletefile(outdbo$)
	save object outdbo$,objid
	delete object objid
	delete image 1
	src$=outdbo$
endif

bnkid = reserve free bank()
make bank from file bnkid,src$
bnkptr = get bank ptr(bnkid)
bnksize = get bank size(bnkid)
make object from pointer objid,bnkptr
// dbo header
dwCodePTR = bnkptr+0
dwLength = *dwCodePTR
inc dwCodePTR , 4 
pszString = peek string(dwCodePTR,dwLength) 
if pszString <> "MAGICDBO"
	warningmessage "is not a genuine DBO file!"
	DeleteReleaseBank(bnkid)
	end
else
`message "This is a genuine DBO file!"
endif
inc dwCodePTR , dwLength
dwVersion = *dwCodePTR
inc dwCodePTR , 4
dwReserved1 = *dwCodePTR
inc dwCodePTR , 4
dwReserved2 = *dwCodePTR
inc dwCodePTR , 4

isRoot as boolean
isRoot = GetRootFrame()
if isRoot =0
	warningmessage "No root frame found in DBO, exiting!"
	DeleteReleaseBank(bnkid)
	end
endif

// initialise DBO structure arrays
dim frames() as frametype // frames
dim mesh() as meshtype // mesh
dim meshmatptr() as meshptrtype // mesh ptr to material data
dim meshmultimaterials() as meshmaterialstype //mesh multimaterials
dim meshmultimatptr() as meshptrtype // ptr to mesh multimaterial data

// Read in DBO data , Frame, Mesh, Bone etc
// stripped down for this example
GetAllFrames()

meshcol as dword
print "Number of frames: ";array count(frames())+1 // frames
print "Number of meshes: ";array count(mesh())+1 // mesh
print "meshmatptr: ";array count(meshmatptr())+1  // mesh ptr to material data
print "meshmulimaterials: ";array count(meshmultimaterials())+1  //mesh multimaterials
print "meshmultimatptr: ";array count(meshmultimatptr())+1  // ptr to mesh multimaterial data
for m = 0 to array count(mesh())
	meshcol=GetMeshRGBA(mesh(m).id)
	print "diffuse color for mesh "+str$(mesh(m).id)+" : "+str$(meshcol)
	print "r: "+str$(rgbr(meshcol))+" g: "+str$(rgbg(meshcol))+" b: "+str$(rgbb(meshcol))+" a: "+str$(rgba(meshcol))
next m

`Set Object Diffuse 1,rgb(0,0,0),0
`DeleteFile(shortfilename$+"_setdiffuse.dbo")
`save object shortfilename$+"_setdiffuse.dbo",1
` change each mesh (assuming there are 3 here-update to suit) to a different color

RGBAval1 as dword
RGBAval2 as dword
RGBAval3 as dword
RGBAval4 as dword
RGBAval1=rgb(rnd(255),rnd(255),rnd(255))
RGBAval2=rgb(rnd(255),rnd(255),rnd(255))
RGBAval3=rgb(rnd(255),rnd(255),rnd(255))
RGBAval4=rgb(rnd(255),rnd(255),rnd(255))
for m = 0 to array count(mesh())
	if mesh(m).id=1 then SetMeshRGBA(mesh(m).id,RGBAval1)
	if mesh(m).id=2 then SetMeshRGBA(mesh(m).id,RGBAval2)
	if mesh(m).id=3 then SetMeshRGBA(mesh(m).id,RGBAval3)
	if mesh(m).id=4 then SetMeshRGBA(mesh(m).id,RGBAval4)
next m

`create a 2nd object using modified material info and save out to file 
make object from pointer 2,bnkptr
outdbo$=shortfilename$+"_modified_diffuse.dbo"
DeleteFile(outdbo$)
save object shortfilename$+"_modified_diffuse.dbo",2

`display the modified content
print
for m = 0 to array count(mesh())
	meshcol=GetMeshRGBA(mesh(m).id)
	print "Modified object mesh colours:"
	print "diffuse color for mesh "+str$(mesh(m).id)+" : "+str$(meshcol)
	print "r: "+str$(rgbr(meshcol))+" g: "+str$(rgbg(meshcol))+" b: "+str$(rgbb(meshcol))+" a: "+str$(rgba(meshcol))
next m

sync
wait key

` cleanup
release reserved object objid
delete object objid
release reserved bank bnkid
delete bank bnkid
end

function DeleteFile(f$)
	if file exist(f$)=1 then delete file f$
endfunction

function GetFileShort$(src$) 
	longfilename$=src$
	shortfilename$=extract filename$(longfilename$)
	shortfilenameext$=extract fileext$(longfilename$)
	shortfilenameextlen  = fast len (shortfilenameext$)
	shortfilename$ = fast left$(shortfilename$,fast len (shortfilename$)-shortfilenameextlen) 
endfunction shortfilename$

// uses relative string end position based on number of chars to copy from start position e.g. spos = 8 , charnum = 8
// i.e. it calculates the string end position based on start position and the number of chars to copy
function Substr(s$, spos, chars)
   l = len(s$)
   epos = spos + chars-1 // end position equals the start char position plus number of chars minus 1
   for c = 1 to l
	 if c=spos
	 	r$=mid$(s$,c)
	 else
	 	 if c>spos and c<=epos 
			r$=r$+mid$(s$,c)
		 endif
	 endif
   next c
endfunction r$

function bin2dec(src$)
	if len(src$) <=0 or len(src$)>8 then exitfunction 0
	dim binary$(7)
	for i=len(src$) to 1 step -1
    	binary$(len(src$)-i)=mid$(src$,i)
    	bn$=bn$+mid$(src$,i,1)
	next i
	decval=0
	
	for b=0 to 7
    	if binary$(b)="1"
        	inc decval,2^b
    	endif      
	next b
	undim binary$()
endfunction decval

function mkdword(byte1,byte2,byte3,byte4,msb)
    if msb <0 or msb>1 then exitfunction
    if msb=0
    	dw = (byte1) || (byte2 << 8) || (byte3 << 16) || (byte4 << 24)
    else
    	if msb=1
    		dw = (byte4) || (byte3 << 8) || (byte2 << 16) || (byte1 << 24)
		endif
	endif
endfunction dw

function DeleteReleaseBank(id)
	if bank exist(id) 
		delete bank id
		release reserved bank id
	endif
endfunction

function GetRootFrame()
	retbool as boolean 
	retbool = 0	
	dwCode AS DWORD
	dwCodeSize AS DWORD
	
	dwCode = 0
	dwCodeSize = 0
	
	dwCode = *dwCodePTR 		
	dwCodeSizePTR = dwCodePTR+4
	dwCodeSize = *dwCodeSizePTR
	mempos = dwCodePTR - bnkptr
	if (dwCode = DBOBLOCK_ROOT_FRAME and mempos=24) 
		RootSize = dwCodeSize
		retbool = 1	
	endif

endfunction retbool

` stripped down to bare minimum for this example
function GetAllFrames()
	dwCode AS DWORD
	dwCodeSize AS DWORD
	pDataPTR AS DWORD
	
	dwCode = 0
	dwCodeSize = 0
	
	dwCode = *dwCodePTR 		
	dwCodeSizePTR = dwCodePTR+4
	dwCodeSize = *dwCodeSizePTR
	
	mempos = dwCodePTR - bnkptr
	startPTR = bnkptr

	for dwAddr = startPTR to startPTR+bnksize	

		dwCode = *dwAddr 		
		dwCodeSizePTR = dwAddr+4
		dwCodeSize = *dwCodeSizePTR
		mempos = dwAddr - bnkptr
		
		select dwCode
		case DBOBLOCK_FRAME_NAME :
			pDataPTR = dwAddr+8
			pData = *pDataPTR
			if dwCodeSize = pData + 4 and pData <=BYTEMAX
				value$=""
				inc frameCount
				array insert at bottom(frames())
				frames().id = frameCount
				frames().ismesh=0
			endif 
		endcase

		case DBOBLOCK_FRAME_MESH
			pDataPTR = dwAddr+8
			pData = *pDataPTR
			checkvalidPTR = dwAddr+12
			checkvalidData = *checkvalidPTR
			if pData = DBOBLOCK_MESH_FVF and checkvalidData = 4
				dwCodePTR = dwAddr
				inc meshCount
				frames().ismesh=1
				GetFrameMeshData(dwCodeSize)
			endif 
		endcase
		
		endselect
	next dwAddr
endfunction 

DBOFRAMEMESH:

function GetFrameMeshData(meshblocksize)
	dwCode AS DWORD
	dwCodeSize AS DWORD
	pDataPTR AS DWORD
	
	dwCode = 0
	dwCodeSize = 0
		mempos = dwCodePTR - bnkptr
		startPTR = dwCodePTR
		for dwAddr = startPTR to startPTR+meshblocksize
			dwCode = *dwAddr 		
			dwCodeSizePTR = dwAddr+4
			dwCodeSize = *dwCodeSizePTR
			pData = -1
			value$=""
		
			select dwCode

			case DBOBLOCK_MESH_FVF :
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				if dwCodeSize = 4
					fvf=pData
					`targetfvf=FVF_XYZ || FVF_NORMAL || FVF_DIFFUSE || FVF_TEX1  
					`message "fvf: "+str$(fvf)+chr$(13)+bin$(fvf)+chr$(13)+str$(targetfvf)
					array insert at bottom mesh()
					mesh().id = meshCount
				endif 
			endcase

			case DBOBLOCK_MESH_USEMATERIAL :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if dwCodeSize = 1 or dwCodeSize = 0 
					mesh().usematerial = dwCodeSize
				endif 
			endcase 
			
			case DBOBLOCK_MESH_MATERIAL :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if dwCodeSize = 68 and mesh().usematerial=1
					array insert at bottom meshmatptr()
					meshmatptr().id=meshCount
					meshmatptr().ptr=pDataPTR
					meshmatptr().size=dwCodeSize
				endif 
			endcase 

			case DBOBLOCK_MESH_USEMULTIMAT :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if dwCodeSize = 1 or dwCodeSize = 0 
				endif 
			endcase 

			case DBOBLOCK_MESH_MULTIMATCOUNT :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if dwCodeSize = 4 
					mesh().multimatcount=pData
				endif 
			endcase 

			case DBOBLOCK_MESH_MULTIMAT :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if pData = DBOBLOCK_MULTIMAT_NAME 
					dwCodePTR = dwAddr			
					GetMeshMaterialsData(dwCodeSize)
				endif 
			endcase 

			endselect

		next dwAddr

endfunction 

function GetMeshMaterialsData(materialsblocksize)
	dwCode AS DWORD
	dwCodeSize AS DWORD
	pDataPTR AS DWORD
	
	dwCode = 0
	dwCodeSize = 0
		startPTR = dwCodePTR
		for dwAddr = startPTR to startPTR+materialsblocksize
			dwCode = *dwAddr 		
			dwCodeSizePTR = dwAddr+4
			dwCodeSize = *dwCodeSizePTR
			pData = -1
			value$=""
		
			select dwCode

			case DBOBLOCK_MULTIMAT_NAME :
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				if dwCodeSize = pData + 4 and pData <=255
					value$=""
					if pData > 0
						value$=peek string(dwAddr+12,pData)
					else
						value$=""
					endif
					inc materialCount 
					array insert at bottom(meshmultimaterials())
					meshmultimaterials().id = meshCount
					meshmultimaterials().mmatid=materialCount
					`meshmultimaterials().name = value$
				endif 
			endcase

			case DBOBLOCK_MULTIMAT_MATERIAL :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if dwCodeSize = 68
					array insert at bottom meshmultimatptr()
					meshmultimatptr().id=meshCount
					meshmultimatptr().subid=materialCount // link this with meshmultimaterials().mmatid - generic name used i.e. subid
					meshmultimatptr().ptr=pDataPTR
					meshmultimatptr().size=dwCodeSize
				endif 
			endcase 
			endselect

		next dwAddr
endfunction 

function GetMeshRGBA(meshid)
	msh = array count(mesh()) // mesh
	mshmat = array count(meshmatptr()) // mesh ptr to material data
	mshmmat = array count(meshmultimaterials()) // mesh ptr to multimaterial data

	// loop through each mesh
	if msh =-1 then exitfunction -1
	for m=0 to msh
	if mshmat > -1 
		for mm= 0 to mshmat
			if mesh(m).id = meshmatptr(mm).id and mesh(m).id=meshid
				tptr=meshmatptr(mm).ptr
				tsize=meshmatptr(mm).size
				idx=-1
				for i = 0 to tsize-4 step 4
					inc idx
					valuef#=peek float(tptr+i)
					`note DBO stores RGBA as BGRA
					if idx = 0 then mmcolB#=valuef# // Blue
					if idx = 1 then mmcolG#=valuef# // Green
					if idx = 2 then mmcolR#=valuef# // Red
					if idx = 3 then mmcolA#=valuef# // Alpha
				next i
							
				b1 as byte
				b2 as byte
				b3 as byte
				b4 as byte

				`note DBO stores RGBA as BGRA
				b1=mmcolR#*255.0 // Blue
				b2=mmcolG#*255.0 // Green
				b3=mmcolB#*255.0 // Red
				b4=mmcolA#*255.0 // Alpha
											
				col as dword
				col = mkdword(b1,b2,b3,b4,0) 
			endif
		next mm
	endif
	
	if mshmmat > -1 		
		for mt=0 to mshmmat
			if mesh(m).id = meshmultimaterials(mt).id
				for mm= 0 to mshmmat
					if mesh(m).id = meshmultimatptr(mm).id and meshmultimatptr(mm).subid=meshmultimaterials(mt).id and mesh(m).id=meshid
						tptr=meshmultimatptr(mm).ptr
						tsize=meshmultimatptr(mm).size
						idx=-1
						for i = 0 to tsize-4 step 4
							inc idx
							valuef#=peek float(tptr+i)
							`note DBO stores RGBA as BGRA
							if idx = 0 then mmcolB#=valuef# // Blue
							if idx = 1 then mmcolG#=valuef# // Green
							if idx = 2 then mmcolR#=valuef# // Red
							if idx = 3 then mmcolA#=valuef# // Alpha
						next i
						b1 as byte
						b2 as byte
						b3 as byte
						b4 as byte
			
						`note DBO stores RGBA as BGRA
						b1=mmcolR#*255.0 // Blue
						b2=mmcolG#*255.0 // Green
						b3=mmcolB#*255.0 // Red
						b4=mmcolA#*255.0 // Alpha
														
						col as dword
						col = mkdword(b1,b2,b3,b4,0) 
					endif
				next mm
			endif
		next mt
	endif
	
	mesh(m).diffusecol=col
	next m
endfunction col

function SetMeshRGBA(meshid,RGBAval as dword)
	msh = array count(mesh()) // mesh
	mshmat = array count(meshmatptr()) // mesh ptr to material data
	mshmmat = array count(meshmultimaterials()) // mesh ptr to multimaterial data

	// loop through each mesh
	if msh =-1 then exitfunction 
	for m=0 to msh
	if mshmat > -1 
		for mm= 0 to mshmat
			if mesh(m).id = meshmatptr(mm).id and mesh(m).id=meshid
				tptr=meshmatptr(mm).ptr
				tsize=meshmatptr(mm).size
				idx=-1
				for i = 0 to tsize-4 step 4
					inc idx
					`note DBO stores RGBA as BGRA
					
					if idx = 0
						valuebf#=rgbb(RGBAval)/255.0 
						poke float tptr,valuebf#  // Blue
					endif
					
					if idx = 1 
						valuegf#=rgbg(RGBAval)/255.0 
						poke float tptr+4,valuegf# // Green
					endif
					
					if idx = 2 
						valuerf#=rgbr(RGBAval)/255.0 
						poke float tptr+8,valuerf# // Red
					endif
					
					if idx = 3 
						valueaf#=rgba(RGBAval)/255.0 
						poke float tptr+12,valueaf# // Alpha
					endif
					
					`if idx = 4 then mmcol1#=valuef# // Col 1
					`if idx = 5 then mmcol2#=valuef# // Col 2
					`if idx = 6 then mmcol3#=valuef# // Col 3
					`if idx = 7 then mmcol4#=valuef# // Col 4
					`if idx = 8 then mmspec1#=valuef#  // Spec 1
					`if idx = 9 then mmspec2#=valuef#  // Spec 2
					`if idx = 10 then mmspec3#=valuef# // Spec 3
					`if idx = 11 then mmspec4#=valuef# // Spec 4
					`if idx = 12 then mmemm1#=valuef#  // Emmisive 1
					`if idx = 13 then mmemm2#=valuef#  // Emmisive 2
					`if idx = 14 then mmemm3#=valuef#  // Emmisive 3
					`if idx = 15 then mmemm4#=valuef#  // Emmisive 4

					if idx = 16
						valuepf#=0.000000 
						poke float tptr+64,valuepf# // Power
					endif

				next i
			endif
		next mm
	endif
	
	if mshmmat > -1 		
		for mt=0 to mshmmat
			if mesh(m).id = meshmultimaterials(mt).id
				for mm= 0 to mshmmat
					if mesh(m).id = meshmultimatptr(mm).id and meshmultimatptr(mm).subid=meshmultimaterials(mt).id and mesh(m).id=meshid
						tptr=meshmultimatptr(mm).ptr
						tsize=meshmultimatptr(mm).size
						idx=-1
						for i = 0 to tsize-4 step 4
							inc idx
							`note DBO stores RGBA as BGRA
							if idx = 0
								valuebf#=rgbb(RGBAval)/255.0 
								poke float tptr,valuebf#  // Blue
							endif
							
							if idx = 1 
								valuegf#=rgbg(RGBAval)/255.0 
								poke float tptr+4,valuegf# // Green
							endif
							
							if idx = 2 
								valuerf#=rgbr(RGBAval)/255.0 
								poke float tptr+8,valuerf# // Red
							endif
							
							if idx = 3 
								valueaf#=rgba(RGBAval)/255.0 
								poke float tptr+12,valueaf# // Alpha
							endif

							if idx = 16
								valuepf#=0.000000 
								poke float tptr+64,valuepf# // Power
							endif

						next i
					endif
				next mm
			endif
		next mt
	endif
	
	`mesh(m).diffusecol=col
	next m
endfunction 

INIT_CONSTANTS:
#constant appver "return mesh color example 0.1"
#constant BYTEMAX 							256
#constant DBOBLOCK_ROOT_FRAME 				1			// rule = Must = 101 (DBOBLOCK_FRAME_NAME) 
#constant DBOBLOCK_FRAME_NAME 				101			// Rule 1 - Names must be dwCodeSize = pBlock + 4
#constant DBOBLOCK_FRAME_MESH 				103			// Rule x - pBlock must be = 111 (DBOBLOCK_MESH_FVF)
#constant DBOBLOCK_MESH_FVF 				111			// Rule 2 - Size must be = DWORD (4)
#constant DBOBLOCK_MESH_FVFSIZE 			112			// Rule 2 - Size must be = DWORD (4)
#constant DBOBLOCK_MESH_USEMATERIAL 		125			// Rule 5 - Size must be = 0 or 1 (boolean flag =1 Yes 0 =No)
#constant DBOBLOCK_MESH_MATERIAL 			126			// Rule 6 - Size must be = 68 e.g. 4x4float + 1 float
#constant DBOBLOCK_MESH_USEMULTIMAT 		123			// Rule 5 - Size must be = 0 or 1 (boolean flag =1 Yes 0 =No)
#constant DBOBLOCK_MESH_MULTIMATCOUNT 		124			// Rule 2 - Size must be = DWORD (4) - docs say size should be 1 --incorrect??
#constant DBOBLOCK_MESH_MULTIMAT 			139			// Docs point to Multi MAts - 128 so code will either be 161 (Name) or something else????
#constant DBOBLOCK_MULTIMAT_NAME 			161			// Rule 1 - Names must be dwCodeSize = pBlock + 4
#constant DBOBLOCK_MULTIMAT_MATERIAL 		162			// Size must be 68 --Contains a reference to a mesh material.??

#constant FVF_XYZ      	0x002 			// float X, Y, Z positions        - bit 1
#constant FVF_XYZRHW   	0x004 			// float X, Y, Z transformed      - bit 2
#constant FVF_NORMAL   	0x010 			// float X, Y, Z normal vector    - bit 3
#constant FVF_PSIZE    	0x020 			// float point size for sprites   - bit 4
#constant FVF_DIFFUSE  	0x040 			// DWORD diffuse colour           - bit 5
#constant FVF_SPECULAR 	0x080 			// DWORD specular colour          - bit 6
#constant FVF_TEX0 		0x000 			// texture coordinates 0		  - bit 7
#constant FVF_TEX1 		0x100 			// texture coordinates 1		  - bit 8
#constant FVF_TEX2 		0x200 			// texture coordinates 2		  - bit 9
#constant FVF_TEX3 		0x300 			// texture coordinates 3		  - bit 10
#constant FVF_TEX4 		0x400 			// texture coordinates 4		  - bit 11
#constant FVF_TEX5 		0x500 			// texture coordinates 5		  - bit 12
#constant FVF_TEX6 		0x600 			// texture coordinates 6		  - bit 13
#constant FVF_TEX7 		0x700 			// texture coordinates 7		  - bit 14
#constant FVF_TEX8 		0x800 			// texture coordinates 8		  - bit 15


` END CONSTANTS
return

INIT_TYPES:
// DBO structure related types
type frametype
	id as integer // frame id - parent ID
	ismesh as boolean
endtype

// for mesh, actual data will be stored in separate arrays for multiple values 
// but mesh id will be stored as a linking value
type meshtype
	frameid as integer // frame id - link
	id as integer // mesh id
	fvf as integer
	fvfsize as integer
	usematerial as boolean
	multimatcount as integer
	diffusecol as dword
endtype

type meshptrtype
	id as integer // mesh id
	subid as integer // sub object id e.g. multimaterials ID
	ptr as dword  // pointer start of vertex data
	size as dword // size of vertex data 
endtype

type meshmaterialstype
	id as integer     // mesh id
	mmatid as integer // multimaterial id	
endtype
return

` END STRUCTURES

INIT_GLOBALS:
global RootSize AS DWORD
global dwCodePTR AS DWORD
global bnkptr AS DWORD
global bnksize AS DWORD
global frameCount
frameCount=-1 // this will force the DBO root frame to start at 0 and not 1
global meshCount
global materialCount

return

` END GLOBALS

Rem Project: Return_Mesh_ColorRGB_v0.3
Rem Created: Mondday, November 1, 2021
Rem BOTR 2021
Rem Stripped down version of DBOFastReader 0.47
Rem which converts DBO to .X/OBJ (animated and static objects)
Rem This code Get / Sets Object mesh / multiple mesh color (diffuse)
Rem Requires IanM Matrix1Utils plugin-thanks IanM
Rem ***** Main Source File *****
sync on : sync rate 30 : sync
`constants
gosub INIT_CONSTANTS
`type
gosub INIT_TYPES
`globals
gosub INIT_GLOBALS

`easy user dbo selection
src$=opendialog("Select a DBO file?","DBO format|*.dbo|DirectX format|*.x",0,"")

if src$ ="" then end

`retain just the filename text without extension
shortfilename$=GetFileShort$(src$)

`if file selected was a direct x file, load and convert to .dbo then delete object
srcext$=extract fileext$(src$)
if upper$(srcext$)=".X" 
	load object src$,1
	outdbo$=shortfilename$+".dbo"
	deletefile(outdbo$)
	save object outdbo$,1
	delete object 1
	src$=outdbo$
endif

`validate DBO file to see if genuine or fake DBO
dwLength AS DWORD
pszString as STRING 
dwVersion AS DWORD 
dwReserved1 AS DWORD 
dwReserved2 AS DWORD 

dwCode AS DWORD
dwCodeSize AS DWORD
pBuffer as BYTE
pData as BYTE
pData = -1 // not sure to use 0 as it's a value and I can't use NULL as DBPro don't understand NULL

if file exist(src$) <> 1 then end

`temp load object to check fvf size - needs to be at 338 - if 274 or less convert model to fvf 338
objid=reserve free object()
load object src$,objid

perform checklist for object limbs objid
limbs=checklist quantity()
fvf=0
for l=0 to limbs-1
	if get limb fvf(1,l)>fvf then fvf=get limb fvf(objid,l)
next l
if fvf <=274 
	convert object fvf objid,338
	`dummy in a temp image for texturing each limb mesh
	`this force in the materials for each mesh 
	`but we need to save the new object and read in again with new fvf 
	box 0,0,1,1,rgb(255,0,0),rgb(255,0,0),rgb(255,0,0),rgb(255,0,0)
	get image 1,0,0,1,1
	im=1
	for l=0 to limbs-1
		if get limb fvf(1,l)>0 then texture limb 1,l,im
	next l

	srcpath$=extract filepath$(src$)
	`srcfile$=extract filename$(src$)
	
	rename file src$,srcpath$+shortfilename$+"_274_orig.dbo"
	outdbo$=srcpath$+shortfilename$+"_338_mod.dbo"
	deletefile(outdbo$)
	save object outdbo$,objid
	delete object objid
	delete image 1
	src$=outdbo$
endif

if object exist(objid)=1 then delete object objid
bnkid = reserve free bank()
make bank from file bnkid,src$
bnkptr = get bank ptr(bnkid)
bnksize = get bank size(bnkid)
make object from pointer objid,bnkptr
// dbo header
dwCodePTR = bnkptr+0
dwLength = *dwCodePTR
inc dwCodePTR , 4 
pszString = peek string(dwCodePTR,dwLength) 
if pszString <> "MAGICDBO"
	warningmessage "is not a genuine DBO file!"
	DeleteReleaseBank(bnkid)
	end
else
`message "This is a genuine DBO file!"
endif
inc dwCodePTR , dwLength
dwVersion = *dwCodePTR
inc dwCodePTR , 4
dwReserved1 = *dwCodePTR
inc dwCodePTR , 4
dwReserved2 = *dwCodePTR
inc dwCodePTR , 4

isRoot as boolean
isRoot = GetRootFrame()
if isRoot =0
	warningmessage "No root frame found in DBO, exiting!"
	DeleteReleaseBank(bnkid)
	end
endif

// initialise DBO structure arrays
dim frames() as frametype // frames
dim mesh() as meshtype // mesh
dim meshmatptr() as meshptrtype // mesh ptr to material data
dim meshmultimaterials() as meshmaterialstype //mesh multimaterials
dim meshmultimatptr() as meshptrtype // ptr to mesh multimaterial data

// Read in DBO data , Frame, Mesh, Bone etc
// stripped down for this example
GetAllFrames()

meshcol as dword
print "Number of frames: ";array count(frames())+1 // frames
print "Number of meshes: ";array count(mesh())+1 // mesh
print "meshmatptr: ";array count(meshmatptr())+1  // mesh ptr to material data
print "meshmulimaterials: ";array count(meshmultimaterials())+1  //mesh multimaterials
print "meshmultimatptr: ";array count(meshmultimatptr())+1  // ptr to mesh multimaterial data
for m = 0 to array count(mesh())
	meshcol=GetMeshRGBA(mesh(m).id)
	print "diffuse color for mesh "+str$(mesh(m).id)+" : "+str$(meshcol)
	print "r: "+str$(rgbr(meshcol))+" g: "+str$(rgbg(meshcol))+" b: "+str$(rgbb(meshcol))+" a: "+str$(rgba(meshcol))
next m

`Set Object Diffuse 1,rgb(0,0,0),0
`DeleteFile(shortfilename$+"_setdiffuse.dbo")
`save object shortfilename$+"_setdiffuse.dbo",1
` change each mesh (assuming there are 3 here-update to suit) to a different color

RGBAv as dword
for m = 0 to array count(mesh())
	RGBAv=rgb(rnd(255),rnd(255),rnd(255))
	SetMeshRGBA(mesh(m).id,RGBAv)
next m

`create a 2nd object using modified material info and save out to file 
make object from pointer 2,bnkptr
outdbo$=shortfilename$+"_modified_diffuse.dbo"
DeleteFile(outdbo$)
save object shortfilename$+"_modified_diffuse.dbo",2

`display the modified content
print
for m = 0 to array count(mesh())
	meshcol=GetMeshRGBA(mesh(m).id)
	print "Modified object mesh colours:"
	print "diffuse color for mesh "+str$(mesh(m).id)+" : "+str$(meshcol)
	print "r: "+str$(rgbr(meshcol))+" g: "+str$(rgbg(meshcol))+" b: "+str$(rgbb(meshcol))+" a: "+str$(rgba(meshcol))
next m

sync
wait key

` cleanup
release reserved object objid
delete object objid
release reserved bank bnkid
delete bank bnkid
end

function DeleteFile(f$)
	if file exist(f$)=1 then delete file f$
endfunction

function GetFileShort$(src$) 
	longfilename$=src$
	shortfilename$=extract filename$(longfilename$)
	shortfilenameext$=extract fileext$(longfilename$)
	shortfilenameextlen  = fast len (shortfilenameext$)
	shortfilename$ = fast left$(shortfilename$,fast len (shortfilename$)-shortfilenameextlen) 
endfunction shortfilename$

// uses relative string end position based on number of chars to copy from start position e.g. spos = 8 , charnum = 8
// i.e. it calculates the string end position based on start position and the number of chars to copy
function Substr(s$, spos, chars)
   l = len(s$)
   epos = spos + chars-1 // end position equals the start char position plus number of chars minus 1
   for c = 1 to l
	 if c=spos
	 	r$=mid$(s$,c)
	 else
	 	 if c>spos and c<=epos 
			r$=r$+mid$(s$,c)
		 endif
	 endif
   next c
endfunction r$

function bin2dec(src$)
	if len(src$) <=0 or len(src$)>8 then exitfunction 0
	dim binary$(7)
	for i=len(src$) to 1 step -1
    	binary$(len(src$)-i)=mid$(src$,i)
    	bn$=bn$+mid$(src$,i,1)
	next i
	decval=0
	
	for b=0 to 7
    	if binary$(b)="1"
        	inc decval,2^b
    	endif      
	next b
	undim binary$()
endfunction decval

function mkdword(byte1,byte2,byte3,byte4,msb)
    if msb <0 or msb>1 then exitfunction
    if msb=0
    	dw = (byte1) || (byte2 << 8) || (byte3 << 16) || (byte4 << 24)
    else
    	if msb=1
    		dw = (byte4) || (byte3 << 8) || (byte2 << 16) || (byte1 << 24)
		endif
	endif
endfunction dw

function DeleteReleaseBank(id)
	if bank exist(id) 
		delete bank id
		release reserved bank id
	endif
endfunction

function GetRootFrame()
	retbool as boolean 
	retbool = 0	
	dwCode AS DWORD
	dwCodeSize AS DWORD
	
	dwCode = 0
	dwCodeSize = 0
	
	dwCode = *dwCodePTR 		
	dwCodeSizePTR = dwCodePTR+4
	dwCodeSize = *dwCodeSizePTR
	mempos = dwCodePTR - bnkptr
	if (dwCode = DBOBLOCK_ROOT_FRAME and mempos=24) 
		RootSize = dwCodeSize
		retbool = 1	
	endif

endfunction retbool

` stripped down to bare minimum for this example
function GetAllFrames()
	dwCode AS DWORD
	dwCodeSize AS DWORD
	pDataPTR AS DWORD
	
	dwCode = 0
	dwCodeSize = 0
	
	dwCode = *dwCodePTR 		
	dwCodeSizePTR = dwCodePTR+4
	dwCodeSize = *dwCodeSizePTR
	
	mempos = dwCodePTR - bnkptr
	startPTR = bnkptr

	for dwAddr = startPTR to startPTR+bnksize	

		dwCode = *dwAddr 		
		dwCodeSizePTR = dwAddr+4
		dwCodeSize = *dwCodeSizePTR
		mempos = dwAddr - bnkptr
		
		select dwCode
		case DBOBLOCK_FRAME_NAME :
			pDataPTR = dwAddr+8
			pData = *pDataPTR
			if dwCodeSize = pData + 4 and pData <=BYTEMAX
				value$=""
				inc frameCount
				array insert at bottom(frames())
				frames().id = frameCount
				frames().ismesh=0
			endif 
		endcase

		case DBOBLOCK_FRAME_MESH
			pDataPTR = dwAddr+8
			pData = *pDataPTR
			checkvalidPTR = dwAddr+12
			checkvalidData = *checkvalidPTR
			if pData = DBOBLOCK_MESH_FVF and checkvalidData = 4
				dwCodePTR = dwAddr
				inc meshCount
				frames().ismesh=1
				GetFrameMeshData(dwCodeSize)
			endif 
		endcase
		
		endselect
	next dwAddr
endfunction 

DBOFRAMEMESH:

function GetFrameMeshData(meshblocksize)
	dwCode AS DWORD
	dwCodeSize AS DWORD
	pDataPTR AS DWORD
	
	dwCode = 0
	dwCodeSize = 0
		mempos = dwCodePTR - bnkptr
		startPTR = dwCodePTR
		for dwAddr = startPTR to startPTR+meshblocksize
			dwCode = *dwAddr 		
			dwCodeSizePTR = dwAddr+4
			dwCodeSize = *dwCodeSizePTR
			pData = -1
			value$=""
		
			select dwCode

			case DBOBLOCK_MESH_FVF :
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				if dwCodeSize = 4
					fvf=pData
					`targetfvf=FVF_XYZ || FVF_NORMAL || FVF_DIFFUSE || FVF_TEX1  
					`message "fvf: "+str$(fvf)+chr$(13)+bin$(fvf)+chr$(13)+str$(targetfvf)
					array insert at bottom mesh()
					mesh().id = meshCount
				endif 
			endcase

			case DBOBLOCK_MESH_USEMATERIAL :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if dwCodeSize = 1 or dwCodeSize = 0 
					mesh().usematerial = dwCodeSize
				endif 
			endcase 
			
			case DBOBLOCK_MESH_MATERIAL :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if dwCodeSize = 68 and mesh().usematerial=1
					array insert at bottom meshmatptr()
					meshmatptr().id=meshCount
					meshmatptr().ptr=pDataPTR
					meshmatptr().size=dwCodeSize
				endif 
			endcase 

			case DBOBLOCK_MESH_USEMULTIMAT :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if dwCodeSize = 1 or dwCodeSize = 0 
				endif 
			endcase 

			case DBOBLOCK_MESH_MULTIMATCOUNT :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if dwCodeSize = 4 
					mesh().multimatcount=pData
				endif 
			endcase 

			case DBOBLOCK_MESH_MULTIMAT :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if pData = DBOBLOCK_MULTIMAT_NAME 
					dwCodePTR = dwAddr			
					GetMeshMaterialsData(dwCodeSize)
				endif 
			endcase 

			endselect

		next dwAddr

endfunction 

function GetMeshMaterialsData(materialsblocksize)
	dwCode AS DWORD
	dwCodeSize AS DWORD
	pDataPTR AS DWORD
	
	dwCode = 0
	dwCodeSize = 0
		startPTR = dwCodePTR
		for dwAddr = startPTR to startPTR+materialsblocksize
			dwCode = *dwAddr 		
			dwCodeSizePTR = dwAddr+4
			dwCodeSize = *dwCodeSizePTR
			pData = -1
			value$=""
		
			select dwCode

			case DBOBLOCK_MULTIMAT_NAME :
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				if dwCodeSize = pData + 4 and pData <=255
					value$=""
					if pData > 0
						value$=peek string(dwAddr+12,pData)
					else
						value$=""
					endif
					inc materialCount 
					array insert at bottom(meshmultimaterials())
					meshmultimaterials().id = meshCount
					meshmultimaterials().mmatid=materialCount
					`meshmultimaterials().name = value$
				endif 
			endcase

			case DBOBLOCK_MULTIMAT_MATERIAL :			
				pDataPTR = dwAddr+8
				pData = *pDataPTR
				
				if dwCodeSize = 68
					array insert at bottom meshmultimatptr()
					meshmultimatptr().id=meshCount
					meshmultimatptr().subid=materialCount // link this with meshmultimaterials().mmatid - generic name used i.e. subid
					meshmultimatptr().ptr=pDataPTR
					meshmultimatptr().size=dwCodeSize
				endif 
			endcase 
			endselect

		next dwAddr
endfunction 

function GetMeshRGBA(meshid)
	msh = array count(mesh()) // mesh
	mshmat = array count(meshmatptr()) // mesh ptr to material data
	mshmmat = array count(meshmultimaterials()) // mesh ptr to multimaterial data

	// loop through each mesh
	if msh =-1 then exitfunction -1
	for m=0 to msh
	if mshmat > -1 
		for mm= 0 to mshmat
			if mesh(m).id = meshmatptr(mm).id and mesh(m).id=meshid
				tptr=meshmatptr(mm).ptr
				tsize=meshmatptr(mm).size
				idx=-1
				for i = 0 to tsize-4 step 4
					inc idx
					valuef#=peek float(tptr+i)
					`note DBO stores RGBA as BGRA
					if idx = 0 then mmcolB#=valuef# // Blue
					if idx = 1 then mmcolG#=valuef# // Green
					if idx = 2 then mmcolR#=valuef# // Red
					if idx = 3 then mmcolA#=valuef# // Alpha
				next i
							
				b1 as byte
				b2 as byte
				b3 as byte
				b4 as byte

				`note DBO stores RGBA as BGRA
				b1=mmcolR#*255.0 // Blue
				b2=mmcolG#*255.0 // Green
				b3=mmcolB#*255.0 // Red
				b4=mmcolA#*255.0 // Alpha
											
				col as dword
				col = mkdword(b1,b2,b3,b4,0) 
			endif
		next mm
	endif
	
	if mshmmat > -1 		
		for mt=0 to mshmmat
			if mesh(m).id = meshmultimaterials(mt).id
				for mm= 0 to mshmmat
					if mesh(m).id = meshmultimatptr(mm).id and meshmultimatptr(mm).subid=meshmultimaterials(mt).id and mesh(m).id=meshid
						tptr=meshmultimatptr(mm).ptr
						tsize=meshmultimatptr(mm).size
						idx=-1
						for i = 0 to tsize-4 step 4
							inc idx
							valuef#=peek float(tptr+i)
							`note DBO stores RGBA as BGRA
							if idx = 0 then mmcolB#=valuef# // Blue
							if idx = 1 then mmcolG#=valuef# // Green
							if idx = 2 then mmcolR#=valuef# // Red
							if idx = 3 then mmcolA#=valuef# // Alpha
						next i
						b1 as byte
						b2 as byte
						b3 as byte
						b4 as byte
			
						`note DBO stores RGBA as BGRA
						b1=mmcolR#*255.0 // Blue
						b2=mmcolG#*255.0 // Green
						b3=mmcolB#*255.0 // Red
						b4=mmcolA#*255.0 // Alpha
														
						col as dword
						col = mkdword(b1,b2,b3,b4,0) 
					endif
				next mm
			endif
		next mt
	endif
	
	mesh(m).diffusecol=col
	next m
endfunction col

function SetMeshRGBA(meshid,RGBAval as dword)
	msh = array count(mesh()) // mesh
	mshmat = array count(meshmatptr()) // mesh ptr to material data
	mshmmat = array count(meshmultimaterials()) // mesh ptr to multimaterial data

	// loop through each mesh
	if msh =-1 then exitfunction 
	for m=0 to msh
	if mshmat > -1 
		for mm= 0 to mshmat
			if mesh(m).id = meshmatptr(mm).id and mesh(m).id=meshid
				tptr=meshmatptr(mm).ptr
				tsize=meshmatptr(mm).size
				idx=-1
				for i = 0 to tsize-4 step 4
					inc idx
					`note DBO stores RGBA as BGRA
					
					if idx = 0
						valuebf#=rgbb(RGBAval)/255.0 
						poke float tptr,valuebf#  // Blue
					endif
					
					if idx = 1 
						valuegf#=rgbg(RGBAval)/255.0 
						poke float tptr+4,valuegf# // Green
					endif
					
					if idx = 2 
						valuerf#=rgbr(RGBAval)/255.0 
						poke float tptr+8,valuerf# // Red
					endif
					
					if idx = 3 
						valueaf#=rgba(RGBAval)/255.0 
						poke float tptr+12,valueaf# // Alpha
					endif
					
					`if idx = 4 then mmcol1#=valuef# // Col 1
					`if idx = 5 then mmcol2#=valuef# // Col 2
					`if idx = 6 then mmcol3#=valuef# // Col 3
					`if idx = 7 then mmcol4#=valuef# // Col 4
					`if idx = 8 then mmspec1#=valuef#  // Spec 1
					`if idx = 9 then mmspec2#=valuef#  // Spec 2
					`if idx = 10 then mmspec3#=valuef# // Spec 3
					`if idx = 11 then mmspec4#=valuef# // Spec 4
					`if idx = 12 then mmemm1#=valuef#  // Emmisive 1
					`if idx = 13 then mmemm2#=valuef#  // Emmisive 2
					`if idx = 14 then mmemm3#=valuef#  // Emmisive 3
					`if idx = 15 then mmemm4#=valuef#  // Emmisive 4

					if idx = 16
						valuepf#=0.000000 
						poke float tptr+64,valuepf# // Power
					endif

				next i
			endif
		next mm
	endif
	
	if mshmmat > -1 		
		for mt=0 to mshmmat
			if mesh(m).id = meshmultimaterials(mt).id
				for mm= 0 to mshmmat
					if mesh(m).id = meshmultimatptr(mm).id and meshmultimatptr(mm).subid=meshmultimaterials(mt).id and mesh(m).id=meshid
						tptr=meshmultimatptr(mm).ptr
						tsize=meshmultimatptr(mm).size
						idx=-1
						for i = 0 to tsize-4 step 4
							inc idx
							`note DBO stores RGBA as BGRA
							if idx = 0
								valuebf#=rgbb(RGBAval)/255.0 
								poke float tptr,valuebf#  // Blue
							endif
							
							if idx = 1 
								valuegf#=rgbg(RGBAval)/255.0 
								poke float tptr+4,valuegf# // Green
							endif
							
							if idx = 2 
								valuerf#=rgbr(RGBAval)/255.0 
								poke float tptr+8,valuerf# // Red
							endif
							
							if idx = 3 
								valueaf#=rgba(RGBAval)/255.0 
								poke float tptr+12,valueaf# // Alpha
							endif

							if idx = 16
								valuepf#=0.000000 
								poke float tptr+64,valuepf# // Power
							endif

						next i
					endif
				next mm
			endif
		next mt
	endif
	
	`mesh(m).diffusecol=col
	next m
endfunction 

INIT_CONSTANTS:
#constant appver "return mesh color example 0.1"
#constant BYTEMAX 							256
#constant DBOBLOCK_ROOT_FRAME 				1			// rule = Must = 101 (DBOBLOCK_FRAME_NAME) 
#constant DBOBLOCK_FRAME_NAME 				101			// Rule 1 - Names must be dwCodeSize = pBlock + 4
#constant DBOBLOCK_FRAME_MESH 				103			// Rule x - pBlock must be = 111 (DBOBLOCK_MESH_FVF)
#constant DBOBLOCK_MESH_FVF 				111			// Rule 2 - Size must be = DWORD (4)
#constant DBOBLOCK_MESH_FVFSIZE 			112			// Rule 2 - Size must be = DWORD (4)
#constant DBOBLOCK_MESH_USEMATERIAL 		125			// Rule 5 - Size must be = 0 or 1 (boolean flag =1 Yes 0 =No)
#constant DBOBLOCK_MESH_MATERIAL 			126			// Rule 6 - Size must be = 68 e.g. 4x4float + 1 float
#constant DBOBLOCK_MESH_USEMULTIMAT 		123			// Rule 5 - Size must be = 0 or 1 (boolean flag =1 Yes 0 =No)
#constant DBOBLOCK_MESH_MULTIMATCOUNT 		124			// Rule 2 - Size must be = DWORD (4) - docs say size should be 1 --incorrect??
#constant DBOBLOCK_MESH_MULTIMAT 			139			// Docs point to Multi MAts - 128 so code will either be 161 (Name) or something else????
#constant DBOBLOCK_MULTIMAT_NAME 			161			// Rule 1 - Names must be dwCodeSize = pBlock + 4
#constant DBOBLOCK_MULTIMAT_MATERIAL 		162			// Size must be 68 --Contains a reference to a mesh material.??

#constant FVF_XYZ      	0x002 			// float X, Y, Z positions        - bit 1
#constant FVF_XYZRHW   	0x004 			// float X, Y, Z transformed      - bit 2
#constant FVF_NORMAL   	0x010 			// float X, Y, Z normal vector    - bit 3
#constant FVF_PSIZE    	0x020 			// float point size for sprites   - bit 4
#constant FVF_DIFFUSE  	0x040 			// DWORD diffuse colour           - bit 5
#constant FVF_SPECULAR 	0x080 			// DWORD specular colour          - bit 6
#constant FVF_TEX0 		0x000 			// texture coordinates 0		  - bit 7
#constant FVF_TEX1 		0x100 			// texture coordinates 1		  - bit 8
#constant FVF_TEX2 		0x200 			// texture coordinates 2		  - bit 9
#constant FVF_TEX3 		0x300 			// texture coordinates 3		  - bit 10
#constant FVF_TEX4 		0x400 			// texture coordinates 4		  - bit 11
#constant FVF_TEX5 		0x500 			// texture coordinates 5		  - bit 12
#constant FVF_TEX6 		0x600 			// texture coordinates 6		  - bit 13
#constant FVF_TEX7 		0x700 			// texture coordinates 7		  - bit 14
#constant FVF_TEX8 		0x800 			// texture coordinates 8		  - bit 15


` END CONSTANTS
return

INIT_TYPES:
// DBO structure related types
type frametype
	id as integer // frame id - parent ID
	ismesh as boolean
endtype

// for mesh, actual data will be stored in separate arrays for multiple values 
// but mesh id will be stored as a linking value
type meshtype
	frameid as integer // frame id - link
	id as integer // mesh id
	fvf as integer
	fvfsize as integer
	usematerial as boolean
	multimatcount as integer
	diffusecol as dword
endtype

type meshptrtype
	id as integer // mesh id
	subid as integer // sub object id e.g. multimaterials ID
	ptr as dword  // pointer start of vertex data
	size as dword // size of vertex data 
endtype

type meshmaterialstype
	id as integer     // mesh id
	mmatid as integer // multimaterial id	
endtype
return

` END STRUCTURES

INIT_GLOBALS:
global RootSize AS DWORD
global dwCodePTR AS DWORD
global bnkptr AS DWORD
global bnksize AS DWORD
global frameCount
frameCount=-1 // this will force the DBO root frame to start at 0 and not 1
global meshCount
global materialCount

return

` END GLOBALS