R/write.x3p.R

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

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