context("XLSX Lines") library(xml2) test_that("segments don't have fill", { file <- tempfile() dml_xlsx(file = file, bg = "transparent") plot.new() segments(0.5, 0.5, 1, 1) dev.off() doc <- read_xml(file) fill_node <- xml_find_first( doc, ".//xdr:sp/xdr:spPr/a:solidFill", ns = xml_ns(doc) ) expect_is(fill_node, "xml_missing") }) test_that("lines don't have fill", { file <- tempfile() dml_xlsx(file = file, bg = "transparent") plot.new() lines(c(0.5, 1, 0.5), c(0.5, 1, 1)) dev.off() doc <- read_xml(file) fill_node <- xml_find_first( doc, ".//xdr:sp/xdr:spPr/a:solidFill", ns = xml_ns(doc) ) expect_is(fill_node, "xml_missing") }) test_that("polygons do have fill", { file <- tempfile() dml_xlsx(file = file, bg = "transparent") plot.new() polygon(c(0.5, 1, 0.5), c(0.5, 1, 1), col = "red", border = "blue") dev.off() doc <- read_xml(file) fill_node <- xml_find_first( doc, ".//xdr:sp/xdr:spPr/a:solidFill", ns = xml_ns(doc) ) expect_is(fill_node, "xml_node") }) test_that("polygons without border", { file <- tempfile() dml_xlsx(file = file, bg = "transparent") plot.new() polygon(c(0.5, 1, 0.5), c(0.5, 1, 1), col = "red", border = NA) dev.off() doc <- read_xml(file) fill_color <- xml_find_first( doc, ".//xdr:sp/xdr:spPr/a:solidFill/a:srgbClr", ns = xml_ns(doc) ) expect_equal(xml_attr(fill_color, "val"), "FF0000") line_color <- xml_find_first(doc, ".//xdr:sp/xdr:spPr/a:ln", ns = xml_ns(doc)) expect_is(line_color, "xml_missing") }) dash_array <- function(...) { file <- tempfile() dml_xlsx(file = file, bg = "transparent") plot(1:3, ..., axes = FALSE, xlab = "", ylab = "", type = "l") dev.off() doc <- read_xml(file) dash <- xml_find_first( doc, ".//xdr:sp/xdr:spPr/a:ln/a:prstDash", ns = xml_ns(doc) ) dash } custom_dash_array <- function(...) { file <- tempfile() dml_xlsx(file = file, bg = "transparent") plot(1:3, ..., axes = FALSE, xlab = "", ylab = "", type = "l") dev.off() doc <- read_xml(file) dash <- xml_find_all( doc, ".//xdr:sp/xdr:spPr/a:ln/a:custDash/a:ds", ns = xml_ns(doc) ) as.character(unlist(lapply(dash, xml_attrs))) } test_that("lty are ok", { expect_equal(xml_attr(dash_array(lty = 1), "val"), "solid") expect_equal(xml_attr(dash_array(lty = 2), "val"), "dash") expect_equal(xml_attr(dash_array(lty = 3), "val"), "dot") expect_equal( custom_dash_array(lty = 4), c("100000", "300000", "400000", "300000") ) expect_equal(xml_attr(dash_array(lty = 5), "val"), "lgDash") expect_equal( custom_dash_array(lty = 6), c("200000", "200000", "600000", "200000") ) expect_equal(custom_dash_array(lty = "1F"), c("100000", "1500000")) expect_equal( custom_dash_array(lty = "1234"), c("100000", "200000", "300000", "400000") ) }) test_that("lty scales with lwd", { expect_equal( custom_dash_array(lty = 4), c("100000", "300000", "400000", "300000") ) expect_equal( custom_dash_array(lty = 4, lwd = 2), c("200000", "600000", "800000", "600000") ) }) test_that("line join shapes", { file <- tempfile() dml_xlsx(file = file, bg = "transparent") plot.new() lines(c(0.3, 0.5, 0.7), c(0.1, 0.9, 0.1), lwd = 15, ljoin = "round") dev.off() doc <- read_xml(file) join_shape <- xml_find_first( doc, ".//xdr:sp/xdr:spPr/a:ln/a:round", ns = xml_ns(doc) ) expect_is(join_shape, "xml_node") file <- tempfile() dml_xlsx(file = file, bg = "transparent") plot.new() lines(c(0.3, 0.5, 0.7), c(0.1, 0.9, 0.1), lwd = 15, ljoin = "mitre") dev.off() doc <- read_xml(file) join_shape <- xml_find_first( doc, ".//xdr:sp/xdr:spPr/a:ln/a:miter", ns = xml_ns(doc) ) expect_is(join_shape, "xml_node") file <- tempfile() dml_xlsx(file = file, bg = "transparent") plot.new() lines(c(0.3, 0.5, 0.7), c(0.1, 0.9, 0.1), lwd = 15, ljoin = "bevel") dev.off() doc <- read_xml(file) join_shape <- xml_find_first( doc, ".//xdr:sp/xdr:spPr/a:ln/a:bevel", ns = xml_ns(doc) ) expect_is(join_shape, "xml_node") })