Merge pull request #58 from adayim/grob_decorator

Add rectangle option to the boxGrobs.#57
gforge · Jul 22, 2021 · 2f87aaf · 2f87aaf
2 parents 7950346 + f0f77f9
commit 2f87aaf
Showing 1 changed file with 10 additions and 5 deletions.
diff --git 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,