Don't interfere with windows

DESCRIPTION

@@ -1,4 +1,4 @@
-Package: textshaping
+Package: textshaping2
 Title: Bindings to the 'HarfBuzz' and 'Fribidi' Libraries for Text Shaping
 Version: 0.4.1.9000
 Authors@R: c(
@@ -28,13 +28,9 @@ Suggests:
     grid,
     knitr,
     rmarkdown
-LinkingTo:
-    cpp11 (>= 0.2.1),
-    systemfonts (>= 1.0.0)
 VignetteBuilder:
     knitr
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.2
-SystemRequirements: freetype2, harfbuzz, fribidi
 Config/build/compilation-database: true

NAMESPACE

@@ -10,4 +10,4 @@ importFrom(lifecycle,deprecated)
 importFrom(systemfonts,font_feature)
 importFrom(systemfonts,match_fonts)
 importFrom(systemfonts,system_fonts)
-useDynLib(textshaping, .registration = TRUE)
+useDynLib(textshaping2, .registration = TRUE)

R/aaa.R

@@ -1,6 +1,6 @@
 release_bullets <- function() {
-  c(
-    '`rhub::check_on_solaris(env_vars = c("_R_CHECK_FORCE_SUGGESTS_" = "false"))`',
-    '`rhub::check_with_valgrind(env_vars = c(VALGRIND_OPTS = "--leak-check=full --track-origins=yes"))`'
-  )
+  #c(
+  #  '`rhub::check_on_solaris(env_vars = c("_R_CHECK_FORCE_SUGGESTS_" = "false"))`',
+  #  '`rhub::check_with_valgrind(env_vars = c(VALGRIND_OPTS = "--leak-check=full --track-origins=yes"))`'
+  #)
 }

R/font_features.R

@@ -22,19 +22,19 @@
 #'
 get_font_features <- function(family = '', italic = FALSE, bold = FALSE,
                               path = NULL, index = 0) {
-  if (is.null(path)) {
-    full_length <- max(length(family), length(italic), length(bold))
-    fonts <- match_fonts(
-      rep_len(family, full_length),
-      rep_len(italic, full_length),
-      ifelse(rep_len(bold, full_length), "bold", "normal")
-    )
-    path <- fonts$path
-    index <- fonts$index
-  } else {
-    full_length <- max(length(path), length(index))
-    path <- rep_len(path, full_length)
-    index <- rep_len(index, full_length)
-  }
-  lapply(get_face_features_c(as.character(path), as.integer(index)), unique)
+  #if (is.null(path)) {
+  #  full_length <- max(length(family), length(italic), length(bold))
+  #  fonts <- match_fonts(
+  #    rep_len(family, full_length),
+  #    rep_len(italic, full_length),
+  #    ifelse(rep_len(bold, full_length), "bold", "normal")
+  #  )
+  #  path <- fonts$path
+  #  index <- fonts$index
+  #} else {
+  #  full_length <- max(length(path), length(index))
+  #  path <- rep_len(path, full_length)
+  #  index <- rep_len(index, full_length)
+  #}
+  #lapply(get_face_features_c(as.character(path), as.integer(index)), unique)
 }

R/lorem_text.R

@@ -27,10 +27,10 @@
 #' lorem_bidi()
 #'
 lorem_text <- function(script = c("latin", "chinese", "arabic", "devanagari", "cyrillic", "kana", "hangul", "greek", "hebrew", "armenian", "georgian"), n = 1) {
-  script <- match.arg(script)
-  file <- paste0(script, ".txt")
-  file <- system.file("lorem", file, package = "textshaping")
-  rep_len(readLines(file), n)
+  #script <- match.arg(script)
+  #file <- paste0(script, ".txt")
+  #file <- system.file("lorem", file, package = "textshaping")
+  #rep_len(readLines(file), n)
 }
 
 #' @rdname lorem_text
@@ -41,32 +41,32 @@ lorem_text <- function(script = c("latin", "chinese", "arabic", "devanagari", "c
 #' @export
 #'
 lorem_bidi <- function(ltr = c("latin", "chinese", "devanagari", "cyrillic", "kana", "hangul", "greek", "armenian", "georgian"), rtl = c("arabic", "hebrew"), ltr_prop = 0.9, n = 1) {
-  ltr <- match.arg(ltr)
-  rtl = match.arg(rtl)
-  ltr_split <- if (ltr %in% c("chinese", "kana", "hangul")) "" else " "
-  ltr <- lorem_text(ltr, n)
-  rtl <- lorem_text(rtl, n)
-  mapply(function(ltr, rtl) {
-    if (ltr_prop >= 0.5) {
-      prop <- ltr_prop
-      main <- ltr
-      sub <- rtl
-      sub_merge <- " "
-      main_merge <- ltr_split
-    } else {
-      prop <- 1 - ltr_prop
-      main <- rtl
-      sub <- ltr
-      sub_merge <- ltr_split
-      main_merge <- " "
-    }
-    n_insert <- min(ceiling(length(main) * (1 - prop)), length(sub))
-    n_chunks <- ceiling(stats::runif(1, n_insert * (prop - 0.5), n_insert))
-    sub <- lapply(split(sub[seq_len(n_insert)], sort(c(seq_len(n_chunks), sample(n_chunks, n_insert - n_chunks, TRUE)))), paste, collapse = sub_merge)
-    insertions <- sort(sample(length(main), n_chunks))
-    for (i in rev(seq_along(insertions))) {
-      main <- append(main, sub[[i]], insertions[i])
-    }
-    paste(main, collapse = main_merge)
-  }, ltr = strsplit(ltr, ltr_split), rtl = strsplit(rtl, " "))
+  #ltr <- match.arg(ltr)
+  #rtl = match.arg(rtl)
+  #ltr_split <- if (ltr %in% c("chinese", "kana", "hangul")) "" else " "
+  #ltr <- lorem_text(ltr, n)
+  #rtl <- lorem_text(rtl, n)
+  #mapply(function(ltr, rtl) {
+  #  if (ltr_prop >= 0.5) {
+  #    prop <- ltr_prop
+  #    main <- ltr
+  #    sub <- rtl
+  #    sub_merge <- " "
+  #    main_merge <- ltr_split
+  #  } else {
+  #    prop <- 1 - ltr_prop
+  #    main <- rtl
+  #    sub <- ltr
+  #    sub_merge <- ltr_split
+  #    main_merge <- " "
+  #  }
+  #  n_insert <- min(ceiling(length(main) * (1 - prop)), length(sub))
+  #  n_chunks <- ceiling(stats::runif(1, n_insert * (prop - 0.5), n_insert))
+  #  sub <- lapply(split(sub[seq_len(n_insert)], sort(c(seq_len(n_chunks), sample(n_chunks, n_insert - n_chunks, TRUE)))), paste, collapse = sub_merge)
+  #  insertions <- sort(sample(length(main), n_chunks))
+  #  for (i in rev(seq_along(insertions))) {
+  #    main <- append(main, sub[[i]], insertions[i])
+  #  }
+  #  paste(main, collapse = main_merge)
+  #}, ltr = strsplit(ltr, ltr_split), rtl = strsplit(rtl, " "))
 }

R/shape_text.R

@@ -219,37 +219,37 @@ text_width <- function(strings, family = '', italic = FALSE, weight = 'normal',
                        width = 'undefined', features = font_feature(),
                        size = 12, res = 72, include_bearing = TRUE, path = NULL,
                        index = 0, bold = deprecated()) {
-  n_strings <- length(strings)
-
-  if (lifecycle::is_present(bold)) {
-    lifecycle::deprecate_soft("0.4.1", "text_width(bold)", "text_width(weight='bold')")
-    weight <- ifelse(bold, "bold", "normal")
-  }
-
-  if (inherits(features, 'font_feature')) features <- list(features)
-  features <- rep_len(features, n_strings)
-
-  if (is.null(path)) {
-    family <- rep_len(family, n_strings)
-    italic <- rep_len(italic, n_strings)
-    weight <- rep_len(weight, n_strings)
-    width <- rep_len(width, n_strings)
-    loc <- match_fonts(family, italic, weight, width)
-    path <- loc$path
-    index <- loc$index
-    features <- Map(c, loc$features, features)
-  } else {
-    path <- rep_len(path, n_strings)
-    index <- rep_len(index, n_strings)
-  }
-  size <- rep_len(size, n_strings)
-  res <- rep_len(res, n_strings)
-  include_bearing <- rep_len(include_bearing, n_strings)
-  if (!all(file.exists(path))) stop("path must point to a valid file", call. = FALSE)
-  get_line_width_c(
-    as.character(strings), path, as.integer(index), as.numeric(size),
-    as.numeric(res), as.logical(include_bearing), features
-  )
+  #n_strings <- length(strings)
+#
+  #if (lifecycle::is_present(bold)) {
+  #  lifecycle::deprecate_soft("0.4.1", "text_width(bold)", "text_width(weight='bold')")
+  #  weight <- ifelse(bold, "bold", "normal")
+  #}
+#
+  #if (inherits(features, 'font_feature')) features <- list(features)
+  #features <- rep_len(features, n_strings)
+#
+  #if (is.null(path)) {
+  #  family <- rep_len(family, n_strings)
+  #  italic <- rep_len(italic, n_strings)
+  #  weight <- rep_len(weight, n_strings)
+  #  width <- rep_len(width, n_strings)
+  #  loc <- match_fonts(family, italic, weight, width)
+  #  path <- loc$path
+  #  index <- loc$index
+  #  features <- Map(c, loc$features, features)
+  #} else {
+  #  path <- rep_len(path, n_strings)
+  #  index <- rep_len(index, n_strings)
+  #}
+  #size <- rep_len(size, n_strings)
+  #res <- rep_len(res, n_strings)
+  #include_bearing <- rep_len(include_bearing, n_strings)
+  #if (!all(file.exists(path))) stop("path must point to a valid file", call. = FALSE)
+  #get_line_width_c(
+  #  as.character(strings), path, as.integer(index), as.numeric(size),
+  #  as.numeric(res), as.logical(include_bearing), features
+  #)
 }
 
 #' Preview shaped text and the metrics for the text box
@@ -280,83 +280,83 @@ text_width <- function(strings, family = '', italic = FALSE, weight = 'normal',
 #' )
 #'
 plot_shape <- function(shape, id = 1) {
-  if (!requireNamespace("grDevices", quietly = TRUE) || utils::packageVersion("grDevices") < package_version("4.3.0")) {
-    stop("This function requires grDevices 4.3.0 or above")
-  }
-  if (!requireNamespace("grid", quietly = TRUE) || utils::packageVersion("grid") < package_version("4.3.0")) {
-    stop("This function requires grid 4.3.0 or above")
-  }
-
-  has_glyph_support <- grDevices::dev.capabilities()$glyphs
-  if (is.na(has_glyph_support)) {
-    warning("The device does not report whether it supports rendering glyphs")
-  } else if (!isTRUE(has_glyph_support)) {
-    stop("The current device doesn't support rendering glyphs")
-  }
-
-  glyphFont <- utils::getFromNamespace("glyphFont", "grDevices")
-  glyphFontList <- utils::getFromNamespace("glyphFontList", "grDevices")
-  glyphInfo <- utils::getFromNamespace("glyphInfo", "grDevices")
-  glyphAnchor <- utils::getFromNamespace("glyphAnchor", "grDevices")
-
-  grid.glyph <- utils::getFromNamespace("grid.glyph", "grid")
-
-  if (!is.numeric(id) || length(id) != 1 || id <= 0 || id %% 1 != 0 || id > nrow(shape$metrics)) {
-    stop("`id` must be an integer pointing to a paragraph in `shape`")
-  }
-  glyphs <- shape$shape[shape$shape$metric_id == id, ]
-  box <- shape$metrics[id, ]
-
-  font_id <- paste0(glyphs$font_path, "&", glyphs$font_index)
-  font_match <- match(font_id, unique(font_id))
-  unique_font <- !duplicated(font_id)
-  fonts <- Map(glyphFont, glyphs$font_path[unique_font], glyphs$font_index[unique_font], "", 0, "")
-  fonts <- do.call(glyphFontList, fonts)
-  glyphs <- glyphInfo(
-    id = glyphs$index,
-    x = glyphs$x_offset,
-    y = glyphs$y_offset,
-    font = font_match,
-    size = glyphs$font_size,
-    fontList = fonts,
-    width = box$width,
-    height = -box$height,
-    hAnchor = glyphAnchor(0, "left"),
-    vAnchor = glyphAnchor(0, "bottom")
-  )
-
-  grid::grid.newpage()
-
-  vp <- grid::viewport(
-    width = box$width,
-    height = box$height,
-    default.units = "bigpts"
-  )
-
-  grid::pushViewport(vp)
-  grid::grid.rect(gp = grid::gpar(fill = "lightgrey", col = NA))
-  grid::grid.rect(
-    x = box$left_bearing,
-    y = box$bottom_bearing,
-    width = box$width - box$left_bearing - box$right_bearing,
-    height = box$height - box$top_bearing - box$bottom_bearing,
-    hjust = 0,
-    vjust = 0,
-    default.units = "bigpts",
-    gp = grid::gpar(fill = NA, col = "darkgrey", lty = 2)
-  )
-  grid.glyph(
-    glyphs,
-    x = 0,
-    y = 0,
-    hjust = 0,
-    vjust = 0
-  )
-  grid::grid.points(
-    x = box$pen_x,
-    y = box$pen_y,
-    default.units = "bigpts",
-    pch = 16,
-    gp = grid::gpar(col = "red", cex = 0.5)
-  )
+  #if (!requireNamespace("grDevices", quietly = TRUE) || utils::packageVersion("grDevices") < package_version("4.3.0")) {
+  #  stop("This function requires grDevices 4.3.0 or above")
+  #}
+  #if (!requireNamespace("grid", quietly = TRUE) || utils::packageVersion("grid") < package_version("4.3.0")) {
+  #  stop("This function requires grid 4.3.0 or above")
+  #}
+#
+  #has_glyph_support <- grDevices::dev.capabilities()$glyphs
+  #if (is.na(has_glyph_support)) {
+  #  warning("The device does not report whether it supports rendering glyphs")
+  #} else if (!isTRUE(has_glyph_support)) {
+  #  stop("The current device doesn't support rendering glyphs")
+  #}
+#
+  #glyphFont <- utils::getFromNamespace("glyphFont", "grDevices")
+  #glyphFontList <- utils::getFromNamespace("glyphFontList", "grDevices")
+  #glyphInfo <- utils::getFromNamespace("glyphInfo", "grDevices")
+  #glyphAnchor <- utils::getFromNamespace("glyphAnchor", "grDevices")
+#
+  #grid.glyph <- utils::getFromNamespace("grid.glyph", "grid")
+#
+  #if (!is.numeric(id) || length(id) != 1 || id <= 0 || id %% 1 != 0 || id > nrow(shape$metrics)) {
+  #  stop("`id` must be an integer pointing to a paragraph in `shape`")
+  #}
+  #glyphs <- shape$shape[shape$shape$metric_id == id, ]
+  #box <- shape$metrics[id, ]
+#
+  #font_id <- paste0(glyphs$font_path, "&", glyphs$font_index)
+  #font_match <- match(font_id, unique(font_id))
+  #unique_font <- !duplicated(font_id)
+  #fonts <- Map(glyphFont, glyphs$font_path[unique_font], glyphs$font_index[unique_font], "", 0, "")
+  #fonts <- do.call(glyphFontList, fonts)
+  #glyphs <- glyphInfo(
+  #  id = glyphs$index,
+  #  x = glyphs$x_offset,
+  #  y = glyphs$y_offset,
+  #  font = font_match,
+  #  size = glyphs$font_size,
+  #  fontList = fonts,
+  #  width = box$width,
+  #  height = -box$height,
+  #  hAnchor = glyphAnchor(0, "left"),
+  #  vAnchor = glyphAnchor(0, "bottom")
+  #)
+#
+  #grid::grid.newpage()
+#
+  #vp <- grid::viewport(
+  #  width = box$width,
+  #  height = box$height,
+  #  default.units = "bigpts"
+  #)
+#
+  #grid::pushViewport(vp)
+  #grid::grid.rect(gp = grid::gpar(fill = "lightgrey", col = NA))
+  #grid::grid.rect(
+  #  x = box$left_bearing,
+  #  y = box$bottom_bearing,
+  #  width = box$width - box$left_bearing - box$right_bearing,
+  #  height = box$height - box$top_bearing - box$bottom_bearing,
+  #  hjust = 0,
+  #  vjust = 0,
+  #  default.units = "bigpts",
+  #  gp = grid::gpar(fill = NA, col = "darkgrey", lty = 2)
+  #)
+  #grid.glyph(
+  #  glyphs,
+  #  x = 0,
+  #  y = 0,
+  #  hjust = 0,
+  #  vjust = 0
+  #)
+  #grid::grid.points(
+  #  x = box$pen_x,
+  #  y = box$pen_y,
+  #  default.units = "bigpts",
+  #  pch = 16,
+  #  gp = grid::gpar(col = "red", cex = 0.5)
+  #)
 }