1# Derived, with only minor changes, from functions GE_SpatialGrid and kml Overlay 2# in the maptools package. These were written by Duncan Golicher, David Forrest and Roger Bivand 3# Adaptation for the raster packcage by Robert J. Hijmans, 4# Date : March 2009 5# Version 0.9 6# Licence GPL v3 7 8 9if (!isGeneric("KML")) { 10 setGeneric("KML", function(x, ...) 11 standardGeneric("KML")) 12} 13 14setMethod('KML', signature(x='Spatial'), 15 function (x, filename, zip='', overwrite=FALSE, ...) { 16 .requireRgdal() 17 if (! is.na(projection(x))) { 18 if (! isLonLat(x) ) { 19 warning('transforming data to longitude/latitude') 20 sp::spTransform(x, sp::CRS('+proj=longlat +datum=WGS84')) 21 } 22 } 23 24 if (!.hasSlot(x, 'data') ) { 25 x <- sp::addAttrToGeom(x, data.frame(id=1:length(x)), match.ID=FALSE) 26 } 27 28 extension(filename) <- '.kml' 29 if (file.exists(filename)) { 30 if (overwrite) { 31 file.remove(filename) 32 } else { 33 stop('file exists, use "overwrite=TRUE" to overwrite it') 34 } 35 } 36 name <- list(...)$name 37 if (is.null(name)) { 38 name <- deparse(substitute(x)) 39 } 40 rgdal::writeOGR(x, filename, name, 'KML', ...) 41 .zipKML(filename, '', zip, overwrite=overwrite) 42 } 43) 44 45 46 47 48setMethod('KML', signature(x='RasterLayer'), 49 50function (x, filename, col=rev(terrain.colors(255)), colNA=NA, maxpixels=100000, blur=1, zip='', overwrite=FALSE, ...) { 51 52 if (! couldBeLonLat(x)) { 53 stop("CRS of x must be longitude / latitude") 54 } 55 56 if (nlayers(x) > 1) { 57 x <- x[[1]] 58 } 59 stopifnot(hasValues(x)) 60 61 if (missing(filename)) { 62 filename <- extension(basename(rasterTmpFile('G_')), '.kml') 63 } 64 65 x <- sampleRegular(x, size=maxpixels, asRaster = TRUE, useGDAL=TRUE) 66 67 imagefile <- filename 68 extension(imagefile) <- '.png' 69 kmlfile <- kmzfile <- filename 70 extension(kmlfile) <- '.kml' 71 72 if (file.exists(kmlfile)) { 73 if (overwrite) { 74 file.remove(kmlfile) 75 } else { 76 stop('kml file exists, use "overwrite=TRUE" to overwrite it') 77 } 78 } 79 80 81 82 grDevices::png(filename = imagefile, width=max(480, blur*ncol(x)), height=max(480,blur*nrow(x)), bg="transparent") 83 if (!is.na(colNA)) { 84 graphics::par(mar=c(0,0,0,0), bg=colNA) 85 } else { 86 graphics::par(mar=c(0,0,0,0)) 87 } 88 image(x, col=col, axes=FALSE, useRaster=TRUE, maxpixels=maxpixels, ...) 89 grDevices::dev.off() 90 91 name <- names(x)[1] 92 if (name == "") { name <- 'x' } 93 kml <- c('<?xml version="1.0" encoding="UTF-8"?>', '<kml xmlns="http://www.opengis.net/kml/2.2">', "<GroundOverlay>") 94 kmname <- paste("<name>", name, "</name>", sep = "") 95 icon <- paste("<Icon><href>", basename(imagefile), "</href><viewBoundScale>0.75</viewBoundScale></Icon>", sep = "") 96 e <- extent(x) 97 latlonbox <- c("\t<LatLonBox>", paste("\t\t<north>", e@ymax, "</north><south>", e@ymin, "</south><east>", e@xmax, "</east><west>", e@xmin, "</west>", sep = ""), "\t</LatLonBox>") 98 footer <- "</GroundOverlay></kml>" 99 100 kml <- c(kml, kmname, icon, latlonbox, footer) 101 102 f <- file(kmlfile, 'wt', encoding='UTF-8') 103 cat(paste(kml, sep="", collapse="\n"), file=f, sep="") 104 close(f) 105 106 .zipKML(kmlfile, imagefile, zip, overwrite=overwrite) 107} 108) 109