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-4)
})
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(NA, "1", NA, "1"))
expect_equal(xml_attr(rPr, "i"), c(NA, NA, "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)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.