tests/testthat/test-pptx-add-geom-ln.R

In davidgohel/officer: Manipulation of Microsoft Word and PowerPoint Documents

test_that("add outline to placeholder", {
  sp_line_ <- list(
    sp_line(color = "#FFFF00", lwd = 4.5, lty = "solid", linecmpd = "sng"),
    sp_line(color = "black", lwd = 9, lty = "dash", linecmpd = "dbl")
  )
  width <- 4; height <- 3; top <- 7.5 / 2 - height / 2
  left <- c(1, 10 - width - 1);

  loc_ <- lapply(seq_along(sp_line_), function(x) ph_location(left = left[x], top = top, width = width, height = height, bg = "orange", ln = sp_line_[[x]]))

  doc <- read_pptx()
  doc <- add_slide(doc, layout = "Title and Content", master = "Office Theme")
  doc <- ph_with(doc, "Box with solid outline", location = loc_[[1]])
  doc <- ph_with(doc, "Box with dashed double outline", location = loc_[[2]])

  sm <- slide_summary(doc)
  expect_equal(nrow(sm), 2)
  expect_equal(sm$text, c("Box with solid outline", "Box with dashed double outline"))

  xmldoc <- doc$slide$get_slide(id = 1)$get()
  cols <- xml_attr(xml_find_all(xmldoc, "//a:ln/a:solidFill/a:srgbClr"), "val")
  expect_equal(cols, c("FFFF00", "000000") )
  expect_equal( xml_attr(xml_find_all(xmldoc, "//a:ln"), "w"), as.character(c(4.5, 9) * 12700))
  expect_equal( xml_attr(xml_find_all(xmldoc, "//a:ln"), "cmpd"), c("sng", "dbl"))
  expect_equal( xml_attr(xml_find_all(xmldoc, "//a:ln/a:prstDash"), "val"), c("solid", "dash"))
})

test_that("add geometry to placeholder", {
  sp_line_ <- sp_line(color = "#FFFF00", lwd = 4.5, lty = "solid", linecmpd = "sng")

  width <- 4; height <- 3; top <- 7.5 / 2 - height / 2
  left <- c(1, 10 - width - 1);

  loc_ <- list(
    ph_location(left = left[1], top = top, width = width, height = height, bg = "orange", ln = sp_line_, geom = "roundRect"),
    ph_location(left = left[2], top = top, width = width, height = height, bg = "steelblue", ln = sp_line_, geom = "trapezoid")
  )

  doc <- read_pptx()
  doc <- add_slide(doc, layout = "Title and Content", master = "Office Theme")
  doc <- ph_with(doc, "Round Rectangle", location = loc_[[1]])
  doc <- ph_with(doc, "Trapezoid", location = loc_[[2]])

  sm <- slide_summary(doc)
  expect_equal(nrow(sm), 2)
  expect_equal(sm$text, c("Round Rectangle", "Trapezoid"))

  xmldoc <- doc$slide$get_slide(id = 1)$get()
  cols <- xml_attr(xml_find_all(xmldoc, "//p:spPr/a:solidFill/a:srgbClr"), "val")
  expect_equal(cols, c("FFA500", "4682B4") )
  expect_equal( xml_attr(xml_find_all(xmldoc, "//a:prstGeom"), "prst"), c("roundRect", "trapezoid"))
  cols <- xml_attr(xml_find_all(xmldoc, "//a:ln/a:solidFill/a:srgbClr"), "val")
  expect_equal(cols, c("FFFF00", "FFFF00") )
  expect_equal( xml_attr(xml_find_all(xmldoc, "//a:ln"), "w"), as.character(c(4.5, 4.5) * 12700))
  expect_equal( xml_attr(xml_find_all(xmldoc, "//a:ln/a:prstDash"), "val"), c("solid", "solid"))
})

test_that("add line geometry with lineends", {

  headend <- sp_lineend(type = "oval", width = "sm", length = "sm")
  tailend <- sp_lineend(type = "triangle", width = "lg", length = "lg")

  sp_line1 <- sp_line(color = "steelblue", lwd = 4.5, lty = "solid", linecmpd = "sng", headend = headend, tailend = tailend)
  sp_line2 <- update(sp_line1, linecmpd = "dbl", headend = tailend, tailend = headend)

  width <- 4; height <- 3
  top <- 7.5 / 2 - height / 2; left <- c(1, 10 - width - 1)

  loc_ <- list(
    ph_location(left = left[1], top = top, width = width, height = height, ln = sp_line1, geom = "line"),
    ph_location(left = left[2], top = top, width = width, height = height, ln = sp_line2, rotation = 180, geom = "line")
  )

  doc <- read_pptx()
  doc <- add_slide(doc, layout = "Title and Content", master = "Office Theme")
  doc <- ph_with(doc, "", location = loc_[[1]])
  doc <- ph_with(doc, "", location = loc_[[2]])

  sm <- slide_summary(doc)
  expect_equal(nrow(sm), 2)

  xmldoc <- doc$slide$get_slide(id = 1)$get()
  expect_equal( xml_attr(xml_find_all(xmldoc, "//a:prstGeom"), "prst"), c("line", "line"))
  cols <- xml_attr(xml_find_all(xmldoc, "//a:ln/a:solidFill/a:srgbClr"), "val")
  expect_equal(cols, c("4682B4", "4682B4") )
  expect_equal( xml_attr(xml_find_all(xmldoc, "//a:ln"), "cmpd"), c("sng", "dbl"))
  expect_equal( xml_attr(xml_find_all(xmldoc, "//a:headEnd"), "type"), c("oval", "triangle"))
  expect_equal( xml_attr(xml_find_all(xmldoc, "//a:tailEnd"), "type"), c("triangle", "oval"))
  expect_equal( xml_attr(xml_find_all(xmldoc, "//a:headEnd"), "w"), c("sm", "lg"))
  expect_equal( xml_attr(xml_find_all(xmldoc, "//a:tailEnd"), "len"), c("lg", "sm"))
})