Change nasty black background to a nicer colour when emf transparency doesn't work

EMFBitmapBGColour.r

EMFBitmapBGColour <- function (filename, background = 0, replacementColour = -1) {
# by martin graham 6th feb 2019
  
  # need to integerise these values explicitly or they change the type of id when inserted
  # which then means mangled values are written back to file
  background <- as.integer (background)
  replacementColour <- as.integer (replacementColour)

  # read emf file
  fullFileName <- paste0(filename)
  myfile <- file (fullFileName, "rb")
  id <- readBin(myfile, integer(0), n = file.info(fullFileName)$size, size=4, endian='little')
  close (myfile)
  
  recordPos <- 1L # R vectors are 1-based
  recordSize <- 0
  recordType <- 0
  convCount <- 0
  
  while (recordType != 0x0000000e) {   # 0x0e is EOF record
    # first four-byte word of emf record is always its type
    recordType = id[recordPos]
    # second four-byte word of emf record is always its size
    recordSize <- ceiling(id[recordPos + 1] / 4); # /4 cos id is 4-bytes per integer
    #print (paste(recordPos, recordSize, recordType, sep=", "))
  
    if (recordType == 0x00000051) {   # 0x51 is EMRSTRETCHDIBITS bitmap type record
      # get offsets
      woffset <- id[recordPos + 14] / 4; # /4 cos id is 4-bytes per integer
      wsize <- id[recordPos + 15] / 4;
      
      # get subset of array
      start <- recordPos + woffset;
      end <- recordPos + woffset + wsize;
      
      # replace 
      bid <- id[start:end]
      bid[bid==background] <- replacementColour;
      id[start:end] = bid;
      
      convCount = convCount + 1
    }
    
    # swing to next record position using this record's size value
    recordPos = recordPos + recordSize;
  }
  
  # write out
  newFileName <- paste(tools::file_path_sans_ext(fullFileName), "New.emf", sep="")
  con <- file(newFileName, 'wb')
  on.exit(close(con)) # close file when finished, note: only one on.exit per function can be declared
  writeBin (id, con, size=4, endian="little")
  flush (con)
  
  # return this list
  list("conversionCount" = convCount);
}