Add support for true rtl text

R/classic_style.R

@@ -13,6 +13,8 @@
 #' @param header_font The font family to use for headers
 #' @param code_font The font family to use for code and code block text
 #' @inheritDotParams base_style -family -size
+#' @param ltr Is the style intended for left-to-right text? This affects list
+#' indentation and citation border
 #'
 #' @return A style set object
 #'
@@ -22,13 +24,13 @@
 #' classic_style(16, "serif", "sans")
 #'
 classic_style <- function(base_size = 12, body_font = "", header_font = "",
-                          code_font = "mono", ...) {
+                          code_font = "mono", ..., ltr = TRUE) {
   base <- base_style(family = body_font, size = base_size, ...)
   style_set(
     base = base,
     body = style(margin = skip_inherit(trbl(0))),
-    ul   = style(padding = trbl(0, 0, 0, em(2)), background = NA, border = NA),
-    ol   = style(padding = trbl(0, 0, 0, em(2)), background = NA, border = NA),
+    ul   = style(padding = if (ltr) trbl(0, 0, 0, em(2)) else trbl(0, em(2), 0, 0), background = NA, border = NA),
+    ol   = style(padding = if (ltr) trbl(0, 0, 0, em(2)) else trbl(0, em(2), 0, 0), background = NA, border = NA),
     li   = style(padding = trbl(0), background = NA, border = NA),
     hr   = style(padding = trbl(0, 0, rem(1/8)), border = "#eeeeee", border_size = trbl(0, 0, rem(1/16))),
     h1   = style(family = header_font, size = relative(2.25), weight = "bold", lineheight = 1.2, margin = trbl(em(1), NULL, NULL, NULL), padding = trbl(0, 0, em(0.3)), border = "#eeeeee", border_size = trbl(0, 0, rem(1/16))),
@@ -39,7 +41,7 @@ classic_style <- function(base_size = 12, body_font = "", header_font = "",
     h6   = style(family = header_font, weight = "bold", lineheight = 1.4, margin = trbl(em(1), NULL, NULL, NULL), color = "#777777"),
     cb   = style(family = code_font, size = relative(0.85), lineheight = 1.45, padding = trbl(rem(1)), background = "#f7f7f7", border_radius = rem(3/16)),
     p    = style(padding = trbl(0), background = NA, border = NA),
-    qb   = style(color = "#777777", padding = trbl(em(0.2), 0, em(0.2), em(1)), border = "#dddddd", border_size = trbl(0, 0, 0, rem(0.25))),
+    qb   = style(color = "#777777", padding = if (ltr) trbl(em(0.2), 0, em(0.2), em(1)) else trbl(em(0.2), em(1), em(0.2), 0), border = "#dddddd", border_size = if (ltr) trbl(0, 0, 0, rem(0.25)) else trbl(0, rem(0.25), 0, 0)),
     em   = style(italic = TRUE),
     str  = style(weight = "bold"),
     a    = style(color = "#4078c0"),

R/grob.R

@@ -225,9 +225,9 @@ marquee_grob <- function(text, style = classic_style(), ignore_html = TRUE,
     features = parsed$features[bullets$index],
     size = parsed$size[bullets$index],
     res = 600,
-    align = "right",
     hjust = 1,
-    vjust = 1
+    vjust = 1,
+    direction = parsed$text_direction[bullets$index]
   )
   ## Inherit color and id from the relevant block
   bullets$shape$shape$col <- parsed$color[bullets$index[bullets$shape$shape$metric_id]]
@@ -384,7 +384,8 @@ makeContext.marquee_grob <- function(x) {
     indent = convertWidth(unit(x$text$indent, "bigpts"), "inches", TRUE),
     hanging = convertWidth(unit(x$text$hanging, "bigpts"), "inches", TRUE),
     space_before = 0,
-    space_after = 0
+    space_after = 0,
+    direction = x$text$text_direction
   )
   if (nrow(shape$shape) == 0) return(nullGrob())
 
@@ -439,6 +440,31 @@ makeContext.marquee_grob <- function(x) {
   y_adjustment <- rep(0, length(x$blocks$start))
   y_bullet_adjustment <- rep(0, length(bullet_blocks))
   x_bullet_adjustment <- rep(0, length(bullet_blocks))
+  if (any(bshape$metrics$ltr != shape$metrics$ltr[bullet_blocks])) {
+    # Redo bullet shaping with the correct direction
+    bshape <- textshaping::shape_text(
+      x$bullets$bullet,
+      family = x$text$family[x$bullets$index],
+      italic = x$text$italic[x$bullets$index],
+      weight = x$text$weight[x$bullets$index],
+      width = x$text$width[x$bullets$index],
+      features = x$text$features[x$bullets$index],
+      size = x$text$size[x$bullets$index],
+      res = 600,
+      hjust = ifelse(shape$metrics$ltr[bullet_blocks], 1, 0),
+      vjust = 1,
+      direction = ifelse(shape$metrics$ltr[bullet_blocks], "ltr", "rtl")
+    )
+    ## Inherit color and id from the relevant block
+    bshape$shape$col <- x$text$color[x$bullets$index[bshape$shape$metric_id]]
+    bshape$shape$id <- x$text$id[x$bullets$index[bshape$shape$metric_id]]
+  }
+  # make rtl bullets left-justified
+  bltr <- bshape$metrics$ltr[bshape$shape$metric_id]
+  bshape$shape$x_offset[!bltr] <- bshape$shape$x_offset[!bltr] + bshape$metrics$width[bshape$shape$metric_id[!bltr]]
+
+  # Add sizebased offset
+  bshape$shape$x_offset <- bshape$shape$x_offset + ifelse(bltr, -1, 1) * bshape$shape$font_size/4
 
   # Position blocks underneath each other, calculate justification info, and position bullets
   for (i in seq_along(x$blocks$start)) {
@@ -450,7 +476,9 @@ makeContext.marquee_grob <- function(x) {
     bullet_ind <- which(i == bullet_blocks)
     if (length(bullet_ind) != 0) {
       ### Determine if bullet is higher than text at first line
-      first <- match(i, shape$shape$metric_id)
+      first <- which(shape$shape$metric_id == i)
+      first <- first[shape$shape$y_offset[first] == max(shape$shape$y_offset[first])]
+      first <- first[if (shape$metrics$ltr[i]) which.min(shape$shape$glyph[first]) else which.max(shape$shape$glyph[first])]
       added_height <- shape$shape$y_offset[first] - bshape$shape$y_offset[match(bullet_ind, bshape$shape$metric_id)]
       if (added_height > 0) {
         #### If higher, adjust the height to make space and record adjustment for glyphs in block
@@ -460,7 +488,7 @@ makeContext.marquee_grob <- function(x) {
         #### Otherwise record negative adjustment to put it in line with the text in the list
         y_bullet_adjustment[bullet_ind] <- -1 * added_height
       }
-      x_bullet_adjustment[bullet_ind] <- shape$shape$x_offset[first]
+      x_bullet_adjustment[bullet_ind] <- shape$shape$x_offset[first] + if (shape$metrics$ltr[i]) 0 else shape$shape$advance[first]
     }
 
     ## calculate y offset and height
@@ -521,7 +549,7 @@ makeContext.marquee_grob <- function(x) {
   shape$shape$y_offset <- shape$shape$y_offset + x$text$baseline[shape$shape$string_id]
 
   ## Do the same for bullets
-  bshape$shape$x_offset <- bshape$shape$x_offset + left_offset[bullet_blocks[bshape$shape$metric_id]] - bshape$shape$font_size/4 + x_bullet_adjustment[bshape$shape$metric_id]
+  bshape$shape$x_offset <- bshape$shape$x_offset + left_offset[bullet_blocks[bshape$shape$metric_id]] + x_bullet_adjustment[bshape$shape$metric_id]
   bshape$shape$y_offset <- bshape$shape$y_offset + top_offset[bullet_blocks[bshape$shape$metric_id]] - y_bullet_adjustment[bshape$shape$metric_id]
 
   # Store info in object
@@ -637,7 +665,7 @@ makeContext.marquee_grob <- function(x) {
     id = x$text$id[x$blocks$start[block_bg]],
     x = left_offset[block_bg] - x$text$padding_left[x$blocks$start[block_bg]],
     y = top_offset[block_bg] + x$text$padding_top[x$blocks$start[block_bg]],
-    width = widths[block_bg] + x$text$padding_left[x$blocks$start[block_bg]] + x$text$padding_right[x$blocks$start[block_bg]],
+    width = widths[block_bg],
     height = heights[block_bg] - x$text$margin_top[x$blocks$start[block_bg]] - x$text$margin_bottom[x$blocks$start[block_bg]],
     fill = x$text$background[x$blocks$start[block_bg]],
     col = x$text$border[x$blocks$start[block_bg]],

R/style.R

@@ -62,6 +62,13 @@
 #' @param baseline The baseline shift to apply to the text
 #' @param img_asp The default aspect ratio for block level images if not
 #' provided by the image itself
+#' @param text_direction The directional flow of the text. Either `"auto"` to
+#' let it be determined by the content of the text, or `"ltr"`/`"rtl"` to
+#' hard-code it to either left-to-right or right-to-left. This setting will not
+#' change the order of glyphs within a span of text, but rather whether
+#' consequtive blocks of text are laid out left-to-right or right-to-left. It
+#' also affects to which side indentation is applied as well as the meaning of
+#' `"auto"`, and `"justified-auto"` aligment.
 #'
 #' @return A `marquee_style` object
 #'
@@ -80,7 +87,7 @@ style <- function(family = NULL, weight = NULL, italic = NULL, width = NULL,
                   margin = NULL, padding = NULL, background = NULL, border = NULL,
                   border_size = NULL, border_radius = NULL, bullets = NULL,
                   underline = NULL, strikethrough = NULL, baseline = NULL,
-                  img_asp = NULL) {
+                  img_asp = NULL, text_direction = NULL) {
   check_string(family, allow_null = TRUE)
 
   if (is.character(weight)) weight <- systemfonts::as_font_weight(weight)
@@ -144,6 +151,8 @@ style <- function(family = NULL, weight = NULL, italic = NULL, width = NULL,
 
   check_number_decimal(img_asp, allow_null = TRUE)
 
+  check_string(text_direction, allow_null = TRUE)
+
   if (!is_modifier(baseline)) check_number_decimal(baseline, allow_null = TRUE)
 
   structure(list(
@@ -178,7 +187,8 @@ style <- function(family = NULL, weight = NULL, italic = NULL, width = NULL,
       underline = underline,
       strikethrough = strikethrough,
       baseline = baseline,
-      img_asp = img_asp
+      img_asp = img_asp,
+      text_direction = text_direction
     ),
     class = "marquee_style"
   )
@@ -236,12 +246,12 @@ str.marquee_style <- function(object, ...) {
 base_style <- function(family = "", weight = "normal", italic = FALSE,
                        width = "normal", features = systemfonts::font_feature(),
                        size = 12, color = "black", lineheight = 1.6,
-                       align = "left", tracking = 0, indent = 0, hanging = 0,
+                       align = "auto", tracking = 0, indent = 0, hanging = 0,
                        margin = trbl(0, 0, rem(1)), padding = trbl(0),
                        background = NA, border = NA, border_size = trbl(0),
                        border_radius = 0, bullets = marquee_bullets,
                        underline = FALSE, strikethrough = FALSE, baseline = 0,
-                       img_asp = 1.65) {
+                       img_asp = 1.65, text_direction = "auto") {
   style(
     family = family,
     weight = weight,
@@ -265,6 +275,7 @@ base_style <- function(family = "", weight = "normal", italic = FALSE,
     underline = underline,
     strikethrough = strikethrough,
     baseline = baseline,
-    img_asp = img_asp
+    img_asp = img_asp,
+    text_direction = text_direction
   )
 }