; XML load / parse / save functions
Type sdXMLnodelist
Field node.sdxmlnode
Field nextnode.sdxmlnodelist
Field prevnode.sdxmlnodelist
End Type
; for internal use, do not use in code outside of this file
Type sdXMLworklist
Field node.sdxmlnode
End Type
Type sdXMLnode
Field tag$,value$,path$
Field firstattr.sdXMLattr
Field lastattr.sdXMLattr
Field attrcount,fileid
Field endtag$
; linkage functionality
Field firstchild.sdXMLnode
Field lastchild.sdXMLnode
Field childcount
Field nextnode.sdXMLnode
Field prevnode.sdXMLnode
Field parent.sdXMLnode
End Type
Type sdXMLattr
Field name$,value$
Field sibattr.sdXMLattr
Field parent.sdxmlnode
End Type
Global SDXMLFILEID
Function sdReadXML.sdXMLnode(filename$)
infile = ReadFile(filename$)
SDXMLFILEID=MilliSecs()
x.sdxmlnode = sdXMLReadNode(infile,Null)
CloseFile infile
Return x
End Function
Function sdWriteXML(filename$,node.sdxmlnode,writeroot=False)
outfile = WriteFile(filename$)
WriteLine outfile,"<?xml version="+Chr$(34)+"1.0"+Chr$(34)+" ?>"
sdXMLwriteNode(outfile,node)
CloseFile outfile
End Function
Function sdXMLOpenNode.sdxmlnode(parent.sdxmlnode,tag$="")
;gak debuglog "Opening new node"
x.sdxmlnode = New sdxmlnode
x ag$=tag$
xfileid = SDXMLFILEID; global indicator to group type entries (allows multiple XML files to be used)
sdXMLaddNode(parent,x)
Return x
End Function
Function sdXMLCloseNode.sdxmlnode(node.sdxmlnode)
;gak debuglog "Closing node ["+node ag$+"]"
If nodeparent <> Null Then
;gak debuglog "Returning to parent ["+nodeparent ag$+"]"
Else
;gak debuglog "No Parent found"
End If
Return nodeparent
End Function
; adds node to end of list (need separate function for insert, or mod this on)
Function sdXMLAddNode(parent.sdxmlnode,node.sdxmlnode)
If parent <> Null
;gak debuglog "Parent of node = ["+parent ag$+"]"
If parentchildcount = 0 Then
parentfirstchild = node
Else
parentlastchild
extnode = node
End If
nodeprevnode = parentlastchild
parentlastchild = node
parentchildcount = parentchildcount +1
nodepath$ = parentpath$+parent ag$
End If
nodeparent = parent
nodepath$=nodepath$+"/"
;gak debuglog "path to ["+node ag$+"]={"+nodepath$+"}"
End Function
Function sdXMLDeleteNode(node.sdxmlnode)
n.sdxmlnode = nodefirstchild
; delete any children recursively
While n <> Null
nn.sdxmlnode= n
extnode
sdXMLdeletenode(n)
n = nn
Wend
; delete attributes for this node
a.sdxmlattr = nodefirstattr
While a <> Null
na.sdxmlattr = asibattr
Delete a
a = na
Wend
; dec parents child count
If nodeparent <> Null
nodeparentchildcount = nodeparentchildcount -1
; heal linkages
If nodeprevnode <> Null Then nodeprevnode
extnode = node
extnode
If node
extnode <> Null Then node
extnodeprevnode = nodeprevnode
If nodeparentfirstchild = node Then nodeparentfirstchild = node
extnode
If nodeparentlastchild = node Then nodeparentlastchild = nodeprevnode
End If
; delete this node
; ;gak debuglog "DELETING:"+node ag$
Delete node
End Function
; node functions
Function sdXMLfindNode.sdXMLnode(node.sdxmlnode,path$)
;gak debuglog "------------- Perfoming Find ("+path$+")------------"
ret.sdXMLnode = Null
p=Instr(path$,"/")
If p > 0 Then
tag$=Left$(path$,p-1)
;gak debuglog "Looking for ["+tag$+"]"
a.sdxmlnode = node
While ret=Null And a<>Null
;gak debuglog "Checking...["+a ag$+"]"
If Lower(tag$)=Lower(a ag$) Then
If p=Len(path$) Then
;gak debuglog "Found..."
ret = a
Else
If afirstchild <> Null Then
ret = sdxmlfindnode(afirstchild,Mid$(path$,p+1))
End If
End If
End If
a = a
extnode
Wend
End If
Return ret
End Function
Function sdXMLDeleteList(nl.sdxmlnodelist)
While nl <> Null
na.sdxmlnodelist = nl
extnode
Delete nl
nl = na
Wend
End Function
Function sdXMLSelectNodes.sdxmlnodelist(node.sdxmlnode,path$,recurse=True)
root.sdxmlnodelist=Null
sdxmlselectnodesi(node,path$,recurse)
prev.sdxmlnodelist=Null
c = 0
For wl.sdxmlworklist = Each sdxmlworklist
c = c + 1
nl.sdxmlnodelist = New sdxmlnodelist
nl
ode = wl
ode
If prev = Null Then
root = nl
prev = nl
Else
prev
extnode = nl
nlprevnode = prev
End If
prev = nl
Delete wl
Next
;gak debuglog "XML: "+c+" nodes selected"
Return root
End Function
; internal selection function, do not use outside this file
Function sdXMLSelectNodesI(node.sdxmlnode,path$,recurse=True)
wl.sdXMLworklist=Null
;gak debuglog "------------- Perfoming Select ("+path$+")------------"
If node = Null Then
;gak debuglog "Search node is null!!!"
End If
ret.sdXMLnode = Null
p=Instr(path$,"/")
If p > 0 Then
tag$=Left$(path$,p-1)
a.sdxmlnode = node
While a<>Null
;gak debuglog "Looking for {"+path$+"} in {"+apath$+a ag$+"/} {"+Lower(Right$(apath$+a ag$+"/",Len(path$)))+"} @"
If Lower(path$)=Lower(Right$(apath$+a ag$+"/",Len(path$))) Then
wl = New sdXMLworklist
wl
ode = a
;gak debuglog ">>FOUND"
End If
If afirstchild <> Null And (recurse) Then
sdXMLSelectNodesI(afirstchild,path$)
End If
a = a
extnode
Wend
End If
End Function
Function sdXMLNextNode.sdXMLnode(node.sdXMLnode)
Return node
extnode
End Function
Function sdXMLPrevNode.sdXMLnode(node.sdXMLnode)
Return nodeprevnode
End Function
Function sdXMLAddAttr(node.sdxmlnode,name$,value$)
;gak debuglog "XML:adding attribute "+name$+"="+value$+" ("+Len(value$)+")"
a.sdxmlattr = New sdxmlattr
a
ame$ = name$
avalue$ = value$
If nodeattrcount = 0 Then
nodefirstattr = a
Else
nodelastattrsibattr = a
End If
nodelastattr=a
nodeattrcount = nodeattrcount + 1
aparent = node
End Function
Function sdXMLReadNode.sdxmlnode(infile,parent.sdXMLnode,pushed=False)
mode = 0
root.sdxmlnode = Null
cnode.sdxmlnode = Null
x.sdXMLnode = Null
ispushed = False
done = False
While (Not done) And (Not Eof(infile))
c = ReadByte(infile)
If c<32 Then c=32
ch$=Chr$(c)
; ;gak debuglog "{"+ch$+"} "+c+" mode="+mode
Select mode
Case 0 ; looking for the start of a tag, ignore everything else
If ch$ = "<" Then
mode = 1; start collecting the tag
End If
Case 1 ; check first byte of tag, ? special tag
If ch$ = "?" Or ch$ = "!" Then
mode = 0; class special nodes as garbage & consume
Else
If ch$ = "/" Then
mode = 2 ; move to collecting end tag
xendtag$=ch$
;gak debuglog "** found end tag"
Else
cnode=x
x.sdXMLnode = sdXMLOpennode(cnode)
If cnode=Null Then root=x
x ag$=ch$
mode = 3 ; move to collecting start tag
End If
End If
Case 2 ; collect the tag name (close tag)
If ch$=">" Then
mode = 0 ; end of the close tag so jump out of loop
;done = True
x = sdXMLclosenode(x)
Else
xendtag$ = xendtag$ + ch$
End If
Case 3 ; collect the tag name
If ch$=" " Then
;gak debuglog "TAG:"+x ag$
mode = 4 ; tag name collected, move to collecting attributes
Else
If ch$="/" Then
;gak debuglog "TAG:"+x ag$
xendtag$=x ag$
mode = 2; start/end tag combined, move to close
Else
If ch$=">" Then
;gak debuglog "TAG:"+x ag$
mode = 20; tag closed, move to collecting value
Else
x ag$ = x ag$ + ch$
End If
End If
End If
Case 4 ; start to collect attributes
If Lower(ch$)>="a" And Lower(ch$)<="z" Then
aname$=ch$;
mode = 5; move to collect attribute name
Else
If ch$=">" Then
xvalue$=""
mode = 20; tag closed, move to collecting value
Else
If ch$="/" Then
mode = 2 ; move to collecting end tag
xendtag$=ch$
;gak debuglog "** found end tag"
End If
End If
End If
Case 5 ; collect attribute name
If ch$="=" Then
;gak debuglog "ATT:"+aname$
aval$=""
mode = 6; move to collect attribute value
Else
aname$=aname$+ch$
End If
Case 6 ; collect attribute value
If c=34 Then
mode = 7; move to collect string value
Else
If c <= 32 Then
;gak debuglog "ATV:"+aname$+"="+aval$
sdXMLAddAttr(x,aname$,aval$)
mode = 4; start collecting a new attribute
Else
aval$=aval$+ch$
End If
End If
Case 7 ; collect string value
If c=34 Then
;gak debuglog "ATV:"+aname$+"="+aval$
sdxmlADDattr(x,aname$,aval$)
mode = 4; go and collect next attribute
Else
aval$=aval$+ch$
End If
Case 20 ; COLLECT THE VALUE PORTION
If ch$="<" Then
;gak debuglog "VAL:"+x ag$+"="+xvalue$
mode=1; go to tag checking
Else
xvalue$=xvalue$+ch$
End If
End Select
If Eof(infile) Then done=True
Wend
Return root
End Function
; write out an XML node (and children)
Function sdXMLWriteNode(outfile,node.sdxmlnode,tab$="")
; ;gak debuglog "Writing...."+node ag$+".."
s$="<"+node ag$
a.sdxmlattr = nodefirstattr
While a<>Null
; ;gak debuglog "Writing attr ["+a
ame$+"]=["+avalue$+"]"
s$ = s$+" "+Lower(a
ame$)+"="+Chr$(34)+avalue$+Chr$(34)
a = asibattr
Wend
If nodevalue$="" And nodechildcount = 0 Then
s$=s$+"/>"
et$=""
Else
s$=s$+">"+nodevalue$
et$="</"+node ag$+">"
End If
WriteLine outfile,sdXMLcleanStr$(tab$+s$)
n.sdxmlnode = nodefirstchild
While n <> Null
sdXMLwriteNode(outfile,n,tab$+" ")
n = n
extnode
Wend
If et$<> "" Then WriteLine outfile,sdXMLcleanStr$(tab$+et$)
End Function
; remove non-visible chars from the output stream
Function sdXMLCleanStr$(s$)
a$=""
For i = 1 To Len(s$)
If Asc(Mid$(s$,i,1))>=32 Then a$ = a$ +Mid$(s$,i,1)
Next
Return a$
End Function
; attribute functions
; return an attribute of a given name
Function sdXMLFindAttr.sdXMLattr(node.sdxmlnode,name$)
ret.sdXMLattr = Null
If node <> Null Then
a.sdxmlattr = nodefirstattr
done = False
While ret=Null And a<>Null
If Lower(name$)=Lower(a
ame$) Then
ret = a
End If
a = asibattr
Wend
End If
Return ret
End Function
; return an attribute value as a string
Function sdXMLAttrValueStr$(node.sdxmlnode,name$,dflt$="")
ret$=dflt$
a.sdxmlattr = sdXMLfindattr(node,name$)
If a <> Null Then ret$=avalue$
Return ret$
End Function
; return an attribute value as an integer
Function sdXMLAttrValueInt(node.sdxmlnode,name$,dflt=0)
ret=dflt
a.sdxmlattr = sdXMLfindattr(node,name$)
If a <> Null Then ret=avalue
Return ret
End Function
; return an attribute value as a float
Function sdXMLAttrValueFloat#(node.sdxmlnode,name$,dflt#=0)
ret#=dflt#
a.sdxmlattr = sdXMLfindattr(node,name$)
If a <> Null Then ret#=avalue
Return ret
End Function
;x.sdxmlnode = sdReadXML("test.xml")
;sdwritexml("test2.xml",x)
;f.sdxmlnode = sdxmlfindnode(x,"BB3D/NODE/MESH/")
;If f <> Null Then
; ;gak debuglog "FOUND!!!"
; sdxmldeletenode(f)
;End If
;sdwritexml("test3.xml",x)
;nl.sdxmlnodelist = sdxmlselectnodes(x,"/VERTEX/POS/")
;While nl <> Null;
; ;gak debuglog "Found....."+nl
ode ag$
; nl=nl
extnode
;Wend
;sdxmldeleteList(nl);
;sdxmldeletenode(x)
