# tags with namespaces ----

wp_ns_yes <- "<w:p xmlns:w=\"http://schemas.openxmlformats.org/wordprocessingml/2006/main\" xmlns:wp=\"http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing\" xmlns:r=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships\" xmlns:w14=\"http://schemas.microsoft.com/office/word/2010/wordml\">"
wp_ns_no <- "<w:p>"

tbl_ns_yes <- "<w:tbl xmlns:w=\"http://schemas.openxmlformats.org/wordprocessingml/2006/main\" xmlns:wp=\"http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing\" xmlns:r=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships\">"
tbl_ns_no <- "<w:tbl>"

wr_ns_yes <- "<w:r xmlns:w=\"http://schemas.openxmlformats.org/wordprocessingml/2006/main\" xmlns:wp=\"http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing\" xmlns:r=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships\" xmlns:w14=\"http://schemas.microsoft.com/office/word/2010/wordml\">"
wr_ns_no <- "<w:r>"

ar_ns_yes <- "<a:r xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\" xmlns:r=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships\" xmlns:p=\"http://schemas.openxmlformats.org/presentationml/2006/main\">"
ar_ns_no <- "<a:r>"

ap_ns_yes <- "<a:p xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\" xmlns:r=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships\" xmlns:p=\"http://schemas.openxmlformats.org/presentationml/2006/main\">"
ap_ns_no <- "<a:p>"

psp_ns_yes <- "<p:sp xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\" xmlns:r=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships\" xmlns:p=\"http://schemas.openxmlformats.org/presentationml/2006/main\">"
psp_ns_no <- "<p:sp>"

# utils -----
runs_to_p_wml <- function(..., add_ns = FALSE, style_id = NULL) {
  runs <- list(...)
  run_str <- lapply(runs, to_wml, add_ns = FALSE)
  run_str$collapse <- ""
  run_str <- do.call(paste0, run_str)
  open_tag <- wp_ns_no
  if (add_ns) {
    open_tag <- wp_ns_yes
  }

  if (!is.null(style_id)) {
    ppr <- paste0("<w:pPr><w:pStyle w:val=\"", style_id, "\"/></w:pPr>")
  } else {
    ppr <- "<w:pPr/>"
  }
  out <- paste0(open_tag, ppr, run_str, "</w:p>")
  out
}


a_xfrm_str <- function(left = 0, top = 0, width = 3, height = 3, rot = 0) {
  start_tag <- "<a:xfrm>"
  if (!is.null(rot) && !is.na(rot) && rot != 0) {
    start_tag <- sprintf("<a:xfrm rot=\"%.0f\">", -rot * 60000)
  }

  xfrm_str <- paste0(
    start_tag,
    "<a:off x=\"%.0f\" y=\"%.0f\"/><a:ext cx=\"%.0f\" cy=\"%.0f\"/></a:xfrm>"
  )
  sprintf(
    xfrm_str,
    left * 914400,
    top * 914400,
    width * 914400,
    height * 914400
  )
}

p_xfrm_str <- function(left = 0, top = 0, width = 3, height = 3, rot = 0) {
  if (is.null(rot) || !is.finite(rot)) {
    rot <- 0
  }

  xfrm_str <- "<p:xfrm rot=\"%.0f\"><a:off x=\"%.0f\" y=\"%.0f\"/><a:ext cx=\"%.0f\" cy=\"%.0f\"/></p:xfrm>"
  sprintf(
    xfrm_str,
    -rot * 60000,
    left * 914400,
    top * 914400,
    width * 914400,
    height * 914400
  )
}


# colors ----

css_color <- function(color) {
  color <- as.vector(col2rgb(color, alpha = TRUE)) / c(1, 1, 1, 255)

  if (!(color[4] > 0)) {
    "transparent"
  } else {
    sprintf(
      "rgba(%.0f,%.0f,%.0f,%.2f)",
      color[1],
      color[2],
      color[3],
      color[4]
    )
  }
}
hex_color <- function(color) {
  color <- as.vector(col2rgb(color, alpha = TRUE)) / c(1, 1, 1, 255)
  sprintf(
    "%02X%02X%02X",
    color[1],
    color[2],
    color[3]
  )
}
colalpha <- function(x) {
  if ("transparent" %in% x) {
    return(0)
  }
  alpha <- as.vector(col2rgb(x, alpha = TRUE))[4] / 255
  alpha
}

is_transparent <- function(color) {
  !(colalpha(color) > 0)
}

solid_fill <- function(color) {
  sprintf(
    paste0(
      "<a:solidFill><a:srgbClr val=\"%s\">",
      "<a:alpha val=\"%.0f\"/>",
      "</a:srgbClr></a:solidFill>"
    ),
    hex_color(color),
    colalpha(color) * 100000
  )
}

solid_fill_pml <- function(bg) {
  bg_str <- ""
  if (!is.null(bg)) {
    bg_str <- solid_fill(bg)
  }
  bg_str
}

# geom ----

prst_geom_pml <- function(x) {
  geom_str <- ""
  if (!is.null(x)) {
    x <- check_set_geom(x)
    tagname <- paste0("a:prstGeom")
    geom_str <- sprintf("<%s prst=\"%s\"><a:avLst/></%s>", tagname, x, tagname)
  }
  geom_str
}

# line ----

ln_pml <- function(x) {
  ln_str <- ""
  if (!is.null(x)) {
    color_ <- ""
    if (is_transparent(x$color) || x$lwd < .001) {
      color_ <- "<a:noFill/>"
    } else {
      color_ <- solid_fill(x$color)
    }

    dash_ <- dash_pml(x$lty)
    join_ <- linejoin_pml(x$linejoin)
    head_ <- lineend_pml(x$headend, "head")
    tail_ <- lineend_pml(x$tailend, "tail")

    ln_str <- sprintf(
      paste0(
        "<a:ln w=\"%s\" cap=\"%s\" cmpd=\"%s\">",
        color_,
        dash_,
        join_,
        head_,
        tail_,
        "</a:ln>"
      ),
      12700 * x$lwd,
      x$lineend,
      x$linecmpd
    )
  }
  ln_str
}

lineend_pml <- function(x, side) {
  lineend_str <- ""
  if (!is.null(x)) {
    tagname <- paste0("a:", side, "End")
    lineend_str <- sprintf(
      "<%s type=\"%s\" w=\"%s\" len=\"%s\"/>",
      tagname,
      x$type,
      x$width,
      x$length
    )
  }
  lineend_str
}

dash_pml <- function(x) {
  dash_str <- ""
  if (!is.null(x)) {
    dash_str <- sprintf("<a:prstDash val=\"%s\"/>", x)
  }
  dash_str
}

linejoin_pml <- function(x) {
  linejoin_str <- ""
  if (!is.null(x)) {
    linejoin_str <- sprintf("<a:%s/>", x)
  }
  linejoin_str
}

# border ----

border_pml <- function(x, side) {
  tagname <- paste0("a:ln", side)

  width_ <- sprintf("w=\"%.0f\"", x$width * 12700)

  if (is_transparent(x$color) || x$width < .001) {
    color_ <- "<a:noFill/>"
  } else {
    color_ <- solid_fill(x$color)
  }

  if (!x$style %in% c("dotted", "dashed", "solid")) {
    x$style <- "solid"
  }
  if ("dotted" %in% x$style) {
    x$style <- "sysDot"
  } else if ("dashed" %in% x$style) {
    x$style <- "sysDash"
  }

  style_ <- sprintf("<a:prstDash val=\"%s\"/>", x$style)

  paste0(
    "<",
    tagname,
    " ",
    "algn=\"ctr\" cmpd=\"sng\" cap=\"flat\"",
    " ",
    width_,
    ">",
    color_,
    style_,
    "</",
    tagname,
    ">"
  )
}


border_wml <- function(x, side) {
  tagname <- paste0("w:", side)
  x$style[x$style %in% "solid"] <- "single"
  x$style[x$style %in% "ridge"] <- "threeDEmboss"
  x$style[x$style %in% "groove"] <- "threeDEngrave"
  if (!x$style %in% border_styles) {
    x$style <- "single"
  }
  if (x$width < 0.0001 || is_transparent(x$color)) {
    x$style <- "none"
  }

  style_ <- sprintf("w:val=\"%s\"", x$style)
  width_ <- sprintf("w:sz=\"%.0f\"", x$width * 8)
  color_ <- sprintf("w:color=\"%s\"", hex_color(x$color))

  paste0(
    "<",
    tagname,
    " ",
    style_,
    " ",
    width_,
    " ",
    "w:space=\"0\"",
    " ",
    color_,
    "/>"
  )
}
border_css <- function(x, side) {
  color_ <- css_color(x$color)
  if (!(x$width > 0)) {
    color_ <- "transparent"
  }

  width_ <- sprintf("%.02fpt", x$width)

  x$style[x$style %in% "threeDEmboss"] <- "ridge"
  x$style[x$style %in% "threeDEngrave"] <- "groove"
  x$style[x$style %in% "nil"] <- "none"

  if (
    !x$style %in%
      c(
        "dotted",
        "dashed",
        "solid",
        "double",
        "inset",
        "outset",
        "ridge",
        "groove",
        "none"
      )
  ) {
    x$style <- "solid"
  }
  paste0("border-", side, ": ", width_, " ", x$style, " ", color_, ";")
}

# ppr ----
ppr_pml <- function(x) {
  align <- ""
  if (!is.na(x$text.align)) {
    align <- " algn=\"r\""
    if (x$text.align == "left") {
      align <- " algn=\"l\""
    } else if (x$text.align == "center") {
      align <- " algn=\"ctr\""
    } else if (x$text.align == "justify") {
      align <- " algn=\"just\""
    }
  }

  leftright_padding <- ""
  if (!is.na(x$padding.left) && !is.na(x$padding.right)) {
    leftright_padding <- sprintf(
      " marL=\"%.0f\" marR=\"%.0f\"",
      x$padding.left * 12700,
      x$padding.right * 12700
    )
  }

  top_padding <- ""
  if (!is.na(x$padding.top)) {
    top_padding <- sprintf(
      "<a:spcBef><a:spcPts val=\"%.0f\" /></a:spcBef>",
      x$padding.top * 100
    )
  }
  bottom_padding <- ""
  if (!is.na(x$padding.bottom)) {
    bottom_padding <- sprintf(
      "<a:spcAft><a:spcPts val=\"%.0f\" /></a:spcAft>",
      x$padding.bottom * 100
    )
  }
  line_spacing <- ""
  if (!is.na(x$line_spacing)) {
    line_spacing <- sprintf(
      "<a:lnSpc><a:spcPct val=\"%.0f\"/></a:lnSpc>",
      x$line_spacing * 100000
    )
  }

  paste0(
    "<a:pPr",
    align,
    leftright_padding,
    ">",
    line_spacing,
    top_padding,
    bottom_padding,
    "<a:buNone/>",
    "</a:pPr>"
  )
}

ppr_css <- function(x) {
  text.align <- sprintf("text-align:%s;", x$text.align)
  borders <- paste0(
    border_css(x$border.bottom, "bottom"),
    border_css(x$border.top, "top"),
    border_css(x$border.left, "left"),
    border_css(x$border.right, "right")
  )

  paddings <- sprintf(
    "padding-top:%.0fpt;padding-bottom:%.0fpt;padding-left:%.0fpt;padding-right:%.0fpt;",
    x$padding.top,
    x$padding.bottom,
    x$padding.left,
    x$padding.right
  )
  ls <- formatC(
    x$line_spacing,
    format = "f",
    digits = 2,
    decimal.mark = ".",
    drop0trailing = TRUE
  )
  line_spacing <- sprintf("line-height: %s;", ls)

  shading.color <- sprintf("background-color:%s;", css_color(x$shading.color))

  paste0(
    "margin:0pt;",
    text.align,
    borders,
    paddings,
    line_spacing,
    shading.color
  )
}

ppr_wml <- function(x) {
  if ("justify" %in% x$text.align) {
    x$text.align <- "both"
  }
  pstyle <- ""
  if (!is.null(x$word_style) && !is.na(x$word_style)) {
    pstyle <- sprintf("<w:pStyle w:pstlname=\"%s\"/>", x$word_style)
  }
  tabs <- ""
  if (!is.null(x$tabs) && !isFALSE(x$tabs)) {
    tabs <- to_wml(x$tabs)
  }

  text_align_ <- ""
  if (!is.na(x$text.align)) {
    text_align_ <- sprintf("<w:jc w:val=\"%s\"/>", x$text.align)
  }

  keep_with_next <- ""
  if (isTRUE(x$keep_with_next)) {
    keep_with_next <- "<w:keepNext/>"
  }

  borders_ <- ""
  if (
    !is.null(x$border.top) &&
      !isFALSE(x$border.top) &&
      !is.null(x$border.bottom) &&
      !isFALSE(x$border.bottom) &&
      !is.null(x$border.left) &&
      !isFALSE(x$border.left) &&
      !is.null(x$border.right) &&
      !isFALSE(x$border.right)
  ) {
    borders_ <- paste0(
      "<w:pBdr>",
      border_wml(x$border.bottom, "bottom"),
      border_wml(x$border.top, "top"),
      border_wml(x$border.left, "left"),
      border_wml(x$border.right, "right"),
      "</w:pBdr>"
    )
  }

  leftright_padding <- ""
  if (!is.na(x$padding.left) && !is.na(x$padding.right)) {
    leftright_padding <- sprintf(
      "<w:ind w:left=\"%.0f\" w:right=\"%.0f\" w:firstLine=\"0\" w:firstLineChars=\"0\"/>",
      x$padding.left * 20,
      x$padding.right * 20
    )
  }

  topbot_spacing <- ""
  if (
    !is.na(x$padding.bottom) && !is.na(x$padding.top) && !is.na(x$line_spacing)
  ) {
    topbot_spacing <- sprintf(
      "<w:spacing w:after=\"%.0f\" w:before=\"%.0f\" w:line=\"%.0f\"/>",
      x$padding.bottom * 20,
      x$padding.top * 20,
      x$line_spacing * 240
    )
  }

  shading_ <- ""
  if (!is_transparent(x$shading.color)) {
    shading_ <- sprintf(
      "<w:shd w:val=\"clear\" w:color=\"auto\" w:fill=\"%s\"/>",
      hex_color(x$shading.color)
    )
  }

  paste0(
    "<w:pPr>",
    pstyle,
    text_align_,
    keep_with_next,
    borders_,
    tabs,
    topbot_spacing,
    leftright_padding,
    shading_,
    "</w:pPr>"
  )
}


# rpr ----

rpr_pml <- function(x) {
  if (is_transparent(x$color)) {
    return("")
  }

  out <- "<a:rPr cap=\"none\""

  if (!is.na(x$font.size)) {
    if (x$font.size > 0) {
      out <- paste0(out, sprintf(" sz=\"%.0f\"", x$font.size * 100))
    }
  }

  if (!is.na(x$italic)) {
    if (x$italic) {
      out <- paste0(out, " i=\"1\"")
    } else {
      out <- paste0(out, " i=\"0\"")
    }
  }

  if (!is.na(x$bold)) {
    if (x$bold) {
      out <- paste0(out, " b=\"1\"")
    } else {
      out <- paste0(out, " b=\"0\"")
    }
  }

  if (!is.na(x$underlined)) {
    if (x$underlined) {
      out <- paste0(out, " u=\"sng\"")
    } else {
      out <- paste0(out, " u=\"none\"")
    }
  }

  has_strike <- !is.null(x$strike) && !is.na(x$strike) && x$strike
  if (has_strike) {
    out <- paste0(out, " strike=\"sngStrike\"")
  } else {
    out <- paste0(out, " strike=\"noStrike\"")
  }

  if (x$vertical.align == "superscript") {
    out <- paste0(out, " baseline=\"40000\"")
  } else if (x$vertical.align == "subscript") {
    out <- paste0(out, " baseline=\"-40000\"")
  }
  out <- paste0(out, ">")

  if (!is.na(x$color)) {
    out <- paste0(out, solid_fill(x$color))

    if (!is_transparent(x$shading.color)) {
      shad <- sprintf(
        paste0(
          "<a:highlight><a:srgbClr val=\"%s\">",
          "<a:alpha val=\"%.0f\"/>",
          "</a:srgbClr></a:highlight>"
        ),
        hex_color(x$shading.color),
        colalpha(x$shading.color) * 100000
      )
      out <- paste0(out, shad)
    }
  }

  out <- paste0(
    out,
    if (!is.na(x$font.family)) {
      sprintf("<a:latin typeface=\"%s\"/>", x$font.family)
    },
    if (!is.na(x$cs.family)) sprintf("<a:cs typeface=\"%s\"/>", x$cs.family),
    if (!is.na(x$eastasia.family)) {
      sprintf("<a:ea typeface=\"%s\"/>", x$eastasia.family)
    },
    if (!is.na(x$hansi.family)) {
      sprintf("<a:sym typeface=\"%s\"/>", x$hansi.family)
    }
  )

  out <- paste0(out, "</a:rPr>")
  out
}

rpr_wml <- function(x) {
  out <- paste0(
    "<w:rPr><w:rFonts",
    if (!is.na(x$font.family)) paste0(" w:ascii=\"", x$font.family, "\""),
    if (!is.na(x$hansi.family)) paste0(" w:hAnsi=\"", x$hansi.family, "\""),
    if (!is.na(x$eastasia.family)) {
      paste0(" w:eastAsia=\"", x$eastasia.family, "\"")
    },
    if (!is.na(x$cs.family)) paste0(" w:cs=\"", x$cs.family, "\""),
    "/>"
  )

  if (!is.na(x$italic)) {
    if (x$italic) {
      out <- paste0(out, "<w:i w:val=\"true\"/>")
    } else {
      out <- paste0(out, "<w:i w:val=\"false\"/>")
    }
  }

  if (!is.na(x$bold)) {
    if (x$bold) {
      out <- paste0(out, "<w:b w:val=\"true\"/>")
    } else {
      out <- paste0(out, "<w:b w:val=\"false\"/>")
    }
  }
  if (!is.na(x$underlined)) {
    if (x$underlined) {
      out <- paste0(out, "<w:u w:val=\"single\"/>")
    } else {
      out <- paste0(out, "<w:u w:val=\"none\"/>")
    }
  }

  has_strike <- !is.null(x$strike) && !is.na(x$strike) && x$strike
  if (has_strike) {
    out <- paste0(out, "<w:strike w:val=\"true\"/>")
  } else {
    out <- paste0(out, "<w:strike w:val=\"false\"/>")
  }

  if (x$vertical.align == "superscript") {
    out <- paste0(out, "<w:vertAlign w:val=\"superscript\"/>")
  } else if (x$vertical.align == "subscript") {
    out <- paste0(out, "<w:vertAlign w:val=\"subscript\"/>")
  }

  if (!is.na(x$font.size)) {
    out <- paste0(
      out,
      sprintf(
        "<w:sz w:val=\"%.0f\"/><w:szCs w:val=\"%.0f\"/>",
        x$font.size * 2,
        x$font.size * 2
      )
    )
  }

  if (!is.na(x$color)) {
    out <- paste0(
      out,
      sprintf("<w:color w:val=\"%s\"/>", hex_color(x$color))
    )
  }

  if (!is.na(x$shading.color)) {
    if (is.na(x$color)) {
      stop("shading.color must be used **with** a color.")
    }
    if (!is_transparent(x$shading.color)) {
      out <- paste0(
        out,
        sprintf(
          "<w:shd w:val=\"clear\" w:color=\"auto\" w:fill=\"%s\"/>",
          hex_color(x$shading.color)
        )
      )
    }
    if (colalpha(x$color) < 1) {
      out <- paste0(
        out,
        sprintf(
          paste0(
            "<w14:textFill><w14:solidFill><w14:srgbClr val=\"%s\">",
            "<w14:alpha val=\"%.0f\"/>",
            "</w14:srgbClr></w14:solidFill></w14:textFill>"
          ),
          hex_color(x$color),
          colalpha(x$color) * 100000
        )
      )
    }
  }

  out <- paste0(out, "</w:rPr>")
  out
}

rpr_css <- function(x) {
  out <- ""

  if (!is.na(x$font.family)) {
    out <- paste0(out, sprintf("font-family:'%s';", x$font.family))
  }
  if (!is.na(x$color)) {
    out <- paste0(out, sprintf("color:%s;", css_color(x$color)))
  }
  if (!is.na(x$font.size)) {
    out <- paste0(out, sprintf("font-size:%0.1fpt;", x$font.size))
  }

  if (!is.na(x$italic)) {
    if (x$italic) {
      out <- paste0(out, "font-style:italic;")
    } else {
      out <- paste0(out, "font-style:normal;")
    }
  }

  if (!is.na(x$bold)) {
    if (x$bold) {
      out <- paste0(out, "font-weight:bold;")
    } else {
      out <- paste0(out, "font-weight:normal;")
    }
  }

  has_underline <- !is.na(x$underlined) && x$underlined
  if (has_underline) {
    out <- paste0(out, "text-decoration:underline;")
  }

  has_strike <- !is.null(x$strike) && !is.na(x$strike) && x$strike
  if (has_strike) {
    out <- paste0(out, "text-decoration:line-through;")
  }

  if (!is.na(x$shading.color)) {
    if (!is_transparent(x$shading.color)) {
      out <- paste0(
        out,
        sprintf("background-color:%s;", css_color(x$shading.color))
      )
    } else {
      out <- paste0(out, "background-color:transparent;")
    }
  }

  if (x$vertical.align == "superscript") {
    out <- paste0(out, "vertical-align: super;")
  } else if (x$vertical.align == "subscript") {
    out <- paste0(out, "vertical-align: sub;")
  }

  out
}
# tcpr ----

tcpr_pml <- function(x) {
  text.direction <-
    if (x$text.direction %in% "btlr") {
      " vert=\"vert270\""
    } else if (x$text.direction %in% "tbrl") {
      " vert=\"vert\""
    } else {
      ""
    }

  vertical.align <-
    if (x$vertical.align %in% "center") {
      " anchor=\"ctr\""
    } else if (x$vertical.align %in% "top") {
      " anchor=\"t\""
    } else {
      " anchor=\"b\""
    }

  margins <- sprintf(
    " marB=\"%.0f\" marT=\"%.0f\" marR=\"%.0f\" marL=\"%.0f\"",
    x$margin.bottom * 12700,
    x$margin.top * 12700,
    x$margin.right * 12700,
    x$margin.left * 12700
  )

  background.color <- paste0(
    sprintf(
      "<a:solidFill><a:srgbClr val=\"%s\">",
      hex_color(x$background.color)
    ),
    sprintf("<a:alpha val=\"%.0f\"/>", colalpha(x$background.color) * 100000),
    "</a:srgbClr></a:solidFill>"
  )

  bb <- border_pml(x$border.bottom, side = "B")
  bt <- border_pml(x$border.top, side = "T")
  bl <- border_pml(x$border.left, side = "L")
  br <- border_pml(x$border.right, side = "R")

  pml_attrs <- paste0(text.direction, vertical.align, margins)
  paste0(
    "<a:tcPr",
    pml_attrs,
    ">",
    bl,
    br,
    bt,
    bb,
    background.color,
    "</a:tcPr>"
  )
}

tcpr_wml <- function(x) {
  background.color <- sprintf(
    "<w:shd w:val=\"clear\" w:color=\"auto\" w:fill=\"%s\"/>",
    hex_color(x$background.color)
  )
  vertical.align <- ifelse(
    x$vertical.align %in% c("center", "top"),
    sprintf("<w:vAlign w:val=\"%s\"/>", x$vertical.align),
    "<w:vAlign w:val=\"bottom\"/>"
  )
  text.direction <- ifelse(
    x$text.direction %in% "btlr",
    "<w:textDirection w:val=\"btLr\"/>",
    ifelse(
      x$text.direction %in% "tbrl",
      "<w:textDirection w:val=\"tbRl\"/>",
      ""
    )
  )

  bb <- border_wml(x$border.bottom, side = "bottom")
  bt <- border_wml(x$border.top, side = "top")
  bl <- border_wml(x$border.left, side = "left")
  br <- border_wml(x$border.right, side = "right")

  margin.bottom <- sprintf(
    "<w:bottom w:w=\"%.0f\" w:type=\"dxa\"/>",
    x$margin.bottom * 20
  )
  margin.top <- sprintf(
    "<w:top w:w=\"%.0f\" w:type=\"dxa\"/>",
    x$margin.top * 20
  )
  margin.left <- sprintf(
    "<w:left w:w=\"%.0f\" w:type=\"dxa\"/>",
    x$margin.left * 20
  )
  margin.right <- sprintf(
    "<w:right w:w=\"%.0f\" w:type=\"dxa\"/>",
    x$margin.right * 20
  )

  rowspan <- ""
  if (x$rowspan > 1) {
    rowspan <- paste0("<w:gridSpan w:val=\"", x$rowspan, "\"/>")
  }
  colspan <- ""
  if (x$colspan > 1) {
    colspan <- "<w:vMerge w:val=\"restart\"/>"
  } else if (x$colspan < 1) {
    colspan <- "<w:vMerge/>"
  }

  paste0(
    "<w:tcPr>",
    rowspan,
    colspan,
    "<w:tcBorders>",
    bb,
    bt,
    bl,
    br,
    "</w:tcBorders>",
    background.color,
    "<w:tcMar>",
    margin.top,
    margin.bottom,
    margin.left,
    margin.right,
    "</w:tcMar>",
    text.direction,
    vertical.align,
    "</w:tcPr>"
  )
}

css_px <- function(x, format = "%.0fpx") {
  ifelse(is.na(x), "inherit", ifelse(x < 0.001, "0", sprintf(format, x)))
}

tcpr_css <- function(x) {
  background.color <- ifelse(
    colalpha(x$background.color) > 0,
    sprintf(
      "background-clip: padding-box;background-color:%s;",
      css_color(x$background.color)
    ),
    "background-color:transparent;"
  )

  width <- ifelse(
    is.null(x$width) || is.na(x$width),
    "",
    sprintf("width:%s;", css_px(x$width * 72))
  )
  height <- ifelse(
    is.null(x$height) || is.na(x$height),
    "",
    sprintf("height:%s;", css_px(x$height * 72))
  )
  vertical.align <- ifelse(
    x$vertical.align %in% "center",
    "vertical-align:middle;",
    ifelse(
      x$vertical.align %in% "top",
      "vertical-align:top;",
      "vertical-align:bottom;"
    )
  )

  bb <- border_css(x$border.bottom, side = "bottom")
  bt <- border_css(x$border.top, side = "top")
  bl <- border_css(x$border.left, side = "left")
  br <- border_css(x$border.right, side = "right")

  margin.bottom <- sprintf(
    "margin-bottom:%s;",
    sprintf("%.0fpt", x$margin.bottom)
  )
  margin.top <- sprintf("margin-top:%s;", sprintf("%.0fpt", x$margin.top))
  margin.left <- sprintf("margin-left:%s;", sprintf("%.0fpt", x$margin.left))
  margin.right <- sprintf("margin-right:%s;", sprintf("%.0fpt", x$margin.right))

  paste0(
    width,
    height,
    background.color,
    vertical.align,
    bb,
    bt,
    bl,
    br,
    margin.bottom,
    margin.top,
    margin.left,
    margin.right
  )
}
