#--------------------------------------------
#' @title Write a x3p format file.
#'
#' @description Write a x3p format file.
#'
#' @details Write a x3p format file. Some of the header information is mandatory as required by programs utilizing
#' libiso5436-2 (), so treat it all as mandatory. Cf. example section.
#'
#' @param x3p.header.info.list header information that will go into main.xml.
#' @param surface.mat the surface to save in matrix form.
#' @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.x3p", package="x3pr")
#' glock.x3p.info <- read.x3p(file.path)
#'
#' this.header.info<-list(
#' surf.type = "SUR",
#' x.axis.type = "I",
#' x.data.type = "F",
#' xinc = glock.x3p.info[[1]]$x.inc*1e-6,
#' x.offset = 0.0,
#' y.axis.type = "I",
#' y.data.type = "F",
#' yinc = glock.x3p.info[[1]]$y.inc*1e-6,
#' y.offset = 0.0,
#' z.axis.type = "A",
#' z.data.type = "F",
#' zinc = "NA",
#' z.offset = 0.0,
#' who.wrote.file = "abe[-at-]potus.gov",
#' manufacturer = "Leitz",
#' model = "Model-A",
#' sn = "A113",
#' vers = "Version: 2001-C.E.",
#' cal.dte = "2013-08-15T08:00:00-03:00",
#' probe.type = "NonContacting",
#' probe.id = "Interferometer",
#' meas.comment = 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.x3p.info[[1]]$x.inc*1e-6, ", ",sep=""),
#' paste("Estimated Resolution y (meters) ", glock.x3p.info[[1]]$y.inc*1e-6, ", ",sep=""),
#' paste("Estimated Resolution z (meters) ", "Not Applicable, z-heights stored as doubles.", ", ",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="")),
#' pts.per.prof = glock.x3p.info[[1]]$num.pts.line,
#' num.prof = glock.x3p.info[[1]]$num.lines,
#' z.format = 1)
#'
#' write.x3p(this.header.info, glock.x3p.info[[2]], fname="testfile.x3p", move.to.directory=getwd(), print.diagnosticsQ=TRUE)
#--------------------------------------------
write.x3p <- function(x3p.header.info.list, surface.mat, fname, move.to.directory, print.diagnosticsQ=FALSE){
#We need this for the file seperators:
os.typ <- .Platform$OS.type
if(os.typ=="unix"){
fs <- "/"
} else if(os.typ=="windows"){
fs <- "\\"
} else {
stop(paste("O.S. not recognized:",os.typ))
}
data.fpath <- paste(tempdir(),fs,"ftmp",fs,"bindata",fs,"data.bin",sep="")
if(print.diagnosticsQ==T){
print(paste("Surface data file will be written to: ",data.fpath,sep=""))
}
#Remove directory structure if it is there first.
system(paste("rm -rf",paste(tempdir(),fs,"ftmp",fs,sep="")))
#Now make the temporary directory structure for the x3p files.
system(paste("mkdir", paste(tempdir(),fs,"ftmp",fs,sep="")))
system(paste("mkdir", paste(tempdir(),fs,"ftmp",fs,"bindata",fs,sep="")))
#Write the surface data file first so that its md5 hash can be computed.
fptr <- file(data.fpath, "wb")
#Assumes data to be written is in units of um. Here we convert it to meters as required by the xp3 standard. TODO: IMPROVE.
writeBin(1e-6 * as.numeric(t(surface.mat)), data.fpath, size=4)
close(fptr)
#Compute the hash for the surface points data:
chk.sum <- md5sum(data.fpath)
if(print.diagnosticsQ==T){
print(paste("Surface data md5 hash: ",chk.sum,sep=""))
}
#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 = x3p.header.info.list$surf.type, #ignored
x.axis.type = x3p.header.info.list$x.axis.type,
x.data.type = x3p.header.info.list$x.data.type,
xinc = x3p.header.info.list$xinc,
x.offset = x3p.header.info.list$x.offset,
#
y.axis.type = x3p.header.info.list$y.axis.type,
y.data.type = x3p.header.info.list$y.data.type,
yinc = x3p.header.info.list$yinc,
y.offset = x3p.header.info.list$y.offset,
#
z.axis.type = x3p.header.info.list$z.axis.type,
z.data.type = x3p.header.info.list$z.data.type,
zinc = x3p.header.info.list$zinc,
z.offset = x3p.header.info.list$z.offset, #This may not be 0, so fill it in. head.info[[1]][["z.off"]]
#
meas.dte = tme.stmp,
who.wrote.file = x3p.header.info.list$who.wrote.file,
manufacturer = x3p.header.info.list$manufacturer,
model = x3p.header.info.list$model,
sn = x3p.header.info.list$sn,
vers = x3p.header.info.list$vers,
cal.dte = x3p.header.info.list$cal.dte,
probe.type = x3p.header.info.list$probe.type,
probe.id = x3p.header.info.list$probe.id,
#
meas.comment = x3p.header.info.list$meas.comment,
pts.per.prof = x3p.header.info.list$pts.per.prof,
num.prof = x3p.header.info.list$num.prof,
z.format = x3p.header.info.list$z.format,
data.bin.md5sumcheck = chk.sum #Generated above
)
options(warn=1) #Turn warnings on again
if(print.diagnosticsQ==T){
print(main.xml)
}
saveXML(main.xml,file=paste(tempdir(),fs,"ftmp",fs,"main.xml",sep=""))
chk.sum.main <- md5sum(paste(tempdir(),fs,"ftmp",fs,"main.xml",sep=""))
write(chk.sum.main, paste(tempdir(),fs,"ftmp",fs,"md5checksum.hex",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"){
system(paste("cd", paste(tempdir(),fs,"ftmp",fs,";",sep=""),
paste("zip ", fname, " bindata",fs,"data.bin main.xml md5checksum.hex;",sep=""),
paste("mv",fname,move.to.directory)
))
system(paste("rm -rf",paste(tempdir(),fs,"ftmp",fs,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.