context("PPTX Lines")
library(xml2)

test_that("segments don't have fill", {
  file <- tempfile()
  dml_pptx(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,
    ".//p:sp/p:spPr/a:solidFill",
    ns = xml_ns(doc)
  )
  expect_is(fill_node, "xml_missing")
})

test_that("lines don't have fill", {
  file <- tempfile()
  dml_pptx(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,
    ".//p:sp/p:spPr/a:solidFill",
    ns = xml_ns(doc)
  )
  expect_is(fill_node, "xml_missing")
})

test_that("polygons do have fill", {
  file <- tempfile()
  dml_pptx(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,
    ".//p:sp/p:spPr/a:solidFill",
    ns = xml_ns(doc)
  )
  expect_is(fill_node, "xml_node")
})

test_that("polygons without border", {
  file <- tempfile()
  dml_pptx(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,
    ".//p:sp/p:spPr/a:solidFill/a:srgbClr",
    ns = xml_ns(doc)
  )
  expect_equal(xml_attr(fill_color, "val"), "FF0000")

  line_color <- xml_find_first(doc, ".//p:sp/p:spPr/a:ln", ns = xml_ns(doc))
  expect_is(line_color, "xml_missing")
})

dash_array <- function(...) {
  file <- tempfile()
  dml_pptx(file = file, bg = "transparent")
  plot(1:3, ..., axes = FALSE, xlab = "", ylab = "", type = "l")
  dev.off()

  doc <- read_xml(file)
  dash <- xml_find_first(
    doc,
    ".//p:sp/p:spPr/a:ln/a:prstDash",
    ns = xml_ns(doc)
  )
  dash
}
custom_dash_array <- function(...) {
  file <- tempfile()
  dml_pptx(file = file, bg = "transparent")
  plot(1:3, ..., axes = FALSE, xlab = "", ylab = "", type = "l")
  dev.off()

  doc <- read_xml(file)
  dash <- xml_find_all(
    doc,
    ".//p:sp/p: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_pptx(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,
    ".//p:sp/p:spPr/a:ln/a:round",
    ns = xml_ns(doc)
  )
  expect_is(join_shape, "xml_node")

  file <- tempfile()
  dml_pptx(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,
    ".//p:sp/p:spPr/a:ln/a:miter",
    ns = xml_ns(doc)
  )
  expect_is(join_shape, "xml_node")

  file <- tempfile()
  dml_pptx(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,
    ".//p:sp/p:spPr/a:ln/a:bevel",
    ns = xml_ns(doc)
  )
  expect_is(join_shape, "xml_node")
})
