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