context("PPTX text")
library(xml2)
library(gdtools)

test_that("text can be found", {
  file <- tempfile()
  dml_pptx(file = file, bg = "transparent")
  plot.new()
  text(0.2, 0.2, "hello")
  dev.off()

  doc <- read_xml(file)
  text_node <- xml_find_first(
    doc,
    ".//p:sp/p:txBody/a:p/a:r/a:t",
    ns = xml_ns(doc)
  )
  expect_is(object = text_node, class = "xml_node")
  expect_equal(xml_text(text_node), "hello")
})

test_that("cex affects strwidth", {
  file <- tempfile()
  dml_pptx(file = file, bg = "transparent")
  plot.new()
  w1 <- strwidth("X")
  par(cex = 4)
  w4 <- strwidth("X")
  dev.off()
  expect_equal(w4 / w1, 4, tol = 1e-3)
})

test_that("special characters are escaped", {
  file <- tempfile()
  dml_pptx(file = file, bg = "transparent")
  plot.new()
  text(0.5, 0.5, "<&>")
  dev.off()

  x <- read_xml(file)
  ns <- xml_ns(x)
  expect_equal(
    xml_text(xml_find_first(x, ".//p:sp/p:txBody/a:p/a:r/a:t", ns = ns)),
    "<&>"
  )
})

test_that("utf-8 characters are preserved", {
  skip_on_os("windows") # skip because of xml2 buglet

  file <- tempfile()
  dml_pptx(file = file, bg = "transparent")
  plot.new()
  text(0.5, 0.5, "\u00b5")
  dev.off()

  x <- read_xml(file)
  ns <- xml_ns(x)
  expect_equal(
    xml_text(xml_find_first(x, ".//p:sp/p:txBody/a:p/a:r/a:t", ns = ns)),
    "\u00b5"
  )
})

test_that("text color is written in fill attr", {
  file <- tempfile()
  dml_pptx(file = file, bg = "transparent")
  plot.new()
  text(0.5, 0.5, "a", col = "#113399")
  dev.off()

  x <- read_xml(file)
  ns <- xml_ns(x)
  expect_equal(
    xml_attr(
      xml_find_first(
        x,
        ".//p:sp/p:txBody/a:p/a:r/a:rPr/a:solidFill/a:srgbClr",
        ns = ns
      ),
      "val"
    ),
    "113399"
  )
})

test_that("default point size is 12", {
  file <- tempfile()
  dml_pptx(file = file, bg = "transparent")
  plot.new()
  text(0.5, 0.5, "a")
  dev.off()

  x <- read_xml(file)
  ns <- xml_ns(x)
  rPr <- xml_find_first(x, ".//p:sp/p:txBody/a:p/a:r/a:rPr", ns = ns)
  expect_equal(xml_attr(rPr, "sz"), "1200")
})

test_that("cex does not generate fractional font sizes", {
  file <- tempfile()
  dml_pptx(file = file, bg = "transparent")
  plot.new()
  text(0.5, 0.5, "a", cex = .1)
  dev.off()

  x <- read_xml(file)
  ns <- xml_ns(x)
  rPr <- xml_find_first(x, ".//p:sp/p:txBody/a:p/a:r/a:rPr", ns = ns)
  expect_equal(xml_attr(rPr, "sz"), "120")
})

test_that("font sets weight/style", {
  file <- tempfile()
  dml_pptx(file = file, bg = "transparent")
  plot.new()
  text(0.5, seq(0.9, 0.1, length = 4), "a", font = 1:4)
  dev.off()

  x <- read_xml(file)
  ns <- xml_ns(x)
  rPr <- xml_find_all(x, ".//p:sp/p:txBody/a:p/a:r/a:rPr", ns = ns)
  expect_equal(xml_attr(rPr, "b"), c("0", "1", "0", "1"))
  expect_equal(xml_attr(rPr, "i"), c("0", "0", "1", "1"))
})


test_that("font sets weight/style", {
  skip_if_not(font_family_exists("Arial"))
  skip_if_not(font_family_exists("Times New Roman"))
  skip_if_not(font_family_exists("Courier New"))

  file <- tempfile()
  dml_pptx(
    file = file,
    bg = "transparent",
    fonts = list(
      sans = "Arial",
      serif = "Times New Roman",
      mono = "Courier New"
    )
  )
  plot.new()
  text(0.5, 0.1, "a", family = "serif")
  text(0.5, 0.5, "a", family = "sans")
  text(0.5, 0.9, "a", family = "mono")
  dev.off()

  x <- read_xml(file)
  ns <- xml_ns(x)
  rPr_latin <- xml_find_all(
    x,
    ".//p:sp/p:txBody/a:p/a:r/a:rPr/a:latin",
    ns = ns
  )
  rPr_cs <- xml_find_all(x, ".//p:sp/p:txBody/a:p/a:r/a:rPr/a:cs", ns = ns)
  expect_equal(
    xml_attr(rPr_latin, "typeface"),
    c("Times New Roman", "Arial", "Courier New")
  )
  expect_equal(
    xml_attr(rPr_cs, "typeface"),
    c("Times New Roman", "Arial", "Courier New")
  )
})

test_that("a symbol has width greater than 0", {
  file <- tempfile()
  dml_pptx(file = file, bg = "transparent")
  plot(c(0, 2), c(0, 2), type = "n")
  strw <- strwidth(expression(symbol("\042")))
  dev.off()

  expect_gt(strw, 0)
})
