diff --git a/R/boxGrobs_boxGrob.R b/R/boxGrobs_boxGrob.R index 70963b1..94093fb 100644 --- a/R/boxGrobs_boxGrob.R +++ b/R/boxGrobs_boxGrob.R @@ -12,8 +12,9 @@ #' See the \code{just} option for the \code{\link[grid]{viewport}} #' @param txt_gp The \code{\link[grid]{gpar}} style to apply to the text. Set \code{boxGrobTxt} option #' if you want to customize all the boxes at once. -#' @param box_gp The \code{\link[grid]{gpar}} style to apply to the box. Set \code{boxGrob} option -#' if you want to customize all the boxes at once. +#' @param box_gp The \code{\link[grid]{gpar}} style to apply to the box function of `boxFN` below. +#' @param boxFN Function to create box for the text. Parameters of `x=0.5`, `y=0.5` and `box_gp` will +#' be passed to this function. #' @param name a character identifier for the \code{grob}. Used to find the \code{grob} on the display #' list and/or as a child of another grob. #' @@ -35,8 +36,10 @@ boxGrob <- function(label, height, just = "center", bjust = "center", - txt_gp = getOption("boxGrobTxt", default = gpar(color = "black")), + txt_gp = getOption("boxGrobTxt", default = gpar(color = "black", + cex = 1)), box_gp = getOption("boxGrob", gpar(fill = "white")), + boxFN = roundrectGrob, name = NULL) { assert( checkString(label), @@ -51,11 +54,12 @@ boxGrob <- function(label, assert_just(bjust) assert_class(txt_gp, "gpar") assert_class(box_gp, "gpar") + x <- prAsUnit(x) y <- prAsUnit(y) - txt_padding <- unit(4, "mm") + txt_padding <- unit(4*txt_gp$cex, "mm") txt <- textGrob( label = label, x = prGetX4Txt(just, txt_padding), y = .5, @@ -83,7 +87,8 @@ boxGrob <- function(label, just = bjust ) - rect <- roundrectGrob(x = .5, y = .5, gp = box_gp, name = "rect_around") + rect <- do.call(boxFN, list(x = .5, y = .5, gp = box_gp)) + gl <- grobTree( gList( rect,