############################# # kmlFunctions.r ver 0.1.7 # fumihiko makiyama ############################# ##kmlAltitudeNode() kmlAltitudeNode<-function(doc,data,fillcolor,linecolor,extrude="1",tessellate="1",altitudeMode="absolute",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="absolute",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("gx: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("gx: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]] 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)) 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) }