#--------------------------------------------
#' @title Convert a read in .sur file to x3p format and write the file.
#'
#' @description Convert a read in .sur file to x3p format
#'
#' @details It's necessary at this point to open the .sur file so
#' that point's can be converted to floats (or doubles),
#' which as far as I can tell is required by the
#' NanoFocus x3p library
#'
#' @param surf.info information read in by \code{read.digital.surf.file}
#' @param extra.file.info.list extra information required by the standard
#' @param comment.list a list of user comments.
#' @param fname desired .x3p file name
#' @param move.to.directory desired place to put the .x3p file
#'
#' @return a x3p file is written to disk.
#'
#' @references http://open-gps.sourceforge.net/
#'
#' @examples
#' file.path <- system.file("extdata", "glock.sur", package="x3pr")
#' glock.sur.info <- read.digital.surf.file(file.path)
#'
#' extra.header.info <- list(
#' x.axis.type = "I",
#' x.data.type = "F",
#' x.offset = 0.0,
#' y.axis.type = "I",
#' y.data.type = "F",
#' y.offset = 0.0,
#' z.axis.type = "A",
#' z.data.type = "F",
#' z.offset = 0.0,
#' who.wrote.file = "abe[-at-]potus.gov ",
#' manufacturer = "Leitz",
#' model = "Model-A",
#' sn = "8675309",
#' vers = "Version: 2010-C.E.",
#' cal.dte = "2013-08-15T08:00:00-03:00",
#' probe.type = "NonContacting",
#' probe.id = "Interferometer",
#' z.format = 1)
#'
#' comment.block<-list(
#' paste("Surface is from: "," an object, ",sep=""),
#' paste("Surface category: ","It was the left chunk, ",sep=""),
#' paste("Surface sample#: ",3,", ",sep=""),
#' paste("Droupouts/Outliers filled with ..., ",sep=""),
#' paste("Estimated Resolution x (meters) ", glock.sur.info[[1]]$x.inc/1000, ", ",sep=""),
#' paste("Estimated Resolution y (meters) ", glock.sur.info[[1]]$y.inc/1000, ", ",sep=""),
#' paste("Estimated Resolution z (meters) ", glock.sur.info[[1]]$z.inc/1000, ", ",sep=""),
#' paste("Form removed?: ", "YesOrNo, ",sep=""),
#' paste("Filter ", "Type: None/", "Cutoffs: None, ",sep=""),
#' paste("Microscope Objective: ", "50x/","0.8NA, ",sep=""),
#' paste("Invalid Pixel Value: ", NaN,sep=""))
#'
#' sur2x3p.file(glock.sur.info, extra.header.info, comment.block, fname="testfile.x3p", move.to.directory=getwd())
#--------------------------------------------
sur2x3p.file <- function(surf.info, extra.file.info.list, comment.list, fname, move.to.directory){
head.info <- surf.info[[1]]
if(head.info["stud.typ"]==2){
sur.type = "SUR"
} else {
stop("Not supported") #FIX ME
}
#We need this for the file seperators and some Windows console qurks:
os.typ <- .Platform$OS.type
x.inc <- head.info["x.inc"][[1]]/1000 #convert mm to m #FIX ME ADD ERROR TRAP! IMPROVE
y.inc <- head.info["y.inc"][[1]]/1000 #convert mm to m #FIX ME ADD ERROR TRAP! IMPROVE
z.inc <- head.info["z.inc"][[1]]/1000 #?? unit ?? FIX ME ADD ERROR TRAP! IMPROVE
num.pts.per.profile <- head.info["num.pts.line"] #FIX ME COMPARE TO DIMS OF surface matrix IMPROVE
num.profile <- head.info["num.lines"] #FIX ME COMPARE TO DIMS OF surface matrix IMPROVE
z.off <- head.info[["z.off"]][[1]]
if(os.typ=="windows"){
data.fpath <- paste(tempdir(),"\\ftmp\\bindata\\data.bin",sep="")
} else if(os.typ=="unix"){
data.fpath <- paste(tempdir(),"/ftmp/bindata/data.bin",sep="")
} else {
stop(paste("O.S. not recognized:",os.typ))
}
#Make a temp directory for file assembly
if(os.typ=="windows"){
system(paste("rm -rf",paste(tempdir(),"\\ftmp\\",sep=""))) #Remove directory structure if it is there first.
system(paste("mkdir",paste(tempdir(),"\\ftmp\\",sep="")))
system(paste("mkdir",paste(tempdir(),"\\ftmp\\bindata\\",sep="")))
}
if(os.typ=="unix"){
system(paste("rm -rf",paste(tempdir(),"/ftmp/",sep=""))) #Remove directory structure if it is there first.
system(paste("mkdir",paste(tempdir(),"/ftmp/",sep="")))
system(paste("mkdir",paste(tempdir(),"/ftmp/bindata/",sep="")))
}
fptr <- file(data.fpath, "wb")
#Assumes data to be written is in units of um. IMPROVE.
writeBin(1e-6 * as.numeric(t(surf.info[[2]])), data.fpath, size=4)
close(fptr)
#chk.sum <- strsplit(system(paste("md5",data.fpath),intern=T)," ")[[1]][4]
chk.sum <- tools::md5sum(data.fpath)
#This is the format of the date/time in main.xml:
tme.stmp <- strsplit(as.character(Sys.time()), " ")[[1]]
tme.stmp <- paste(tme.stmp[1],"T",tme.stmp[2],"-03:00",sep="")
options(warn=-1) #Shut off warnings generated by XML
main.xml<- make.x3p.header(
surf.type = sur.type, #ignored
x.axis.type = extra.file.info.list[["x.axis.type"]],
x.data.type = extra.file.info.list[["x.data.type"]],
xinc = x.inc,
x.offset = 0.0, #Default start at (0,0)
#
y.axis.type = extra.file.info.list[["y.axis.type"]],
y.data.type = extra.file.info.list[["y.data.type"]],
yinc = y.inc,
y.offset = 0.0, #Default start at (0,0)
#
z.axis.type = extra.file.info.list[["z.axis.type"]],
z.data.type = extra.file.info.list[["z.data.type"]],
zinc = z.inc,
z.offset = z.off, #This may not be 0, so fill it in. head.info[[1]][["z.off"]]
#
meas.dte = tme.stmp,
who.wrote.file = extra.file.info.list[["who.wrote.file"]],
manufacturer = extra.file.info.list[["manufacturer"]],
model = extra.file.info.list[["model"]],
sn = extra.file.info.list[["sn"]],
vers = extra.file.info.list[["vers"]],
cal.dte = extra.file.info.list[["cal.dte"]],
probe.type = extra.file.info.list[["probe.type"]],
probe.id = extra.file.info.list[["probe.id"]],
#meas.comment = extra.file.info.list[["meas.comment"]],
meas.comment = comment.list,
pts.per.prof = num.pts.per.profile,
num.prof = num.profile,
z.format = extra.file.info.list[["z.format"]],
data.bin.md5sumcheck = chk.sum
)
options(warn=1) #Turn warnings on again
if(os.typ=="windows"){
saveXML(main.xml,file=paste(tempdir(),"\\ftmp\\main.xml",sep=""))
}
if(os.typ=="unix"){
saveXML(main.xml,file=paste(tempdir(),"/ftmp/main.xml",sep=""))
}
if(os.typ=="windows"){
chk.sum.main <- md5sum(paste(tempdir(),"\\ftmp\\main.xml",sep=""))
write(chk.sum.main, paste(tempdir(),"\\ftmp\\md5checksum.hex",sep=""))
orig.dir <- getwd()
orig.move.to.dir <- move.to.directory #With the way we are switching working directories below, this can get changed if move.to.directory == getwd(). So, save what it was sent in as.
setwd(paste(tempdir(),"\\ftmp",sep=""))
system(paste("zip", fname, "bindata/data.bin main.xml md5checksum.hex"))
system(paste("mv ",fname," ", orig.move.to.dir,sep=""))
setwd(orig.dir)
system(paste("rm -rf",paste(tempdir(),"\\ftmp",sep="")))
}
if(os.typ=="unix"){
chk.sum.main <- md5sum(paste(tempdir(),"/ftmp/main.xml",sep=""))
write(chk.sum.main, paste(tempdir(),"/ftmp/md5checksum.hex",sep=""))
system(paste("cd", paste(tempdir(),"/ftmp/;",sep=""),
paste("zip", fname, "bindata/data.bin main.xml md5checksum.hex;"),
paste("cp",fname,move.to.directory)
))
system(paste("rm -rf",paste(tempdir(),"/ftmp/",sep=""))) #Remove directory structure
}
print(paste("Wrote file:", fname, "to directory:",move.to.directory))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.