#############################
# kmlFunctions.r ver 0.1.3
# fumihiko makiyama
#############################
##kmlAltitudeNode()
kmlAltitudeNode<-function(doc,data,fillcolor,linecolor){
library(XML)
kmlnode <- xmlRoot(doc)
node0<-kmlnode[[1]]
len1<-length(node0[[1]])
for(i in 2:len1){
#altitude
node1<-node0[[1]][[i]][[2]][[1]]
node1<-addChildren(node1,xmlNode("extrude","1"),xmlNode("tessellate","1"),xmlNode("altitudeMode","relativeToGround"))
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
node0[[1]][[i]][[2]][[1]]<-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){
#kmlnode <- xmlRoot(doc)
node0<-kmlnode[[1]]
#altitude
node1<-node0[[1]][[nodeno]][[2]][[1]]
node1<-addChildren(node1,xmlNode("extrude","1"),xmlNode("tessellate","1"),xmlNode("altitudeMode","relativeToGround"))
#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))
#polygon
len2<-length(node0[[1]][[nodeno]][[2]][[1]])
for(j in 1:len2){
x1<-xmlValue(node1[[j]][[1]][[1]])
x2<-rev(unlist(strsplit(x1," ")))
x3<-paste(x2,data,sep=",",collapse=" ")
node1[[j]][[1]][[1]]<-xmlNode("coordinates",x3)
}
#replace node
node0[[1]][[nodeno]][[2]][[1]]<-node1
node0[[1]][[nodeno]][[3]][[2]]<-node2
node0[[1]][[nodeno]][[3]][[1]]<-node3
kmlnode[[1]]<-node0
return(kmlnode)
}
##setAltitudeMesh()
setAltitudeMesh<-function(kmlnode,nodeno,data,fillcolor,linecolor){
#kmlnode <- xmlRoot(doc)
node0<-kmlnode[[1]]
#altitude
node1<-node0[[1]][[nodeno]][[2]]
node1<-addChildren(node1,xmlNode("extrude","1"),xmlNode("tessellate","1"),xmlNode("altitudeMode","relativeToGround"))
#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))
#polygon
len2<-length(node0[[1]][[nodeno]][[2]][[1]])
for(j in 1:len2){
x1<-xmlValue(node1[[j]][[1]])
x2<-rev(unlist(strsplit(x1," ")))
x3<-paste(paste(x2,data,sep=",",collapse=" ")," ",sep="")
node1[[j]][[1]][[1]]<-xmlNode("coordinates",x3)
}
#replace node
node0[[1]][[nodeno]][[2]]<-node1
node0[[1]][[nodeno]][[3]][[2]]<-node2
node0[[1]][[nodeno]][[3]][[1]]<-node3
kmlnode[[1]]<-node0
return(kmlnode)
}
##kmlNodeLength() ver 0.1.2
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]])
for(i in 2:len1){
x[i-1]<-getCDATA(node0[[1]][[i]][[1]][[1]],name)
}
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)))
for(i in 1:len){
node1<-node0[[1]][[nodeno[[i]]]]
node2<-addChildren(node2,node1)
}
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)
}