Write functionality for X3P surface metrology format

Documented in sur2x3p.file

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

}