#############################
#  kmlFunctions.r ver 0.1.6
#  fumihiko makiyama
#############################

##kmlAltitudeNode()
kmlAltitudeNode<-function(doc,data,fillcolor,linecolor,extrude="1",tessellate="1",altitudeMode="relativeToGround",MG=T){
kmlnode <- xmlRoot(doc)
node0<-kmlnode[[1]]
kmlver4<-'http://earth.google.com/kml/2.2'
kmlnode<-xmlNode("kml",node0,attrs=c(xmlns=kmlver4))
len1<-length(node0[[1]])
for(i in 2:len1){
if(MG==T){
node1<-node0[[1]][[i]][[2]][[1]]
}else if(MG==F){
node1<-node0[[1]][[i]][[2]]
}
node1<-addChildren(node1,xmlNode("extrude",extrude),xmlNode("tessellate",tessellate),xmlNode("altitudeMode",altitudeMode))
 node2<-node0[[1]][[i]][[3]][[2]]
 node2<-xmlNode("PolyStyle",xmlNode("color",fillcolor[i-1]))
 #linecolor
 node3<-node0[[1]][[i]][[3]][[1]]
 node3<-xmlNode("LineStyle",xmlNode("color",linecolor))
 #polygon
 len2<-length(node0[[1]][[i]][[2]][[1]])
 for(j in 1:len2){
    x1<-xmlValue(node1[[j]][[1]][[1]])
    x2<-rev(unlist(strsplit(x1," ")))
    x3<-paste(x2,data[[i-1]],sep=",",collapse=" ")
    node1[[j]][[1]][[1]]<-xmlNode("coordinates",x3)
 }
#replace node
if(MG==T){
node0[[1]][[i]][[2]][[1]]<-node1
}else if(MG==F){
node0[[1]][[i]][[2]]<-node1
}
node0[[1]][[i]][[3]][[2]]<-node2
node0[[1]][[i]][[3]][[1]]<-node3
kmlnode[[1]]<-node0
}
return(kmlnode)
}


##setAltitude()
setAltitude<-function(kmlnode,nodeno,data,fillcolor,linecolor,extrude="1",tessellate="1",altitudeMode="relativeToGround",MG=T,label=""){
#kmlnode <- xmlRoot(doc)
node0<-kmlnode[[1]]
kmlver4<-'http://earth.google.com/kml/2.2'
kmlnode<-xmlNode("kml",node0,attrs=c(xmlns=kmlver4))
if(MG==T){

#altitude
node1<-node0[[1]][[nodeno]][[2]][[1]]
node1<-addChildren(node1,xmlNode("extrude",extrude),xmlNode("tessellate",tessellate),xmlNode("altitudeMode",altitudeMode))
#fillcolor
node2<-node0[[1]][[nodeno]][[3]][[2]]
node2<-xmlNode("PolyStyle",xmlNode("color",fillcolor))
#linecolor
node3<-node0[[1]][[nodeno]][[3]][[1]]
node3<-xmlNode("LineStyle",xmlNode("color",linecolor))
#label
node4<-node0[[1]][[nodeno]]
node4<-addChildren(node4,xmlNode("name",label))
#polygon
len2<-length(node0[[1]][[nodeno]][[2]][[1]])
j<-1:len2
text1<-paste('x1<-xmlValue(node1[[',j,']][[1]][[1]]);x2<-rev(unlist(strsplit(x1," ")));',sep='')
text2<-paste('x3<-paste(x2,data,sep=",",collapse=" ");node1[[',j,']][[1]][[1]]<-xmlNode("coordinates",x3)',sep='')
text<-paste(text1,text2,sep="")
eval(parse(text=text))
node0[[1]][[nodeno]]<-node4
node0[[1]][[nodeno]][[2]][[1]]<-node1
node0[[1]][[nodeno]][[3]][[2]]<-node2
node0[[1]][[nodeno]][[3]][[1]]<-node3
kmlnode[[1]]<-node0
}else if(MG==F){
#altitude
node1<-node0[[1]][[nodeno]][[2]]
node1<-addChildren(node1,xmlNode("extrude",extrude),xmlNode("tessellate",tessellate),xmlNode("altitudeMode",altitudeMode))
#fillcolor
node2<-node0[[1]][[nodeno]][[3]][[2]]
node2<-xmlNode("PolyStyle",xmlNode("color",fillcolor))
#linecolor
node3<-node0[[1]][[nodeno]][[3]][[1]]
node3<-xmlNode("LineStyle",xmlNode("color",linecolor))
#label
node4<-node0[[1]][[nodeno]]
node4<-addChildren(node4,xmlNode("name",label))
#polygon
len2<-length(node0[[1]][[nodeno]][[2]][[1]])
j<-1:len2
text1<-paste('x1<-xmlValue(node1[[',j,']][[1]][[1]]);x2<-rev(unlist(strsplit(x1," ")));',sep='')
text2<-paste('x3<-paste(x2,data,sep=",",collapse=" ");node1[[',j,']][[1]][[1]]<-xmlNode("coordinates",x3)',sep='')
text<-paste(text1,text2,sep="")
eval(parse(text=text))
node0[[1]][[nodeno]]<-node4
node0[[1]][[nodeno]][[2]]<-node1
node0[[1]][[nodeno]][[3]][[2]]<-node2
node0[[1]][[nodeno]][[3]][[1]]<-node3
kmlnode[[1]]<-node0
}

return(kmlnode)
}



##kmlNodeLength()
kmlNodeLength<-function(doc){
library(XML)
kmlnode <- xmlRoot(doc)
node0<-kmlnode[[1]]
len1<-length(node0[[1]])
return(len1)
}


##getCDATAList
getCDATAList<-function(doc,name){

getCDATA<-function(node,name){
x<-gsub(" ","",iconv(xmlValue(node),"utf-8","cp932"))
x<-unlist(strsplit(x,"<br/>\n"))
x<-x[[grep(name,x)]]
x<-gsub("<b>","",gsub("</b>","",gsub("<i>","",gsub("</i>","",gsub("<br/>","",gsub(paste(name,":",sep=""),"",x))))))
#x<-iconv(x,"","utf-8")
return(x)
}

kmlnode <- xmlRoot(doc)
node0<-kmlnode[[1]]
len1<-length(node0[[1]])
x<-NULL
 for(i in 2:len1){
 x[i-1]<-getCDATA(node0[[1]][[i]][[1]][[1]],name)
 }
 return(x)
}

#getCDATA
getCDATA<-function(kmlnode,name,nodeno=1,sep=":",cdatano=1){
node0<-kmlnode[[1]]
node1<-node0[[1]][[nodeno]][[1]][[1]]
#x<-gsub(" ","",xmlValue(node1))#mac
x<-gsub(" ","",iconv(xmlValue(node1),"utf-8","cp932"))
#print(x)
x<-unlist(strsplit(x,"<br/>\n"))
xno<-grep(name,x)
len<-length(xno)
if(len>1){
x<-x[[xno[cdatano]]]
}else if(len==1){
x<-x[[xno]]
}
#print(x)
x<-gsub("<b>","",gsub("</b>","",gsub("<i>","",gsub("</i>","",gsub("<br/>","",x)))))
x<-gsub(paste(name,sep,sep=""),"",x)
return(x)
}




##getCDATANo
getCDATANo<-function(kmlnode,name,value){
getCDATA2<-function(node,name){
x<-gsub(" ","",iconv(xmlValue(node),"utf-8","cp932"))
x<-unlist(strsplit(x,"<br/>\n"))
x<-x[[grep(name,x)]]
x<-gsub("<b>","",gsub("</b>","",gsub("<i>","",gsub("</i>","",gsub("<br/>","",x)))))
#x<-iconv(x,"","utf-8")
return(x)
}
#kmlnode <- xmlRoot(doc)
namevalue<-paste(name,":",value,sep="")
node0<-kmlnode[[1]]
len1<-length(node0[[1]])
for(i in 2:len1){
   if(namevalue == getCDATA2(node0[[1]][[i]][[1]][[1]],name)){
   x<-i
   break
   }else{
   x<-NA
   }
 }
 return(x)
}


##getKmlNode
getKmlNode<-function(kmlnode,nodeno){
len<-length(nodeno)
node0<-kmlnode[[1]]
kmlver4<-'http://earth.google.com/kml/2.2'
kmlnode<-xmlNode("kml",node0,attrs=c(xmlns=kmlver4))
node2<-xmlNode("Folder",xmlNode("name",as.character(nodeno)))
i<-1:len
text<-paste("node1<-node0[[1]][[nodeno[[",i,"]]]];node2<-addChildren(node2,node1)",sep="")
eval(parse(text=text))
kmlnode[[1]][[1]]<-node2
return(kmlnode)
}


##colors.kml
colors.kml<-function(rgb=colors(),alpha="FF"){
         colors.hex <- function( x=colors() ) { 
         color.hex <- function(x) do.call( "rgb", as.list(col2rgb(x)/255) ) 
         sapply( x, color.hex ) 
         }
col.hex<-colors.hex(rgb)
red<-substr(col.hex,2,3)
green<-substr(col.hex,4,5)
blue<-substr(col.hex,6,7)
alpha<-alpha
col.kml<-paste(alpha,blue,green,red,sep="")
return(col.kml)
}
