1# Author: Robert J. Hijmans 2# Date : September 2009 3# Version 0.9 4# Licence GPL v3 5 6 7.isSurferFile <- function(filename, version=FALSE) { 8 con <- file(filename, "rb") 9 id <- readBin(con, "character", n=1, size=4) 10 close(con) 11 if (id == 'DSBB') { 12 if (version) { 13 return(6) 14 } else { 15 return (TRUE) 16 } 17 } 18 con <- file(filename, "rb") 19 id <- readBin(con, "numeric", n=1, size=4) 20 close(con) 21 if (id == as.numeric(0x42525344)) { 22 if (version) { 23 return(7) 24 } else { 25 return (TRUE) 26 } 27 } else { 28 return (FALSE) 29 } 30} 31 32 33.rasterFromSurferFile <- function(filename) { 34 v <- .isSurferFile(filename, TRUE) 35 if (v == 6) { 36 return ( .rasterFromSurfer6(filename) ) 37 } else if (v == 7) { 38 return ( .rasterFromSurfer7(filename) ) 39 } else { 40 stop ('not a (recognized) binary Surfer file') 41 } 42} 43 44 45.rasterFromSurfer6 <- function(filename) { 46 con <- file(filename, "rb") 47 r <- raster() 48 id <- readBin(con, "character", n=1, size=4) 49 r@ncols <- readBin(con, "int", n=1, size=2) 50 r@rows <- readBin(con, "int", n=1, size=2) 51 r@extent@xmin <- readBin(con, "double", n=1, size=8) 52 r@extent@xmax <- readBin(con, "double", n=1, size=8) 53 r@extent@ymin <- readBin(con, "double", n=1, size=8) 54 r@extent@ymax <- readBin(con, "double", n=1, size=8) 55 r@data@min <- readBin(con, "double", n=1, size=8) 56 r@data@max <- readBin(con, "double", n=1, size=8) 57 close(con) 58 r@file@offset <- 56 59 r@file@toptobottom <- FALSE 60 dataType(r) <- 'FLT4S' 61 r@data@fromdisk <- TRUE 62 63 r@file@driver <- "surfer" 64 return(r) 65} 66 67 68.rasterFromSurfer7 <- function(filename) { 69# source: http://www.geospatialdesigns.com/surfer7_format.htm 70 con <- file(filename, "rb") 71 r <- raster() 72 id <- readBin(con, "numeric", n=1, size=4) 73 size <- readBin(con, "numeric", n=1, size=4) 74 offset <- size + 8 75 seek(con, size, origin = "current") 76 id <- readBin(con, "numeric", n=1, size=4) 77 if (id != as.numeric(0x44495247)) { 78 # should be 0x44495247 grid section 79 # get size and skip to the next section 80 stop('file with this section not yet supported') 81 } 82 size <- readBin(con, "numeric", n=1, size=4) 83 offset <- offset + size + 8 84 r@rows <- as.integer(readBin(con, "numeric", n=1, size=4)) 85 r@cols <- as.integer(readBin(con, "numeric", n=1, size=4)) 86 r@extent@xmin <- readBin(con, "double", n=1, size=8) 87 r@extent@ymin <- readBin(con, "double", n=1, size=8) 88 xr <- readBin(con, "double", n=1, size=8) 89 yr <- readBin(con, "double", n=1, size=8) 90 r@extent@xmax <- r@extent@xmin + xr * r@cols 91 r@extent@ymax <- r@extent@ymin + yr * r@rows 92 r@data@min <- readBin(con, "double", n=1, size=8) 93 r@data@max <- readBin(con, "double", n=1, size=8) 94 rotation <- readBin(con, "double", n=1, size=8) 95 if (rotation != 0) { 96 stop('rotation != 0, cannot use this file') 97 } 98 r@data@max <- readBin(con, "double", n=1, size=8) 99 r@file@nodatavalue <- readBin(con, "double", n=1, size=8) 100 id <- readBin(con, "numeric", n=1, size=4) 101 size <- readBin(con, "numeric", n=1, size=4) 102 close(con) 103 r@file@offset <- offset + 8 104 r@file@toptobottom <- FALSE 105 if (ncell(r) / size == 4) { 106 dataType(r) <- 'FLT4S' 107 } else if (ncell(r) / size == 8) { 108 dataType(r) <- 'FLT8S' 109 } else { 110 stop('sorry; cannot process this file') 111 } 112 r@file@driver <- "surfer" 113 return(r) 114} 115 116 117