gridtext/man/ 0000755 0001762 0000144 00000000000 14310622556 012663 5 ustar ligges users gridtext/man/gridtext.Rd 0000644 0001762 0000144 00000000671 14310622556 015010 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/gridtext.R
\docType{package}
\name{gridtext}
\alias{gridtext}
\title{Improved text rendering support for grid graphics}
\description{
The gridtext package provides two new grobs, \code{\link[=richtext_grob]{richtext_grob()}} and
\code{\link[=textbox_grob]{textbox_grob()}}, which support drawing of formatted text labels and
formatted text boxes, respectively.
}
gridtext/man/textbox_grob.Rd 0000644 0001762 0000144 00000016330 14310622556 015663 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/textbox-grob.R
\name{textbox_grob}
\alias{textbox_grob}
\title{Draw formatted multi-line text with word wrap}
\usage{
textbox_grob(
text,
x = NULL,
y = NULL,
width = unit(1, "npc"),
height = NULL,
minwidth = NULL,
maxwidth = NULL,
minheight = NULL,
maxheight = NULL,
hjust = 0.5,
vjust = 0.5,
halign = 0,
valign = 1,
default.units = "npc",
margin = unit(c(0, 0, 0, 0), "pt"),
padding = unit(c(0, 0, 0, 0), "pt"),
r = unit(0, "pt"),
orientation = c("upright", "left-rotated", "right-rotated", "inverted"),
name = NULL,
gp = gpar(),
box_gp = gpar(col = NA),
vp = NULL,
use_markdown = TRUE
)
}
\arguments{
\item{text}{Character vector containing Markdown/HTML string to draw.}
\item{x, y}{Unit objects specifying the location of the reference point.
If set to \code{NULL} (the default), these values are chosen based on the
values of \code{hjust} and \code{vjust} such that the box is appropriately
justified in the enclosing viewport.}
\item{width, height}{Unit objects specifying width and height of the
grob. A value of \code{NULL} means take up exactly the space necessary
to render all content. Use a value of \code{unit(1, "npc")} to have the
box take up all available space.}
\item{minwidth, minheight, maxwidth, maxheight}{Min and max values for
width and height. Set to \code{NULL} to impose neither a minimum nor
a maximum. Note: \code{minheight} and \code{maxheight} do not work if \code{width = NULL}.}
\item{hjust, vjust}{Numerical values specifying the justification
of the text box relative to the reference point defined by \code{x} and \code{y}. These
justification parameters are specified in the internal reference frame of
the text box, so that, for example, \code{hjust} adjusts the vertical
justification when the text box is left- or right-rotated.}
\item{halign, valign}{Numerical values specifying the justification of the text
inside the text box.}
\item{default.units}{Units of \code{x}, \code{y}, \code{width}, \code{height}, \code{minwidth},
\code{minheight}, \code{maxwidth}, \code{maxheight} if these are provided only as
numerical values.}
\item{margin, padding}{Unit vectors of four elements each indicating the
margin and padding around each text label in the order top, right,
bottom, left. Margins are drawn outside the enclosing box (if any),
and padding is drawn inside. To avoid rendering artifacts, it is best
to specify these values in absolute units (such as points, mm, or inch)
rather than in relative units (such as npc).}
\item{r}{The radius of the rounded corners. To avoid rendering artifacts,
it is best to specify this in absolute units (such as points, mm, or inch)
rather than in relative units (such as npc).}
\item{orientation}{Orientation of the box. Allowed values are \code{"upright"},
\code{"left-rotated"}, \code{"right-rotated"}, and \code{"inverted"}, corresponding to
a rotation by 0, 90, 270, and 180 degrees counter-clockwise, respectively.}
\item{name}{Name of the grob.}
\item{gp}{Other graphical parameters for drawing.}
\item{box_gp}{Graphical parameters for the enclosing box around each text label.}
\item{vp}{Viewport.}
\item{use_markdown}{Should the \code{text} input be treated as markdown?}
}
\value{
A grid \code{\link{grob}} that represents the formatted text.
}
\description{
The function \code{textbox_grob()} is intended to render multi-line text
labels that require automatic word wrapping. It is similar to
\code{\link[=richtext_grob]{richtext_grob()}}, but there are a few important differences. First,
while \code{\link[=richtext_grob]{richtext_grob()}} is vectorized, \code{textbox_grob()} is not. It
can draw only a single text box at a time. Second, \code{textbox_grob()}
doesn't support rendering the text box at arbitrary angles. Only
four different orientations are supported, corresponding to a
rotation by 0, 90, 180, and 270 degrees.
}
\examples{
library(grid)
g <- textbox_grob(
"**The quick brown fox jumps over the lazy dog.**>ڹ/>}yi/S&KgΤ7jԠ>N]yj{Bc2hևg7G
G?KҦӑL i't 菀]Ev¢$$@eFLxrPIG"r|''{x2ׯkDs2 P]I\sС<ݝ-KU90$+J.Q+_>^t0zt$ ݗ
6ҕ*A)y)-o~ݩlgo= @ @@ @+e- k.]6iTx Ҡ`Pڕ6\jȚ;7'WR$:8-=> .8ދ plV< ۶,I ^TK0jkBMҕvݻ;֬Iճe!=zЦPޮX
Ղτ%tC םm i @.8* I:|Sr 7o_̎6_L9蔂yMj5m͎J'f"Q \)szl,͍@9
| U ?GMsGsS( v_OxjiOE*͂O4β hr& #=cvFG?L6kF
| k{|c]g $Kwql>-=쬑zsW2yetΰF F h77._eݼY; =k뗥w|E)ް!UWϮwsnxzz:-CY_iJY5%|yC;H( % c\we:vxs+̖:tΙ9sZ~γ !9Ύ G>EPMɿYJ[ܾ&3~ ` @3${Ԩuk٥.M7^:!I,cGpj ȓ'f
YG7l' ǧϐ &N4yh9|^' t;4gu-};/X? l,K@!C
tnoF 7ѽ{(K4:|Rُ$$h@ A 3G{8ϟ $Ok'p$En[갞_~ ;I 9`JG.%{ 6!QJ5{| bn3y!>錌/#hm}$G JV;f Mq Nٮ`
EJy2sk_ ,LTć0^đW`f
0H?3(cbkl# rK0*,Ҳ
Kx8sʉ#gk@
Hi.bb@[nYiE, da~qʼ3;"3g- QfOh: {772"k0wTJwUCy? sbݨ:xOj]Q#+=H1f3"S1[}Z,dD2JrFA"n" h0!{谑` @$&VLG-1MQ8"g;wG %"ս f&[ 9kya[Ga^,dI_ =(٤qYPZ8Q@b}.7A} ̽fq(*>BzedeSZCV >mifQ! B
4*Jn
c!ot$ʶ\ihh|]{%lWsa 3'~j!\ OJ H8n>*0I&FuQS\W`zڠGTe@i _Lh>X?V,G9'L#h>{mRʊv:<~'Z F
Linebreaks
Linebreaks",
"*x*2 + 5*x* + *C**i*",
"Some blue text **in bold.**
And *italics text.*
And some large text."
)
x <- c(.2, .1, .7, .9)
y <- c(.8, .4, .1, .5)
rot <- c(0, 0, 45, -45)
gp = gpar(col = c("black", "red"), fontfamily = c("Palatino", "Courier", "Times", "Helvetica"))
box_gp = gpar(col = "black", fill = c("cornsilk", NA, "lightblue1", NA), lty = c(0, 1, 1, 1))
hjust <- c(0.5, 0, 0, 1)
vjust <- c(0.5, 1, 0, 0.5)
g <- richtext_grob(
text, x, y, hjust = hjust, vjust = vjust, rot = rot,
padding = unit(c(6, 6, 4, 6), "pt"),
r = unit(c(0, 2, 4, 8), "pt"),
gp = gp, box_gp = box_gp
)
grid.newpage()
grid.draw(g)
grid.points(x, y, default.units = "npc", pch = 19, size = unit(5, "pt"))
# multiple text labels with aligned boxes
text <- c("January", "February", "March", "April", "May")
x <- (1:5)/6 + 1/24
y <- rep(0.8, 5)
g <- richtext_grob(
text, x, y, halign = 0, hjust = 1,
rot = 45,
padding = unit(c(3, 6, 1, 3), "pt"),
r = unit(4, "pt"),
align_widths = TRUE,
box_gp = gpar(col = "black", fill = "cornsilk")
)
grid.newpage()
grid.draw(g)
grid.points(x, y, default.units = "npc", pch = 19, size = unit(5, "pt"))
}
\seealso{
\code{\link[=textbox_grob]{textbox_grob()}}
}
gridtext/DESCRIPTION 0000644 0001762 0000144 00000002725 14311055377 013626 0 ustar ligges users Package: gridtext
Type: Package
Title: Improved Text Rendering Support for 'Grid' Graphics
Version: 0.1.5
Authors@R:
c(
person(
given = "Claus O.",
family = "Wilke",
role = c("aut"),
email = "wilke@austin.utexas.edu",
comment = c(ORCID = "0000-0002-7470-9261")
),
person(
given = "Brenton M.",
family = "Wiernik",
role = c("aut", "cre"),
email = "brenton@wiernik.org",
comment = c(ORCID = "0000-0001-9560-6336", Twitter = "@bmwiernik")
)
)
Description: Provides support for rendering of formatted text using 'grid' graphics. Text can be
formatted via a minimal subset of 'Markdown', 'HTML', and inline 'CSS' directives, and it can be
rendered both with and without word wrap.
URL: https://wilkelab.org/gridtext/
BugReports: https://github.com/wilkelab/gridtext/issues
License: MIT + file LICENSE
Depends: R (>= 3.5)
Imports: curl, grid, grDevices, markdown, rlang, Rcpp, png, jpeg,
stringr, xml2
Suggests: covr, knitr, rmarkdown, testthat, vdiffr
LinkingTo: Rcpp
Encoding: UTF-8
RoxygenNote: 7.1.1
SystemRequirements: C++11
NeedsCompilation: yes
Packaged: 2022-09-15 13:49:42 UTC; brentonw
Author: Claus O. Wilke [aut] (
The quick brown fox jumps over the lazy dog.
The **quick brown fox** jumps over the lazy dog.
The quick brown fox jumps over the lazy dog.",
y = unit(0.9, "npc"), vjust = 1,
gp = gpar(fontsize = 15),
box_gp = gpar(col = "black", fill = "lightcyan1"),
r = unit(5, "pt"),
padding = unit(c(10, 10, 10, 10), "pt"),
margin = unit(c(0, 10, 0, 10), "pt")
)
grid.draw(g)
grid.text(" Box spanning entire viewport, with margins", 0, 1, hjust = 0, vjust = 1.2)
grid.points(0.5, 0.9, default.units = "npc", pch = 19, size = unit(5, "pt"))
invisible()
}
}
expect_doppelganger("Box spanning entire viewport, with margins", draw_box())
draw_align_upright <- function() {
function() {
g1 <- textbox_grob(
"The quick brown fox jumps over the lazy dog.",
hjust = 0, vjust = 1, valign = 1, halign = 0,
width = unit(1.5, "inch"), height = unit(1.5, "inch"),
box_gp = gpar(col = "black", fill = "cornsilk"),
padding = unit(c(2, 2, 2, 2), "pt"),
margin = unit(c(5, 5, 5, 5), "pt")
)
g2 <- textbox_grob(
"The quick brown fox jumps over the lazy dog.",
hjust = 1, vjust = 1, valign = 0.5, halign = 0.5,
width = unit(1.5, "inch"), height = unit(1.5, "inch"),
box_gp = gpar(col = "black", fill = "cornsilk"),
padding = unit(c(2, 2, 2, 2), "pt"),
margin = unit(c(5, 5, 5, 5), "pt")
)
g3 <- textbox_grob(
"The quick brown fox jumps over the lazy dog.",
hjust = 0, vjust = 0, valign = 1, halign = 1,
width = unit(1.5, "inch"), height = unit(1.5, "inch"),
box_gp = gpar(col = "black", fill = "cornsilk"),
padding = unit(c(2, 2, 2, 2), "pt"),
margin = unit(c(5, 5, 5, 5), "pt")
)
g4 <- textbox_grob(
"The quick brown fox jumps over the lazy dog.",
hjust = 1, vjust = 0, valign = 0, halign = 0,
width = unit(1.5, "inch"), height = unit(1.5, "inch"),
box_gp = gpar(col = "black", fill = "cornsilk"),
padding = unit(c(2, 2, 2, 2), "pt"),
margin = unit(c(5, 5, 5, 5), "pt")
)
grid.draw(g1)
grid.draw(g2)
grid.draw(g3)
grid.draw(g4)
invisible()
}
}
expect_doppelganger("Multiple boxes, internal alignment", draw_align_upright())
draw_align_left_rotated <- function() {
function() {
g1 <- textbox_grob(
"The quick brown fox jumps over the lazy dog.",
hjust = 0, vjust = 1, valign = 1, halign = 0,
width = unit(1.5, "inch"), height = unit(1.5, "inch"),
orientation = "left-rotated",
box_gp = gpar(col = "black", fill = "cornsilk"),
padding = unit(c(2, 2, 2, 2), "pt"),
margin = unit(c(5, 5, 5, 5), "pt")
)
g2 <- textbox_grob(
"The quick brown fox jumps over the lazy dog.",
hjust = 1, vjust = 1, valign = 0.5, halign = 0.5,
width = unit(1.5, "inch"), height = unit(1.5, "inch"),
orientation = "left-rotated",
box_gp = gpar(col = "black", fill = "cornsilk"),
padding = unit(c(2, 2, 2, 2), "pt"),
margin = unit(c(5, 5, 5, 5), "pt")
)
g3 <- textbox_grob(
"The quick brown fox jumps over the lazy dog.",
hjust = 0, vjust = 0, valign = 1, halign = 1,
width = unit(1.5, "inch"), height = unit(1.5, "inch"),
orientation = "left-rotated",
box_gp = gpar(col = "black", fill = "cornsilk"),
padding = unit(c(2, 2, 2, 2), "pt"),
margin = unit(c(5, 5, 5, 5), "pt")
)
g4 <- textbox_grob(
"The quick brown fox jumps over the lazy dog.",
hjust = 1, vjust = 0, valign = 0, halign = 0,
width = unit(1.5, "inch"), height = unit(1.5, "inch"),
orientation = "left-rotated",
box_gp = gpar(col = "black", fill = "cornsilk"),
padding = unit(c(2, 2, 2, 2), "pt"),
margin = unit(c(5, 5, 5, 5), "pt")
)
grid.draw(g1)
grid.draw(g2)
grid.draw(g3)
grid.draw(g4)
invisible()
}
}
expect_doppelganger("Multiple boxes left rotated, internal alignment", draw_align_left_rotated())
draw_align_right_rotated <- function() {
function() {
g1 <- textbox_grob(
"The quick brown fox jumps over the lazy dog.",
hjust = 0, vjust = 1, valign = 1, halign = 0,
width = unit(1.5, "inch"), height = unit(1.5, "inch"),
orientation = "right-rotated",
box_gp = gpar(col = "black", fill = "cornsilk"),
padding = unit(c(2, 2, 2, 2), "pt"),
margin = unit(c(5, 5, 5, 5), "pt")
)
g2 <- textbox_grob(
"The quick brown fox jumps over the lazy dog.",
hjust = 1, vjust = 1, valign = 0.5, halign = 0.5,
width = unit(1.5, "inch"), height = unit(1.5, "inch"),
orientation = "right-rotated",
box_gp = gpar(col = "black", fill = "cornsilk"),
padding = unit(c(2, 2, 2, 2), "pt"),
margin = unit(c(5, 5, 5, 5), "pt")
)
g3 <- textbox_grob(
"The quick brown fox jumps over the lazy dog.",
hjust = 0, vjust = 0, valign = 1, halign = 1,
width = unit(1.5, "inch"), height = unit(1.5, "inch"),
orientation = "right-rotated",
box_gp = gpar(col = "black", fill = "cornsilk"),
padding = unit(c(2, 2, 2, 2), "pt"),
margin = unit(c(5, 5, 5, 5), "pt")
)
g4 <- textbox_grob(
"The quick brown fox jumps over the lazy dog.",
hjust = 1, vjust = 0, valign = 0, halign = 0,
width = unit(1.5, "inch"), height = unit(1.5, "inch"),
orientation = "right-rotated",
box_gp = gpar(col = "black", fill = "cornsilk"),
padding = unit(c(2, 2, 2, 2), "pt"),
margin = unit(c(5, 5, 5, 5), "pt")
)
grid.draw(g1)
grid.draw(g2)
grid.draw(g3)
grid.draw(g4)
invisible()
}
}
expect_doppelganger("Multiple boxes right rotated, internal alignment", draw_align_right_rotated())
draw_align_inverted <- function() {
function() {
g1 <- textbox_grob(
"The quick brown fox jumps over the lazy dog.",
hjust = 0, vjust = 1, valign = 1, halign = 0,
width = unit(1.5, "inch"), height = unit(1.5, "inch"),
orientation = "inverted",
box_gp = gpar(col = "black", fill = "cornsilk"),
padding = unit(c(2, 2, 2, 2), "pt"),
margin = unit(c(5, 5, 5, 5), "pt")
)
g2 <- textbox_grob(
"The quick brown fox jumps over the lazy dog.",
hjust = 1, vjust = 1, valign = 0.5, halign = 0.5,
width = unit(1.5, "inch"), height = unit(1.5, "inch"),
orientation = "inverted",
box_gp = gpar(col = "black", fill = "cornsilk"),
padding = unit(c(2, 2, 2, 2), "pt"),
margin = unit(c(5, 5, 5, 5), "pt")
)
g3 <- textbox_grob(
"The quick brown fox jumps over the lazy dog.",
hjust = 0, vjust = 0, valign = 1, halign = 1,
width = unit(1.5, "inch"), height = unit(1.5, "inch"),
orientation = "inverted",
box_gp = gpar(col = "black", fill = "cornsilk"),
padding = unit(c(2, 2, 2, 2), "pt"),
margin = unit(c(5, 5, 5, 5), "pt")
)
g4 <- textbox_grob(
"The quick brown fox jumps over the lazy dog.",
hjust = 1, vjust = 0, valign = 0, halign = 0,
width = unit(1.5, "inch"), height = unit(1.5, "inch"),
orientation = "inverted",
box_gp = gpar(col = "black", fill = "cornsilk"),
padding = unit(c(2, 2, 2, 2), "pt"),
margin = unit(c(5, 5, 5, 5), "pt")
)
grid.draw(g1)
grid.draw(g2)
grid.draw(g3)
grid.draw(g4)
invisible()
}
}
expect_doppelganger("Multiple boxes inverted, internal alignment", draw_align_inverted())
draw_rotated_fixedpoint <- function() {
function() {
g1 <- textbox_grob(
"The quick brown fox jumps over the lazy dog.",
hjust = 0, vjust = 1,
x = 0.4, y = 0.6,
width = unit(1.5, "inch"), height = unit(1.5, "inch"),
orientation = "upright",
box_gp = gpar(col = "black", fill = "cornsilk"),
padding = unit(c(2, 2, 2, 2), "pt"),
margin = unit(c(5, 0, 5, 0), "pt")
)
g2 <- textbox_grob(
"The quick brown fox jumps over the lazy dog.",
hjust = 0, vjust = 1,
x = 0.4, y = 0.6,
width = unit(1.5, "inch"), height = unit(1.5, "inch"),
orientation = "left-rotated",
box_gp = gpar(col = "black", fill = "cornsilk"),
padding = unit(c(2, 2, 2, 2), "pt"),
margin = unit(c(5, 0, 5, 0), "pt")
)
g3 <- textbox_grob(
"The quick brown fox jumps over the lazy dog.",
hjust = 0, vjust = 1,
x = 0.4, y = 0.6,
width = unit(1.5, "inch"), height = unit(1.5, "inch"),
orientation = "right-rotated",
box_gp = gpar(col = "black", fill = "cornsilk"),
padding = unit(c(2, 2, 2, 2), "pt"),
margin = unit(c(5, 0, 5, 0), "pt")
)
g4 <- textbox_grob(
"The quick brown fox jumps over the lazy dog.",
hjust = 0, vjust = 1,
x = 0.4, y = 0.6,
width = unit(1.5, "inch"), height = unit(1.5, "inch"),
orientation = "inverted",
box_gp = gpar(col = "black", fill = "cornsilk"),
padding = unit(c(2, 2, 2, 2), "pt"),
margin = unit(c(5, 0, 5, 0), "pt")
)
grid.draw(g1)
grid.draw(g2)
grid.draw(g3)
grid.draw(g4)
grid.points(0.4, 0.6, default.units = "npc", pch = 19, size = unit(5, "pt"))
invisible()
}
}
expect_doppelganger("Rotation around fixed point", draw_rotated_fixedpoint())
})
gridtext/tests/testthat/helper-vdiffr.R 0000644 0001762 0000144 00000000252 14310622556 017771 0 ustar ligges users expect_doppelganger <- function(title, fig, path = NULL, ...) {
testthat::skip_if_not_installed("vdiffr")
vdiffr::expect_doppelganger(title, fig, path = path, ...)
}
gridtext/tests/testthat/test-rect-box.R 0000644 0001762 0000144 00000015315 14310622556 017742 0 ustar ligges users test_that("alignment of content", {
nb <- bl_make_null_box()
cb <- bl_make_rect_box(nb, 20, 10, c(0, 0, 0, 0), c(0, 0, 0, 0), gp = gpar())
rb <- bl_make_rect_box(cb, 400, 600, c(1, 2, 4, 8), c(16, 32, 64, 128), gp = gpar())
bl_calc_layout(rb, 0, 0)
g <- bl_render(rb, 100, 200)
# placement of outer box depends on margins
outer <- g[[1]]
expect_identical(outer$x, unit(100 + 8, "pt"))
expect_identical(outer$y, unit(200 + 4, "pt"))
expect_identical(outer$width, unit(400 - 2 - 8, "pt"))
expect_identical(outer$height, unit(600 - 1 - 4, "pt"))
# placement of inner box depends on margins, padding, justification, and inner size
inner <- g[[2]]
expect_identical(inner$x, unit(100 + 8 + 128, "pt"))
expect_identical(inner$y, unit(200 + 600 - 1 - 16 - 10, "pt"))
rb <- bl_make_rect_box(cb, 400, 600, c(1, 2, 4, 8), c(16, 32, 64, 128), gp = gpar(),
content_hjust = 1, content_vjust = 0)
bl_calc_layout(rb, 0, 0)
g <- bl_render(rb, 100, 200)
inner <- g[[2]]
expect_identical(inner$x, unit(100 + 400 - 2 - 32 - 20, "pt"))
expect_identical(inner$y, unit(200 + 4 + 64, "pt"))
})
test_that("size policies", {
nb <- bl_make_null_box()
cb <- bl_make_rect_box(nb, 20, 10, c(0, 0, 0, 0), c(0, 0, 0, 0), gp = gpar())
rb <- bl_make_rect_box(
cb, 400, 600, c(1, 2, 4, 8), c(16, 32, 64, 128), gp = gpar(),
width_policy = "expand", height_policy = "relative"
)
bl_calc_layout(rb, 100, 50)
g <- bl_render(rb, 100, 200)
outer <- g[[1]]
expect_identical(outer$x, unit(100 + 8, "pt"))
expect_identical(outer$y, unit(200 + 4, "pt"))
expect_identical(outer$width, unit(100 - 2 - 8, "pt"))
expect_identical(outer$height, unit(300 - 1 - 4, "pt"))
inner <- g[[2]]
expect_identical(inner$x, unit(100 + 8 + 128, "pt"))
expect_identical(inner$y, unit(200 + 300 - 1 - 16 - 10, "pt"))
rb <- bl_make_rect_box(
cb, 400, 600, c(1, 2, 4, 8), c(16, 32, 64, 128), gp = gpar(),
width_policy = "relative", height_policy = "expand"
)
bl_calc_layout(rb, 50, 300)
g <- bl_render(rb, 100, 200)
outer <- g[[1]]
expect_identical(outer$x, unit(100 + 8, "pt"))
expect_identical(outer$y, unit(200 + 4, "pt"))
expect_identical(outer$width, unit(200 - 2 - 8, "pt"))
expect_identical(outer$height, unit(300 - 1 - 4, "pt"))
inner <- g[[2]]
expect_identical(inner$x, unit(100 + 8 + 128, "pt"))
expect_identical(inner$y, unit(200 + 300 - 1 - 16 - 10, "pt"))
rb <- bl_make_rect_box(
cb, 400, 600, c(1, 2, 4, 8), c(16, 32, 64, 128), gp = gpar(),
width_policy = "native", height_policy = "native"
)
bl_calc_layout(rb, 50, 300)
g <- bl_render(rb, 100, 200)
outer <- g[[1]]
expect_identical(outer$x, unit(100 + 8, "pt"))
expect_identical(outer$y, unit(200 + 4, "pt"))
# native width/height now depends on padding, not on margin
expect_identical(outer$width, unit(20 + 32 + 128, "pt"))
expect_identical(outer$height, unit(10 + 16 + 64, "pt"))
inner <- g[[2]]
expect_identical(inner$x, unit(100 + 8 + 128, "pt"))
expect_identical(inner$y, unit(200 + 4 + 64, "pt"))
rb <- bl_make_rect_box(
cb, 400, 600, c(1, 2, 4, 8), c(16, 32, 64, 128), gp = gpar(),
width_policy = "native", height_policy = "relative"
)
bl_calc_layout(rb, 50, 50)
g <- bl_render(rb, 100, 200)
outer <- g[[1]]
expect_identical(outer$x, unit(100 + 8, "pt"))
expect_identical(outer$y, unit(200 + 4, "pt"))
expect_identical(outer$width, unit(20 + 32 + 128, "pt"))
expect_identical(outer$height, unit(300 - 1 - 4, "pt"))
inner <- g[[2]]
expect_identical(inner$x, unit(100 + 8 + 128, "pt"))
expect_identical(inner$y, unit(200 + 300 - 1 - 16 - 10, "pt"))
rb <- bl_make_rect_box(
cb, 400, 600, c(1, 2, 4, 8), c(16, 32, 64, 128), gp = gpar(),
width_policy = "native", height_policy = "expand"
)
bl_calc_layout(rb, 50, 300)
g <- bl_render(rb, 100, 200)
outer <- g[[1]]
expect_identical(outer$x, unit(100 + 8, "pt"))
expect_identical(outer$y, unit(200 + 4, "pt"))
expect_identical(outer$width, unit(20 + 32 + 128, "pt"))
expect_identical(outer$height, unit(300 - 1 - 4, "pt"))
inner <- g[[2]]
expect_identical(inner$x, unit(100 + 8 + 128, "pt"))
expect_identical(inner$y, unit(200 + 300 - 1 - 16 - 10, "pt"))
rb <- bl_make_rect_box(
cb, 400, 600, c(1, 2, 4, 8), c(16, 32, 64, 128), gp = gpar(),
width_policy = "native", height_policy = "fixed"
)
bl_calc_layout(rb, 50, 300)
g <- bl_render(rb, 100, 200)
outer <- g[[1]]
expect_identical(outer$x, unit(100 + 8, "pt"))
expect_identical(outer$y, unit(200 + 4, "pt"))
expect_identical(outer$width, unit(20 + 32 + 128, "pt"))
expect_identical(outer$height, unit(600 - 1 - 4, "pt"))
inner <- g[[2]]
expect_identical(inner$x, unit(100 + 8 + 128, "pt"))
expect_identical(inner$y, unit(200 + 600 - 1 - 16 - 10, "pt"))
rb <- bl_make_rect_box(
cb, 400, 600, c(1, 2, 4, 8), c(16, 32, 64, 128), gp = gpar(),
width_policy = "fixed", height_policy = "native"
)
bl_calc_layout(rb, 50, 300)
g <- bl_render(rb, 100, 200)
outer <- g[[1]]
expect_identical(outer$x, unit(100 + 8, "pt"))
expect_identical(outer$y, unit(200 + 4, "pt"))
expect_identical(outer$width, unit(400 - 2 - 8, "pt"))
expect_identical(outer$height, unit(10 + 16 + 64, "pt"))
inner <- g[[2]]
expect_identical(inner$x, unit(100 + 8 + 128, "pt"))
expect_identical(inner$y, unit(200 + 4 + 64, "pt"))
# native size policies with no content
rb <- bl_make_rect_box(
NULL, 400, 600, c(1, 2, 4, 8), c(16, 32, 64, 128), gp = gpar(),
width_policy = "native", height_policy = "native"
)
bl_calc_layout(rb, 50, 300)
g <- bl_render(rb, 100, 200)
outer <- g[[1]]
expect_identical(outer$x, unit(100 + 8, "pt"))
expect_identical(outer$y, unit(200 + 4, "pt"))
# native width/height now depends only on padding, since content size is 0
expect_identical(outer$width, unit(32 + 128, "pt"))
expect_identical(outer$height, unit(16 + 64, "pt"))
rb <- bl_make_rect_box(
NULL, 400, 600, c(1, 2, 4, 8), c(16, 32, 64, 128), gp = gpar(),
width_policy = "native", height_policy = "fixed"
)
bl_calc_layout(rb, 50, 300)
g <- bl_render(rb, 100, 200)
outer <- g[[1]]
expect_identical(outer$x, unit(100 + 8, "pt"))
expect_identical(outer$y, unit(200 + 4, "pt"))
expect_identical(outer$width, unit(32 + 128, "pt"))
expect_identical(outer$height, unit(600 - 1 - 4, "pt"))
rb <- bl_make_rect_box(
NULL, 400, 600, c(1, 2, 4, 8), c(16, 32, 64, 128), gp = gpar(),
width_policy = "fixed", height_policy = "native"
)
bl_calc_layout(rb, 50, 300)
g <- bl_render(rb, 100, 200)
outer <- g[[1]]
expect_identical(outer$x, unit(100 + 8, "pt"))
expect_identical(outer$y, unit(200 + 4, "pt"))
expect_identical(outer$width, unit(400 - 2 - 8, "pt"))
expect_identical(outer$height, unit(16 + 64, "pt"))
})
gridtext/tests/testthat/test-richtext-grob.R 0000644 0001762 0000144 00000016122 14310622556 020775 0 ustar ligges users context("richtext-grob")
test_that("grobheight and grobwidth work", {
# width is the same for textGrob and richtext_grob
g <- textGrob("test")
g2 <- richtext_grob("test")
w <- convertWidth(grobWidth(g), "pt", valueOnly = TRUE)
w2 <- convertWidth(grobWidth(g2), "pt", valueOnly = TRUE)
expect_equal(w, w2)
# height is slightly larger for richtext_grob, b/c descent is considered
h <- convertHeight(grobHeight(g), "pt", valueOnly = TRUE)
h2 <- convertHeight(grobHeight(g2), "pt", valueOnly = TRUE)
expect_lt(h, h2)
# width and height are flipped after rotating 90 degrees
g <- textGrob("test", rot = 90)
g2 <- richtext_grob("test", rot = 90)
w <- convertWidth(grobWidth(g), "pt", valueOnly = TRUE)
w2 <- convertWidth(grobWidth(g2), "pt", valueOnly = TRUE)
expect_lt(w, w2)
# height is slightly larger for richtext_grob, b/c descent is considered
h <- convertHeight(grobHeight(g), "pt", valueOnly = TRUE)
h2 <- convertHeight(grobHeight(g2), "pt", valueOnly = TRUE)
expect_equal(h, h2)
# position of multiple labels is taken into account
g <- textGrob("test", x = unit(0, "pt"), y = unit(80, "pt"))
g2 <- textGrob(c("test", "test"), x = unit(c(0, 50), "pt"), y = unit(c(80, 40), "pt"))
w <- convertWidth(grobWidth(g), "pt", valueOnly = TRUE)
w2 <- convertWidth(grobWidth(g2), "pt", valueOnly = TRUE)
expect_equal(w + 50, w2)
h <- convertHeight(grobHeight(g), "pt", valueOnly = TRUE)
h2 <- convertHeight(grobHeight(g2), "pt", valueOnly = TRUE)
expect_equal(h + 40, h2)
# multiple labels, w rotation
g <- textGrob("test", x = unit(0, "pt"), y = unit(80, "pt"), rot = 45)
g2 <- textGrob(c("test", "test"), x = unit(c(0, 50), "pt"), y = unit(c(80, 40), "pt"), rot = 45)
w <- convertWidth(grobWidth(g), "pt", valueOnly = TRUE)
w2 <- convertWidth(grobWidth(g2), "pt", valueOnly = TRUE)
expect_equal(w + 50, w2)
h <- convertHeight(grobHeight(g), "pt", valueOnly = TRUE)
h2 <- convertHeight(grobHeight(g2), "pt", valueOnly = TRUE)
expect_equal(h + 40, h2)
# grob height and width are identical with and without debug info
text <- c(
"Some text **in bold.**
(centered)", "Linebreaks
Linebreaks
Linebreaks",
"*x*2 + 5*x* + *C*i
*a* = 5"
)
x <- c(.4, .3, .8)
y <- c(.8, .5, .3)
rot <- c(0, -45, 45)
halign <- c(0.5, 0, 1)
valign <- c(0.5, 1, 0)
g1 <- richtext_grob(
text, x, y, halign = halign, valign = valign, rot = rot,
padding = unit(c(6, 6, 4, 6), "pt"),
r = unit(c(0, 4, 8), "pt"),
debug = FALSE
)
g2 <- richtext_grob(
text, x, y, halign = halign, valign = valign, rot = rot,
padding = unit(c(6, 6, 4, 6), "pt"),
r = unit(c(0, 4, 8), "pt"),
debug = TRUE
)
w1 <- convertWidth(grobWidth(g1), "pt", valueOnly = TRUE)
w2 <- convertWidth(grobWidth(g2), "pt", valueOnly = TRUE)
expect_equal(w1, w2)
h1 <- convertHeight(grobHeight(g1), "pt", valueOnly = TRUE)
h2 <- convertHeight(grobHeight(g2), "pt", valueOnly = TRUE)
expect_equal(h1, h2)
})
test_that("misc. tests", {
# empty strings work
expect_silent(richtext_grob(""))
expect_silent(richtext_grob(" "))
# NAs work
expect_silent(richtext_grob(c(" ", "abc", NA)))
})
test_that("visual tests", {
draw_labels <- function() {
function() {
text <- c(
"**Various text boxes in different stylings**",
"Some text **in bold.**
(centered)", "Linebreaks
Linebreaks
Linebreaks",
"*x*2 + 5*x* + *C*i
*a* = 5"
)
x <- c(0, .4, .3, .8)
y <- c(1, .8, .5, .3)
rot <- c(0, 0, -45, 45)
gp = gpar(col = c("black", "red"))
box_gp = gpar(col = "black", fill = c(NA, "cornsilk", NA, "lightblue1"), lty = c(0, 1, 1, 1))
hjust <- c(0, 0.5, 0, 1)
vjust <- c(1, 0.5, 1, 0)
g <- richtext_grob(
text, x, y, hjust = hjust, vjust = vjust, rot = rot,
padding = unit(c(6, 6, 4, 6), "pt"),
r = unit(c(0, 0, 4, 8), "pt"),
gp = gp, box_gp = box_gp
)
grid.draw(g)
grid.points(x, y, default.units = "npc", pch = 19, size = unit(5, "pt"))
invisible()
}
}
expect_doppelganger("Various text boxes", draw_labels())
draw_labels_debug <- function() {
function() {
text <- c(
"Some text **in bold.**
(centered)", "Linebreaks
Linebreaks
Linebreaks",
"*x*2 + 5*x* + *C*i
*a* = 5"
)
x <- c(.4, .3, .8)
y <- c(.8, .5, .3)
rot <- c(0, -45, 45)
gp = gpar(col = c("black", "red", "black"))
box_gp = gpar(col = "black", fill = c("cornsilk", NA, "lightblue1"), lty = c(1, 1, 1))
hjust <- c(0.5, 0, 1)
vjust <- c(0.5, 1, 0)
g <- richtext_grob(
text, x, y, hjust = hjust, vjust = vjust, rot = rot,
padding = unit(c(6, 6, 4, 6), "pt"),
r = unit(c(0, 4, 8), "pt"),
gp = gp, box_gp = box_gp,
debug = TRUE
)
grid.draw(g)
grid.points(x, y, default.units = "npc", pch = 19, size = unit(5, "pt"))
invisible()
}
}
expect_doppelganger("Various text boxes w/ debug", draw_labels_debug())
draw_aligned_heights <- function() {
function() {
text <- c(
"Some text **in bold.**
(centered)", "Linebreaks
Linebreaks
Linebreaks",
"*x*2 + 5*x* + *C*i
*a* = 5"
)
x <- c(.4, .3, .8)
y <- c(.8, .5, .3)
rot <- c(0, -45, 45)
gp = gpar()
box_gp = gpar(col = "black", fill = c("cornsilk", NA, "lightblue1"))
hjust <- c(0.5, 0, 1)
vjust <- c(0.5, 1, 0)
g <- richtext_grob(
text, x, y, halign = 0.5, valign = 0.5,
hjust = hjust, vjust = vjust, rot = rot,
align_heights = TRUE,
padding = unit(c(6, 6, 4, 6), "pt"),
r = unit(c(0, 4, 8), "pt"),
gp = gp, box_gp = box_gp
)
grid.draw(g)
grid.text("Box heights aligned, content centered", gp = gpar(fontface = "bold"), 0.02, 1, hjust = 0, vjust = 1.2)
grid.points(x, y, default.units = "npc", pch = 19, size = unit(5, "pt"))
invisible()
}
}
expect_doppelganger("Aligned heights", draw_aligned_heights())
draw_aligned_widths <- function() {
function() {
text <- c(
"Some text **in bold.**
(centered)", "Linebreaks
Linebreaks
Linebreaks",
"*x*2 + 5*x* + *C*i
*a* = 5"
)
x <- c(.4, .3, .8)
y <- c(.8, .5, .3)
rot <- c(0, -45, 45)
gp = gpar()
box_gp = gpar(col = "black", fill = c("cornsilk", NA, "lightblue1"))
hjust <- c(0.5, 0, 1)
vjust <- c(0.5, 1, 0)
g <- richtext_grob(
text, x, y, halign = 0.5, valign = 0.5,
hjust = hjust, vjust = vjust, rot = rot,
align_widths = TRUE,
padding = unit(c(6, 6, 4, 6), "pt"),
r = unit(c(0, 4, 8), "pt"),
gp = gp, box_gp = box_gp
)
grid.draw(g)
grid.text("Box widths aligned, content centered", gp = gpar(fontface = "bold"), 0.02, 1, hjust = 0, vjust = 1.2)
grid.points(x, y, default.units = "npc", pch = 19, size = unit(5, "pt"))
invisible()
}
}
expect_doppelganger("Aligned widths", draw_aligned_widths())
})
gridtext/tests/testthat/test-vbox.R 0000644 0001762 0000144 00000006761 14310622556 017202 0 ustar ligges users test_that("vertical stacking works", {
nb <- bl_make_null_box()
rb1 <- bl_make_rect_box(nb, 100, 100, rep(0, 4), rep(0, 4), gp = gpar())
rb2 <- bl_make_rect_box(nb, 50, 50, rep(10, 4), rep(0, 4), gp = gpar())
rb3 <- bl_make_rect_box(nb, 50, 10, rep(0, 4), rep(0, 4), gp = gpar(), width_policy = "expand")
vb <- bl_make_vbox(list(rb1, rb2, rb3), width = 200, hjust = 0, vjust = 0, width_policy = "fixed")
bl_calc_layout(vb, 0, 0)
bl_place(vb, 0, 0)
expect_identical(bl_box_width(vb), 200)
expect_identical(bl_box_height(vb), 160)
expect_identical(bl_box_voff(vb), 0)
g <- bl_render(vb, 200, 100)
out1 <- g[[1]]
expect_identical(out1$x, unit(200, "pt"))
expect_identical(out1$y, unit(100 + 10 + 50, "pt"))
out2 <- g[[2]]
expect_identical(out2$x, unit(210, "pt"))
expect_identical(out2$y, unit(100 + 10 + 10, "pt"))
out3 <- g[[3]]
expect_identical(out3$x, unit(200, "pt"))
expect_identical(out3$y, unit(100, "pt"))
expect_identical(out3$width, unit(200, "pt"))
# alternatve hjust, vjust, x, y
vb <- bl_make_vbox(list(rb1, rb2, rb3), width = 200, hjust = 1, vjust = 1, width_policy = "fixed")
bl_calc_layout(vb, 0, 0)
bl_place(vb, 15, 27)
expect_identical(bl_box_width(vb), 200)
expect_identical(bl_box_height(vb), 160)
g <- bl_render(vb, 200, 100)
out1 <- g[[1]]
expect_identical(out1$x, unit(15 + 0, "pt"))
expect_identical(out1$y, unit(27 - 60 + 10 + 50, "pt"))
out2 <- g[[2]]
expect_identical(out2$x, unit(15 + 10, "pt"))
expect_identical(out2$y, unit(27 - 60 + 10 + 10, "pt"))
out3 <- g[[3]]
expect_identical(out3$x, unit(15 + 0, "pt"))
expect_identical(out3$y, unit(27 - 60, "pt"))
expect_identical(out3$width, unit(200, "pt"))
})
test_that("size policies", {
nb <- bl_make_null_box()
rb1 <- bl_make_rect_box(nb, 100, 100, rep(0, 4), rep(0, 4), gp = gpar())
rb2 <- bl_make_rect_box(nb, 50, 50, rep(10, 4), rep(0, 4), gp = gpar())
vb <- bl_make_vbox(list(rb1, rb2), width = 200, hjust = 0.5, vjust = 0.5, width_policy = "native")
bl_calc_layout(vb, 0, 0)
expect_identical(bl_box_width(vb), 100)
expect_identical(bl_box_height(vb), 150)
vb <- bl_make_vbox(list(rb1, rb2), width = 200, hjust = 0.5, vjust = 0.5, width_policy = "relative")
bl_calc_layout(vb, 70, 0)
expect_identical(bl_box_width(vb), 140)
expect_identical(bl_box_height(vb), 150)
vb <- bl_make_vbox(list(rb1, rb2), width = 200, hjust = 0.5, vjust = 0.5, width_policy = "expand")
bl_calc_layout(vb, 300, 0)
expect_identical(bl_box_width(vb), 300)
expect_identical(bl_box_height(vb), 150)
})
test_that("vertical offset is ignored in vertical stacking", {
tb1 <- bl_make_text_box("string1", gp = gpar(fontsize = 10))
tb2 <- bl_make_text_box("string2", gp = gpar(fontsize = 20), voff = -10)
tb3 <- bl_make_text_box("string2", gp = gpar(fontsize = 20), voff = 0)
tb4 <- bl_make_text_box("string3", gp = gpar(fontsize = 15))
vb1 <- bl_make_vbox(list(tb1, tb2, tb4), hjust = 0, vjust = 0)
bl_calc_layout(vb1, 100, 100)
bl_place(vb1, 17, 24)
vb2 <- bl_make_vbox(list(tb1, tb3, tb4), hjust = 0, vjust = 0)
bl_calc_layout(vb2, 100, 100)
bl_place(vb2, 17, 24)
g1 <- bl_render(vb1, 0, 0)
g2 <- bl_render(vb2, 0, 0)
extract <- function(x, name) {x[[name]]}
expect_identical(
lapply(g1, extract, name = "x"),
lapply(g2, extract, name = "x")
)
expect_identical(
lapply(g1, extract, name = "y"),
lapply(g2, extract, name = "y")
)
expect_identical(
lapply(g1, extract, name = "label"),
lapply(g2, extract, name = "label")
)
})
gridtext/tests/testthat/test-grid-constructors.R 0000644 0001762 0000144 00000012272 14310622556 021711 0 ustar ligges users test_that("unit_pt", {
expect_equal(
unit_pt(10),
grid::unit(10, "pt")
)
expect_identical(
unit_pt(1:10),
grid::unit(1:10, "pt")
)
})
test_that("gpar_empty", {
expect_identical(
gpar_empty(),
grid::gpar()
)
})
test_that("text_grob", {
# basic functionality, gp is set to gpar() if not provided
expect_identical(
text_grob("test", 10, 20, name = "abc"),
textGrob(
"test",
x = unit(10, "pt"), y = unit(20, "pt"),
hjust = 0, vjust = 0,
gp = gpar(),
name = "abc"
)
)
# basic functionality, x and y are set to 0 if not provided
expect_identical(
text_grob("test", name = "abc"),
textGrob(
"test",
x = unit(0, "pt"), y = unit(0, "pt"),
hjust = 0, vjust = 0,
gp = gpar(),
name = "abc"
)
)
# gp is set as requested
gp <- gpar(col = "blue", fill = "red")
expect_identical(
text_grob("test", 10, 20, gp = gp, name = "abc"),
textGrob(
"test",
x = unit(10, "pt"), y = unit(20, "pt"),
hjust = 0, vjust = 0,
gp = gp,
name = "abc"
)
)
# if no name is provided, different names are assigned
g1 <- text_grob("test")
g2 <- text_grob("test")
expect_false(identical(g1$name, g2$name))
# function is not vectorized
expect_error(
text_grob(c("test", "test"), 10, 20),
"not vectorized"
)
expect_error(
text_grob("test", 1:5, 20),
"not vectorized"
)
expect_error(
text_grob("test", 10, 1:5),
"not vectorized"
)
# arguments of length 0 are also disallowed
expect_error(
text_grob("test", numeric(0), 5),
"not vectorized"
)
})
test_that("raster_grob", {
# basic functionality
image <- matrix(0:1, ncol = 5, nrow = 4)
expect_identical(
raster_grob(image, 10, 20, 50, 40, gp = gpar(), name = "abc"),
rasterGrob(
image,
x = unit(10, "pt"), y = unit(20, "pt"),
width = unit(50, "pt"), height = unit(40, "pt"),
hjust = 0, vjust = 0,
interpolate = TRUE,
gp = gpar(),
name = "abc"
)
)
# interpolate is set as requested, gp default is NULL
expect_identical(
raster_grob(image, 10, 20, 50, 40, interpolate = FALSE, name = "abc"),
rasterGrob(
image,
x = unit(10, "pt"), y = unit(20, "pt"),
width = unit(50, "pt"), height = unit(40, "pt"),
hjust = 0, vjust = 0,
interpolate = FALSE,
gp = NULL,
name = "abc"
)
)
# if no name is provided, different names are assigned
g1 <- raster_grob(image)
g2 <- raster_grob(image)
expect_false(identical(g1$name, g2$name))
# function is not vectorized
expect_error(
raster_grob(image, c(10, 20), 20, 100, 140),
"not vectorized"
)
expect_error(
raster_grob(image, 10, numeric(0), 100, 140),
"not vectorized"
)
})
test_that("rect_grob", {
# basic functionality, gp is set to gpar() if not provided
expect_identical(
rect_grob(10, 20, 100, 140, name = "abc"),
rectGrob(
x = unit(10, "pt"), y = unit(20, "pt"),
width = unit(100, "pt"), height = unit(140, "pt"),
hjust = 0, vjust = 0,
gp = gpar(),
name = "abc"
)
)
# gp is set as requested
gp <- gpar(col = "blue", fill = "red")
expect_identical(
rect_grob(10, 20, 100, 140, gp = gp, name = "abc"),
rectGrob(
x = unit(10, "pt"), y = unit(20, "pt"),
width = unit(100, "pt"), height = unit(140, "pt"),
hjust = 0, vjust = 0,
gp = gp,
name = "abc"
)
)
# if no name is provided, different names are assigned
g1 <- rect_grob()
g2 <- rect_grob()
expect_false(identical(g1$name, g2$name))
# function is not vectorized
expect_error(
rect_grob(c(10, 20), 20, 100, 140),
"not vectorized"
)
expect_error(
rect_grob(10, numeric(0), 100, 140),
"not vectorized"
)
})
test_that("roundrect_grob", {
# basic functionality, gp is set to gpar() if not provided
expect_identical(
roundrect_grob(10, 20, 100, 140, 10, name = "abc"),
roundrectGrob(
x = unit(10, "pt"), y = unit(20, "pt"),
width = unit(100, "pt"), height = unit(140, "pt"),
r = unit(10, "pt"),
just = c(0, 0),
gp = gpar(),
name = "abc"
)
)
# gp is set as requested
gp <- gpar(col = "blue", fill = "red")
expect_identical(
roundrect_grob(10, 20, 100, 140, 20, gp = gp, name = "abc"),
roundrectGrob(
x = unit(10, "pt"), y = unit(20, "pt"),
width = unit(100, "pt"), height = unit(140, "pt"),
r = unit(20, "pt"),
just = c(0, 0),
gp = gp,
name = "abc"
)
)
# if no name is provided, different names are assigned
g1 <- roundrect_grob()
g2 <- roundrect_grob()
expect_false(identical(g1$name, g2$name))
# function is not vectorized
expect_error(
roundrect_grob(c(10, 20), 20, 100, 140, 20),
"not vectorized"
)
expect_error(
roundrect_grob(10, numeric(0), 100, 140, 20),
"not vectorized"
)
})
test_that("set_grob_coords", {
g <- list(x = 0, y = 0)
# setting coords as numbers
expect_identical(
set_grob_coords(g, x = 20, y = 40),
list(x = 20, y = 40)
)
# setting coords as units
expect_identical(
set_grob_coords(g, x = unit_pt(20), y = unit_pt(40)),
list(x = unit_pt(20), y = unit_pt(40))
)
})
gridtext/tests/testthat/test-text-details.R 0000644 0001762 0000144 00000003075 14310622556 020626 0 ustar ligges users test_that("text_details() calculates info correctly", {
# descent and space are independent of string
gp1 <- gpar(fontfamily = "Helvetica", fontface = "plain", fontsize = 10)
t1 <- text_details("abcd", gp = gp1)
t2 <- text_details("gjqp", gp = gp1)
expect_equal(t1$descent_pt, t2$descent_pt)
expect_equal(t1$space_pt, t2$space_pt)
# recalculating the same details gives same results (tests caching)
t2 <- text_details("abcd", gp = gp1)
expect_equal(t1$width_pt, t2$width_pt)
expect_equal(t1$ascent_pt, t2$ascent_pt)
expect_equal(t1$descent_pt, t2$descent_pt)
expect_equal(t1$space_pt, t2$space_pt)
# all parameters scale with font size
gp2 <- gpar(fontfamily = "Helvetica", fontface = "plain", fontsize = 20)
t2 <- text_details("abcd", gp = gp2)
expect_equal(2 * t1$width_pt, t2$width_pt)
expect_equal(2 * t1$ascent_pt, t2$ascent_pt)
expect_equal(2 * t1$descent_pt, t2$descent_pt)
expect_equal(2 * t1$space_pt, t2$space_pt)
# parameters change with font
gp2 <- gpar(fontfamily = "Times", fontface = "plain", fontsize = 10)
t2 <- text_details("abcd", gp = gp2)
expect_false(t1$width_pt == t2$width_pt)
expect_false(t1$ascent_pt == t2$ascent_pt)
expect_false(t1$descent_pt == t2$descent_pt)
expect_false(t1$space_pt == t2$space_pt)
# font details are identical to what we would get from an actual grob
g <- textGrob("Qbcd", gp = gp1)
t1 <- text_details("Qbcd", gp = gp1)
expect_equal(t1$ascent_pt, convertHeight(grobHeight(g), "pt", valueOnly = TRUE))
expect_equal(t1$width_pt, convertWidth(grobWidth(g), "pt", valueOnly = TRUE))
})
gridtext/tests/testthat/test-get_file.R 0000644 0001762 0000144 00000000655 14310622556 017776 0 ustar ligges users test_that("get_file works", {
# skip test on cran because the url could be broken in the future
skip_on_cran()
# get_file returns raw data if it's an url and a character path if it's
# a local path. That's why we test it with the function read_image that calls it
expect_identical(
read_image("https://upload.wikimedia.org/wikipedia/commons/6/62/Biedronka.drs.png"),
read_image("../figs/test_image.png")
)
})
gridtext/tests/testthat/test-raster-box.R 0000644 0001762 0000144 00000012361 14310622556 020303 0 ustar ligges users test_that("image dimensions are used", {
logo_file <- system.file("extdata", "Rlogo.png", package = "gridtext")
logo <- png::readPNG(logo_file, native = FALSE)
# default size policy is native for both height and width
# dpi = 72.27 turns lengths in pixels to lengths in pt
rb <- bl_make_raster_box(logo, dpi = 72.27)
bl_calc_layout(rb, 100, 100)
bl_place(rb, 30, 5)
g <- bl_render(rb, 10, 20)
img <- g[[1]]
expect_identical(img$x, unit(40, "pt"))
expect_identical(img$y, unit(25, "pt"))
expect_equal(img$width, unit(ncol(logo), "pt"))
expect_equal(img$height, unit(nrow(logo), "pt"))
# test now with raster object
logo2 <- as.raster(logo)
rb <- bl_make_raster_box(logo2, dpi = 72.27)
bl_calc_layout(rb, 100, 100)
g <- bl_render(rb, 10, 20)
img <- g[[1]]
expect_identical(img$x, unit(10, "pt"))
expect_identical(img$y, unit(20, "pt"))
expect_equal(img$width, unit(ncol(logo), "pt"))
expect_equal(img$height, unit(nrow(logo), "pt"))
# test now with nativeRaster object
logo3 <- png::readPNG(logo_file, native = TRUE)
rb <- bl_make_raster_box(logo3, dpi = 72.27)
bl_calc_layout(rb, 100, 100)
g <- bl_render(rb, 10, 20)
img <- g[[1]]
expect_identical(img$x, unit(10, "pt"))
expect_identical(img$y, unit(20, "pt"))
expect_equal(img$width, unit(ncol(logo), "pt"))
expect_equal(img$height, unit(nrow(logo), "pt"))
# dimensions are reported correctly
expect_equal(bl_box_width(rb), ncol(logo))
expect_equal(bl_box_height(rb), nrow(logo))
expect_equal(bl_box_ascent(rb), nrow(logo))
expect_identical(bl_box_descent(rb), 0)
expect_identical(bl_box_voff(rb), 0)
m <- 1:10
dim(m) <- 10
expect_error(
bl_make_raster_box(m),
"Cannot extract image dimensions."
)
})
test_that("size policies, respect_aspect = FALSE", {
logo_file <- system.file("extdata", "Rlogo.png", package = "gridtext")
logo <- png::readPNG(logo_file, native = TRUE)
rb <- bl_make_raster_box(logo, width = 50, height = 80,
width_policy = "fixed", height_policy = "fixed",
respect_aspect = FALSE)
bl_calc_layout(rb, 200, 100)
g <- bl_render(rb, 10, 20)
img <- g[[1]]
expect_identical(img$x, unit(10, "pt"))
expect_identical(img$y, unit(20, "pt"))
expect_identical(img$width, unit(50, "pt"))
expect_identical(img$height, unit(80, "pt"))
rb <- bl_make_raster_box(logo, width = 50, height = 80,
width_policy = "relative", height_policy = "expand",
respect_aspect = FALSE)
bl_calc_layout(rb, 200, 100)
g <- bl_render(rb, 10, 20)
img <- g[[1]]
expect_identical(img$x, unit(10, "pt"))
expect_identical(img$y, unit(20, "pt"))
expect_identical(img$width, unit(100, "pt"))
expect_identical(img$height, unit(100, "pt"))
rb <- bl_make_raster_box(logo, width = 50, height = 80,
width_policy = "expand", height_policy = "relative",
respect_aspect = FALSE)
bl_calc_layout(rb, 200, 100)
g <- bl_render(rb, 10, 20)
img <- g[[1]]
expect_identical(img$x, unit(10, "pt"))
expect_identical(img$y, unit(20, "pt"))
expect_identical(img$width, unit(200, "pt"))
expect_identical(img$height, unit(80, "pt"))
rb <- bl_make_raster_box(logo, width = 50, height = 80,
width_policy = "fixed", height_policy = "native",
respect_aspect = FALSE)
bl_calc_layout(rb, 200, 100)
g <- bl_render(rb, 10, 20)
img <- g[[1]]
expect_identical(img$x, unit(10, "pt"))
expect_identical(img$y, unit(20, "pt"))
expect_identical(img$width, unit(50, "pt"))
expect_equal(img$height, unit(50*nrow(logo)/ncol(logo), "pt"))
rb <- bl_make_raster_box(logo, width = 50, height = 80,
width_policy = "native", height_policy = "fixed",
respect_aspect = FALSE)
bl_calc_layout(rb, 200, 100)
g <- bl_render(rb, 10, 20)
img <- g[[1]]
expect_identical(img$x, unit(10, "pt"))
expect_identical(img$y, unit(20, "pt"))
expect_equal(img$width, unit(80*ncol(logo)/nrow(logo), "pt"))
expect_identical(img$height, unit(80, "pt"))
})
test_that("size policies, respect_aspect = TRUE", {
logo_file <- system.file("extdata", "Rlogo.png", package = "gridtext")
logo <- png::readPNG(logo_file, native = TRUE)
rb <- bl_make_raster_box(logo, width = 50, height = 80,
width_policy = "fixed", height_policy = "fixed")
bl_calc_layout(rb, 200, 100)
g <- bl_render(rb, 10, 20)
nr <- nrow(logo)
nc <- ncol(logo)
img_height <- 50*nr/nc
yoff <- (80 - img_height)/2
img <- g[[1]]
expect_identical(img$x, unit(10, "pt"))
expect_equal(img$y, unit(20 + yoff, "pt"))
expect_identical(img$width, unit(50, "pt"))
expect_equal(img$height, unit(img_height, "pt"))
rb <- bl_make_raster_box(logo, width = 80, height = 50,
width_policy = "fixed", height_policy = "fixed")
bl_calc_layout(rb, 200, 100)
g <- bl_render(rb, 10, 20)
nr <- nrow(logo)
nc <- ncol(logo)
img_width <- 50*nc/nr
xoff <- (80 - img_width)/2
img <- g[[1]]
expect_equal(img$x, unit(10 + xoff, "pt"))
expect_identical(img$y, unit(20, "pt"))
expect_equal(img$width, unit(img_width, "pt"))
expect_identical(img$height, unit(50, "pt"))
})
gridtext/tests/testthat/test-grid-renderer.R 0000644 0001762 0000144 00000007211 14310622556 020744 0 ustar ligges users context("grid-renderer")
test_that("basic functioning", {
r <- grid_renderer()
g <- grid_renderer_collect_grobs(r)
# without any grobs rendered, we get an empty list of class gList
expect_equal(length(g), 0)
expect_true(inherits(g, "gList"))
# grobs get added in order
grid_renderer_text(r, "abcd", 100, 100, gpar())
grid_renderer_rect(r, 100, 100, 200, 200, gpar())
g <- grid_renderer_collect_grobs(r)
expect_equal(length(g), 2)
expect_true(inherits(g, "gList"))
expect_true(inherits(g[[1]], "text"))
expect_true(inherits(g[[2]], "rect"))
# internal state gets reset after calling collect_grobs()
g <- grid_renderer_collect_grobs(r)
expect_equal(length(g), 0)
expect_true(inherits(g, "gList"))
})
test_that("smart rendering of rects", {
r <- grid_renderer()
# add normal rect
grid_renderer_rect(r, 100, 100, 200, 200, gp = gpar())
# add rect with rounded corners
grid_renderer_rect(r, 100, 100, 200, 200, gp = gpar(), r = 5)
# add rect that is invisible, gets removed automatically
grid_renderer_rect(r, 100, 100, 200, 200, gp = gpar(col = NA))
g <- grid_renderer_collect_grobs(r)
expect_equal(length(g), 2)
expect_true(inherits(g, "gList"))
expect_true(inherits(g[[1]], "rect"))
expect_true(inherits(g[[2]], "roundrect"))
# more extensive testing variations for dropping unneeded rects
grid_renderer_rect(r, 100, 100, 200, 200, gp = gpar(lty = 0))
g <- grid_renderer_collect_grobs(r)
expect_equal(length(g), 0)
grid_renderer_rect(r, 100, 100, 200, 200, gp = gpar(col = NA, lty = 1))
g <- grid_renderer_collect_grobs(r)
expect_equal(length(g), 0)
grid_renderer_rect(r, 100, 100, 200, 200, gp = gpar(col = "black", lty = 0))
g <- grid_renderer_collect_grobs(r)
expect_equal(length(g), 0)
grid_renderer_rect(r, 100, 100, 200, 200, gp = gpar(fill = NA, lty = 0))
g <- grid_renderer_collect_grobs(r)
expect_equal(length(g), 0)
grid_renderer_rect(r, 100, 100, 200, 200, gp = gpar(fill = NA, col = "black", lty = 0))
g <- grid_renderer_collect_grobs(r)
expect_equal(length(g), 0)
grid_renderer_rect(r, 100, 100, 200, 200, gp = gpar(fill = NA, col = NA, lty = 1))
g <- grid_renderer_collect_grobs(r)
expect_equal(length(g), 0)
})
test_that("visual tests", {
draw_grob <- function(g) {
function() {
grid.newpage()
grid.draw(g)
invisible()
}
}
r <- grid_renderer()
grid_renderer_text(r, "blue", 10, 400, gp = gpar(col = "blue", fontsize = 12))
grid_renderer_text(r, "red bold", 20, 380, gp = gpar(col = "red", fontsize = 12, fontface = "bold"))
grid_renderer_text(r, "roman", 30, 360, gp = gpar(fontsize = 12, fontfamily = "Times"))
g <- grid_renderer_collect_grobs(r)
expect_doppelganger("Text in different stylings", draw_grob(g))
grid_renderer_rect(r, 100, 400, 200, 20, gp = gpar(col = "blue"))
grid_renderer_rect(r, 100, 200, 300, 30, gp = gpar(fill = "cornsilk"), r = 8)
grid_renderer_text(r, "text 1, square box blue", 100, 400, gp = gpar(fontsize = 20))
grid_renderer_text(r, "text 2, rounded box filled", 100, 200, gp = gpar(fontsize = 20))
g <- grid_renderer_collect_grobs(r)
expect_doppelganger("Mixing text and boxes", draw_grob(g))
logo_file <- system.file("extdata", "Rlogo.png", package = "gridtext")
logo <- png::readPNG(logo_file, native = TRUE)
width <- ncol(logo)
height <- nrow(logo)
grid_renderer_raster(r, logo, 10, 10, width, height)
g <- grid_renderer_collect_grobs(r)
expect_doppelganger("Rendering raster data", draw_grob(g))
})
test_that("text details are calculated correctly", {
gp = gpar(fontsize = 20)
td <- text_details("abcd", gp)
td2 <- grid_renderer_text_details("abcd", gp)
expect_identical(td, td2)
})
gridtext/tests/figs/ 0000755 0001762 0000144 00000000000 14310622556 014202 5 ustar ligges users gridtext/tests/figs/test_image.png 0000644 0001762 0000144 00000452717 14310622556 017051 0 ustar ligges users PNG
IHDR u , UIDATx^Li%[y'Vu5nHd& (AC_A2
dM7 Fzdv͛y " 9wu1GX{ [_}\ѻks
cξ/cHnt݇K!PVo)Zsk\ >^k}Tx ?۱9t5gqιZkJk-z>~[T N1%5*qV]c:>FB?{ō]\qt~h;#w
.fg곮݊~P^>;Ӈ'q.9 B.u9?K )ǒg΅Fikӧ )< έ#1r9vkbczǽ~e}|L15n˻}n>1}Z12[?Yդ3Ys #9;vsCpι֎>>\cMAQ k9ZP n<V"۰e0Z0-krJ kz
o V}8{I aC73e.ޛ(muȦe}6eJ 6-'%|~y~:J p5\ 2ع`օ$ha6
Fo"xo(GaFUZ+ :p<'HtO SbzKGR> *u,FQoIqҜTeS 9
>-37"$=Ҙar2KgH,^r֬ S!DRYO.U| Y(Cnpr JC ף# GOq eo-!c O$ 9w[m:ĝŃncQe? (fXhwL0u+ uq>
D]d6ԤxǔKYxjqStPޟJi. tRz_'uiV1X3J AџE(Go%l 5_f;V"<HwA%ZytIT5Z8/JRqHnC*<ɱM;ۖ7bHoN7 G-)Gǣ Q UNI1w Ni@gp7؛k[oZsz+Xy_QT˽PyfGYV, NR뎇CbeP8Ј!JU{Ȯ9CiS!vIIkG dp3 ;,6U>/*t-N qk7ɼĆ5$SwzKQge26_[7StLK mi1\NJh^s2"Uܛk8._aw7}RFϜx?cVlB#^R.AP{k)n ѣ(0K`7n-t2XZ՟_^}~aV>"4◰E@ H ) r K|ncL[@{^g^թ/;guZkM]jDB2VyC }CQ}*i<J)-t
=$}n^8dWPŒUb&61])("*@ҍjkڗ0 +gT}.o0srM2! beR|p@ufqgHƽS%s|q
n^vfs
j̇}GQ# YEkf;TGαrNd6)Hp4gXZLqΤlN F?)'eٳC 08?6vg:Ai]R`FQ(#zVC^<+&TL9
hBɜ&8fT(w"K`͓l g
7gQn>| d 4 (7%?';+n(Bѝs6 'u}:yC]iV0c0~1S@E B)[6?P}Ag {rY߶um lA`H=b$%ۊ!& -kf]MISw;?s$