#--------------------------------------------
#' @title Convert a Zeiss LMS file to an X3P format.
#'
#' @description Convert a Zeiss LMS file to an X3P format.
#'
#' @details Convert a Zeiss LMS file to an X3P format and writes the result to file. \code{move.to.directory}
#' is the path where to move the file. The file itself is initiall written to \code{tempdir()}.
#'
#' @param surf.info surface information returned from read.zeiss.lms.file
#' @param extra.file.info.list extra information required by ISO standards
#' @param comment.list optional comments on how the data was obtained.
#' @param fname name for the .x3p file to be written
#' @param move.to.directory path where to move the file.
#' @return Nothing.
#
#' @examples
#' file.path <- system.file("extdata", "glock.lms", package="x3pr")
#' glock.lms.info <- read.zeiss.lms.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.lms.info[[1]]$x.inc/1000, ", ",sep=""),
#' paste("Estimated Resolution y (meters) ", glock.lms.info[[1]]$y.inc/1000, ", ",sep=""),
#' paste("Estimated Resolution z (meters) ", glock.lms.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=""))
#'
#' lms2x3p.file(glock.sur.info, extra.header.info, comment.block, fname="testfile.x3p", move.to.directory=getwd())
#--------------------------------------------
lms2x3p.file <- function(surf.info, extra.file.info.list, comment.list, fname, move.to.directory){
head.info <- surf.info[[1]]
x.inc <- head.info["width.inc"][[1]]/1e6 #convert um to m #FIX ME ADD ERROR TRAP! IMPROVE
y.inc <- head.info["width.inc"][[1]]/1e6 #convert um to m #FIX ME ADD ERROR TRAP! IMPROVE
z.inc <- head.info["height.inc"][[1]]/1e6 #?? unit ?? FIX ME ADD ERROR TRAP! IMPROVE
num.pts.per.profile <- head.info["biwidth2"] #FIX ME COMPARE TO DIMS OF surface matrix IMPROVE
num.profile <- head.info["biheight2"] #FIX ME COMPARE TO DIMS OF surface matrix IMPROVE
#z.off <- head.info[["z.off"]][[1]]
z.off <- 0 #ASSUMES A 0 OFFSET FOR z. ALWAYS TRUE???? FIX
data.fpath <- paste(tempdir(),"/ftmp/bindata/data.bin",sep="")
#print(data.fpath)
#Make a temp directory for file assembly
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]
#print(chk.sum)
#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", #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
saveXML(main.xml,file=paste(tempdir(),"/ftmp/main.xml",sep=""))
chk.sum.main <- strsplit(system(paste("md5",paste(tempdir(),"/ftmp/main.xml",sep="")),intern=T)," ")[[1]][4]
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("mv",fname,move.to.directory)
))
system(paste("rm -rf",paste(tempdir(),"/ftmp/",sep=""))) #Remove directory structure
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.