#############################
# kmlFunctions.r ver 0.1.7
# fumihiko makiyama
#############################
##kmlAltitudeNode()
kmlAltitudeNode<-function(doc,data,fillcolor,linecolor,extrude="1",tessellate="1",altitudeMode="relativeToGround",MG=T){
kmlnode <- xmlRoot(doc)
node0<-kmlnode[[1]]
kmlver5<-'http://www.opengis.net/kml/2.2" xmlns:gx="http://www.google.com/kml/ext/2.2'
kmlnode<-xmlNode("kml",node0,attrs=c(xmlns=kmlver5))
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("gx: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="clampToGround",MG=T,label=""){
#kmlnode <- xmlRoot(doc)
node0<-kmlnode[[1]]
kmlver5<-'http://www.opengis.net/kml/2.2" xmlns:gx="http://www.google.com/kml/ext/2.2'
kmlnode<-xmlNode("kml",node0,attrs=c(xmlns=kmlver5))
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,"
\n"))
x<-x[[grep(name,x)]]
x<-gsub("","",gsub("","",gsub("","",gsub("","",gsub("
","",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,"
\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("","",gsub("","",gsub("","",gsub("","",gsub("
","",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,"
\n"))
x<-x[[grep(name,x)]]
x<-gsub("","",gsub("","",gsub("","",gsub("","",gsub("
","",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]]
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)
}