R/lms2x3p.file.R

In npetraco/x3pr: Read/Write functionality for X3P surface metrology format

#--------------------------------------------
#' @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
  
  
}