openxlsx: Read, Write and Edit XLSX Files

#' @include class_definitions.R


Style$methods(initialize = function(){
  
  fontName <<- NULL
  fontColour <<- NULL
  fontSize <<- NULL
  fontFamily <<- NULL
  fontScheme <<- NULL
  fontDecoration <<- NULL
  
  borderTop <<- NULL
  borderLeft <<- NULL
  borderRight <<- NULL
  borderBottom <<- NULL
  borderTopColour <<- NULL
  borderLeftColour <<- NULL
  borderRightColour <<- NULL
  borderBottomColour <<- NULL
  borderDiagonal <<- NULL
  borderDiagonalColour <<- NULL
  borderDiagonalUp <<- FALSE
  borderDiagonalDown <<- FALSE
    
  halign <<- NULL
  valign <<- NULL
  indent <<- NULL
  textRotation <<- NULL
  numFmt <<- NULL
  fill <<- NULL
  wrapText <<- NULL
  hidden <<- NULL
  locked <<- NULL
  xfId <<- NULL
  
})



mergeStyle = function(oldStyle, newStyle){

  ## This function is used to merge an existing cell style with a new style to create a stacked style.
  oldStyle <- oldStyle$copy()
  
  if(!is.null(newStyle$fontName))
    oldStyle$fontName <- newStyle$fontName
  
  if(!is.null(newStyle$fontColour))
    oldStyle$fontColour <- newStyle$fontColour

  if(!is.null(newStyle$fontSize))
    oldStyle$fontSize <- newStyle$fontSize
  
  if(!is.null(newStyle$fontFamily))
    oldStyle$fontFamily <- newStyle$fontFamily
  
  if(!is.null(newStyle$fontScheme))
    oldStyle$fontScheme <- newStyle$fontScheme
  
  if(length(newStyle$fontDecoration) > 0){
    
    if(length(oldStyle$fontDecoration) == 0){
      oldStyle$fontDecoration <- newStyle$fontDecoration
    }else{
      oldStyle$fontDecoration <- c(oldStyle$fontDecoration, newStyle$fontDecoration)
    }
    
  }
    
  
  ## borders
  if(!is.null(newStyle$borderTop))
    oldStyle$borderTop <- newStyle$borderTop
  
  if(!is.null(newStyle$borderLeft))
    oldStyle$borderLeft <- newStyle$borderLeft
  
  if(!is.null(newStyle$borderRight))
    oldStyle$borderRight <- newStyle$borderRight
  
  if(!is.null(newStyle$borderBottom))
    oldStyle$borderBottom <- newStyle$borderBottom
  
  if(!is.null(newStyle$borderDiagonal))
    oldStyle$borderDiagonal <- newStyle$borderDiagonal
  
  oldStyle$borderDiagonalUp <- newStyle$borderDiagonalUp
  oldStyle$borderDiagonalDown <- newStyle$borderDiagonalDown
  
  
  if(!is.null(newStyle$borderTopColour))
    oldStyle$borderTopColour <- newStyle$borderTopColour
  
  if(!is.null(newStyle$borderLeftColour))
    oldStyle$borderLeftColour <- newStyle$borderLeftColour
  
  if(!is.null(newStyle$borderRightColour))
    oldStyle$borderRightColour <- newStyle$borderRightColour
  
  if(!is.null(newStyle$borderBottomColour))
    oldStyle$borderBottomColour <- newStyle$borderBottomColour
  
  
  
  ## other
  if(!is.null(newStyle$halign))
    oldStyle$halign <- newStyle$halign
  
  if(!is.null(newStyle$valign))
    oldStyle$valign <- newStyle$valign
  
  if(!is.null(newStyle$indent))
    oldStyle$indent <- newStyle$indent
  
  if(!is.null(newStyle$textRotation))
    oldStyle$textRotation <- newStyle$textRotation
  
  if(!is.null(newStyle$numFmt))
    oldStyle$numFmt <- newStyle$numFmt
  
  if(!is.null(newStyle$fill))
    oldStyle$fill <- newStyle$fill
  
  if(!is.null(newStyle$wrapText))
    oldStyle$wrapText <- newStyle$wrapText
    
  if(!is.null(newStyle$locked))
    oldStyle$locked <- newStyle$locked
  
  if(!is.null(newStyle$hidden))
    oldStyle$hidden <- newStyle$hidden
  
  if(!is.null(newStyle$xfId))
    oldStyle$xfId <- newStyle$xfId
  
    return(oldStyle)

}





Style$methods(show = function(print = TRUE){
 
  numFmtMapping <- list(list("numFmtId" = 0),
                        list("numFmtId" = 2),
                        list("numFmtId" = 164),
                        list("numFmtId" = 44),
                        list("numFmtId" = 14),
                        list("numFmtId" = 167),
                        list("numFmtId" = 10),
                        list("numFmtId" = 11),
                        list("numFmtId" = 49))
  
  validNumFmt <- c("GENERAL", "NUMBER", "CURRENCY", "ACCOUNTING", "DATE", "TIME", "PERCENTAGE", "SCIENTIFIC", "TEXT")
  
  if(!is.null(numFmt)){
    if(as.integer(numFmt$numFmtId) %in% unlist(numFmtMapping)){
      numFmtStr <- validNumFmt[unlist(numFmtMapping) == as.integer(numFmt$numFmtId)]
    }else{
      numFmtStr <- sprintf('"%s"', numFmt$formatCode)
    }
  }else{
    numFmtStr <- "GENERAL"
  }
  
  borders <- c(sprintf("Top: %s", borderTop), sprintf("Bottom: %s", borderBottom), sprintf("Left: %s", borderLeft), sprintf("Right: %s", borderRight))
  borderColours <- gsub("^FF", "#", c(borderTopColour, borderBottomColour, borderLeftColour, borderRightColour))

  fgFill <- fill$fillFg
  bgFill <- fill$fillBg

  styleShow <- "A custom cell style. \n\n"

  styleShow <- append(styleShow, sprintf("Cell formatting: %s \n", numFmtStr))  ## numFmt
  styleShow <- append(styleShow, sprintf("Font name: %s \n", fontName[[1]]))  ## Font name
  styleShow <- append(styleShow, sprintf("Font size: %s \n", fontSize[[1]]))  ## Font size
  styleShow <- append(styleShow, sprintf("Font colour: %s \n", gsub("^FF", "#", fontColour[[1]])))  ## Font colour
  
  ## Font decoration
  if(length(fontDecoration) > 0)
    styleShow <- append(styleShow, sprintf("Font decoration: %s \n", paste(fontDecoration, collapse = ", ")))
  
  if(length(borders) > 0){
    styleShow <- append(styleShow, sprintf("Cell borders: %s \n", paste(borders, collapse = ", ")))  ## Cell borders
    styleShow <- append(styleShow, sprintf("Cell border colours: %s \n", paste(borderColours, collapse = ", ")))  ## Cell borders
  }
  
  if(!is.null(halign))
    styleShow <- append(styleShow, sprintf("Cell horz. align: %s \n", halign))  ## Cell horizontal alignment
  
  if(!is.null(valign))
    styleShow <- append(styleShow, sprintf("Cell vert. align: %s \n", valign))  ## Cell vertical alignment 
  
  if(!is.null(indent))
    styleShow <- append(styleShow, sprintf("Cell indent: %s \n", indent))  ## Cell indent
  
  if(!is.null(textRotation))
    styleShow <- append(styleShow, sprintf("Cell text rotation: %s \n", textRotation))  ## Cell text rotation 
  
  ## Cell fill colour
  if(length(fgFill) > 0)
    styleShow <- append(styleShow, sprintf("Cell fill foreground: %s \n", paste(paste0(names(fgFill),": ", sub("^FF", "#", fgFill)), collapse = ", ")))
  
  if(length(bgFill) > 0)
    styleShow <- append(styleShow, sprintf("Cell fill background: %s \n", paste(paste0(names(bgFill),": ", sub("^FF", "#", bgFill)), collapse = ", ")))
  
  if(!is.null(locked))
    styleShow <- append(styleShow, sprintf("Cell protection: %s \n", locked))  ## Cell protection
  if(!is.null(hidden))
    styleShow <- append(styleShow, sprintf("Cell formula hidden: %s \n", hidden))  ## Cell formula hidden
  
  styleShow <- append(styleShow, sprintf("wraptext: %s", wrapText))  ## wrap text
  
  styleShow <- c(styleShow, "\n\n")

  if(print)
    cat(styleShow)
  
  return(invisible(styleShow))
  
})
  

          

Style$methods(as.list = function(){
  
  l <- list(
  "fontName" = fontName,
  "fontColour" = fontColour,
  "fontSize" = fontSize,
  "fontFamily" = fontFamily,
  "fontScheme" = fontScheme,
  "fontDecoration" = fontDecoration,
  
  "borderTop" = borderTop,
  "borderLeft" = borderLeft,
  "borderRight" = borderRight,
  "borderBottom" = borderBottom,
  "borderTopColour" = borderTopColour,
  "borderLeftColour" = borderLeftColour,
  "borderRightColour" = borderRightColour,
  "borderBottomColour" = borderBottomColour,
  
  "halign" = halign,
  "valign" = valign,
  "indent" = indent,
  "textRotation" = textRotation,
  "numFmt" = numFmt,
  "fillFg" = fill$fillFg,
  "fillBg" = fill$fillBg,
  "wrapText" = wrapText,
  "locked" = locked,
  "hidden" = hidden,
  "xfId" = xfId
  )
  
  l[sapply(l, length) > 0]
  
})