diff --git a/NAMESPACE b/NAMESPACE index dec4757..d4a710a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,6 +5,7 @@ S3method(element_grob,element_textbox) export(GeomRichText) export(GeomRichtext) export(GeomTextBox) +export(draw_key_richtext) export(element_markdown) export(element_textbox) export(element_textbox_simple) diff --git a/R/draw-keys.R b/R/draw-keys.R new file mode 100644 index 0000000..2d6bd31 --- /dev/null +++ b/R/draw-keys.R @@ -0,0 +1,92 @@ +#' Key glyph for rich text +#' +#' This is a function for rendering the key in the rich text style when a geom +#' needs to be displayed in a legend. It is designed to be provided to a layer's +#' `key_glyph` argument, either as a function or as `key_glyph = "richtext"`. +#' +#' @inheritParams ggplot2::draw_key +#' +#' @return A [`richtext_grob`][gridtext::richtext_grob] that represents +#' formatted text. +#' @export +#' +#' @examples +#' library(ggplot2) +#' +#' ggplot(mtcars, aes(wt, mpg, label = rownames(mtcars))) + +#' geom_richtext(aes(colour = factor(cyl)), key_glyph = "richtext") +draw_key_richtext <- function(data, params, size) { + + # Set text justification + data$hjust <- data$hjust %||% 0.5 + data$vjust <- data$vjust %||% 0.5 + data$angle <- data$angle %||% 0 + just <- rotate_just(data$angle, data$hjust, data$vjust) + + # Populate graphical parameters for text + text_gp <- gpar( + fontsize = (data$size %||% 3.88) * .pt, + fontfamily = data$family %||% "", + fontface = data$face %||% 1, + col = scales::alpha( + data$text.colour %||% data$colour %||% "black", + data$alpha %||% NA + ), + lineheight = data$lineheight %||% 1.2 + ) + + # Populate graphical parameters for text box + lwd <- (data$label.size %||% 0.25) * .pt + box_gp <- gpar( + col = scales::alpha( + data$label.colour %||% data$colour %||% "black", + data$alpha %||% NA + ), + fill = scales::alpha(data$fill %||% "white", data$alpha %||% NA), + lwd = lwd + ) + + grob <- richtext_grob( + text = data[["label"]] %||% "a", # prevent partial matching + x = unit(just$hjust, "npc"), + y = unit(just$vjust, "npc"), + rot = data$angle, + hjust = data$hjust, + vjust = data$vjust, + gp = text_gp, + box_gp = box_gp, + # Defaults for unit input are the same as `geom_richtext()` formals + r = params$label.r %||% unit(0.15, "lines"), + padding = params$label.padding %||% + unit(c(0.25, 0.25, 0.25, 0.25), "lines"), + margin = params$label.margin %||% + unit(c(0, 0, 0, 0), "lines"), + ) + + # Key drawing functions deal with 1 key at a time, so we can extract the + # box's (relative) coordinates from the first child-grob. + # The units are given in points + x <- range(grob$children[[1]]$xext) + c(-0.5, 0.5) * lwd + y <- range(grob$children[[1]]$yext) + c(-0.5, 0.5) * lwd + + # # Calculate offsets that account for textbox size + # xoffset <- x[1] * (1 - just$hjust) + x[2] * just$hjust + # yoffset <- y[1] * (1 - just$vjust) + y[2] * just$vjust + # + # # We apply offsets to the grob's viewport so that textbox is remains within + # # the bounds of the key area + # grob <- editGrob( + # grob, + # vp = viewport( + # x = unit(0.5, "npc") - unit(xoffset, "pt"), + # y = unit(0.5, "npc") - unit(yoffset, "pt") + # ) + # ) + + # Calculate size in cm. + # 'x * .pt' converts mm to pt, so 'x / .pt' converts pt to mm + # This circumvents `convertWidth(grobWidth(grob), "cm", valueOnly = TRUE)` + attr(grob, "width") <- diff(x) / (10 * .pt) + attr(grob, "height") <- diff(y) / (10 * .pt) + grob +} \ No newline at end of file diff --git a/man/draw_key_richtext.Rd b/man/draw_key_richtext.Rd new file mode 100644 index 0000000..e3f728b --- /dev/null +++ b/man/draw_key_richtext.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/draw-keys.R +\name{draw_key_richtext} +\alias{draw_key_richtext} +\title{Key glyph for rich text} +\usage{ +draw_key_richtext(data, params, size) +} +\arguments{ +\item{data}{A single row data frame containing the scaled aesthetics to +display in this key} + +\item{params}{A list of additional parameters supplied to the geom.} + +\item{size}{Width and height of key in mm.} +} +\value{ +A \code{\link[gridtext:richtext_grob]{richtext_grob}} that represents +formatted text. +} +\description{ +This is a function for rendering the key in the rich text style when a geom +needs to be displayed in a legend. It is designed to be provided to a layer's +\code{key_glyph} argument, either as a function or as \code{key_glyph = "richtext"}. +} +\examples{ +library(ggplot2) + +ggplot(mtcars, aes(wt, mpg, label = rownames(mtcars))) + + geom_richtext(aes(colour = factor(cyl)), key_glyph = "richtext") +} diff --git a/tests/testthat/_snaps/draw-keys/rotated-rich-text-keys.svg b/tests/testthat/_snaps/draw-keys/rotated-rich-text-keys.svg new file mode 100644 index 0000000..ef93642 --- /dev/null +++ b/tests/testthat/_snaps/draw-keys/rotated-rich-text-keys.svg @@ -0,0 +1,221 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +5 +6 +7 +8 + + + + + + + + + + +2.0 +2.5 +3.0 +3.5 +4.0 +4.5 +Sepal.Width +Sepal.Length + +Species + + +Iris +setosa + + +Iris +versicolor + + +Iris +virginica +Rotated rich text keys + + diff --git a/tests/testthat/test-draw-keys.R b/tests/testthat/test-draw-keys.R new file mode 100644 index 0000000..1366b6d --- /dev/null +++ b/tests/testthat/test-draw-keys.R @@ -0,0 +1,18 @@ +test_that("visual test", { + skip_if_not(packageVersion("ggplot2") >= "3.5.0") + + p <- ggplot(iris, aes(Sepal.Width, Sepal.Length, colour = Species)) + + geom_point(key_glyph = "richtext") + + scale_colour_discrete( + labels = NULL, + guide = guide_legend(override.aes = list( + label = paste0( + "Iris", + c("
setosa", " versicolor", "
virginica"), "
" + ), + size = 11 / .pt, hjust = c(1, 0.5, 0), angle = c(-45, 0, 45), + label.colour = "blue" + )) + ) + expect_doppelganger("Rotated rich text keys", p) +})