fix #93 add think fxn

NAMESPACE

@@ -1,11 +1,13 @@
 # Generated by roxygen2: do not edit by hand
 
 export(animals)
-export(bubble)
+export(bubble_say)
 export(bubble_tail)
 export(bubble_tail2)
+export(bubble_think)
 export(endless_horse)
 export(say)
+export(think)
 importFrom(rlang,abort)
 importFrom(rlang,are_na)
 importFrom(rlang,arg_match)

R/bubble.R

@@ -5,35 +5,87 @@
 #' @param width (integer/numeric) width of each line. default: 60
 #' @return character vector of length greater than the input `x`
 #' @note modified from <https://github.com/schochastics/startifyR>
+#' @details `bubble_say` gives the traditional bubble that you get when
+#' you run `cowsay` on the command line, with carrots or slashes for the
+#' sides, while `bubble_think` gives a slightly different bubble with
+#' parens for the sides
 #' @examplesIf rlang::is_installed("fortunes")
 #' library(fortunes)
 #' quote <- as.character(fortune())
-#' bubble(x = quote)
+#' bubble_say(x = quote)
+#' 
+#' cat(bubble_say(paste(quote, collapse = " ")), sep = "\n")
+#' ch <- animals[["chicken"]]
+#' z <- paste(c(bubble_say(quote), bubble_tail(ch, "\\"), ch), collapse = "\n")
+#' cat(z)
 #'
+#' @examplesIf rlang::is_installed("fortunes") && interactive()
 #' text_color <- sample(grDevices::colors(), 1)
 #' text_style <- crayon::make_style(text_color)
-#' text_style(bubble(quote))
-#'
-#' cat(bubble(paste(quote, collapse = " ")), sep = "\n")
-bubble <- function(x, width = 60) {
+#' text_style(bubble_say(quote))
+bubble_say <- function(x, width = 60) {
+  top <- bottom <- "-"
+  side <- "|"
+  empty_to_avoid_rlang_header <- ""
+  added_ws <- 2L
+  x <- strwrap(x, width = width - 4)
+  n <- max(nchar(x))
+  m <- length(x)
+  top_ <- paste0(c(" ", rep(top, n + added_ws), " "), collapse = "")
+  bottom_ <- paste0(c(" ", rep(bottom, n + added_ws), " "), collapse = "")
+  slant_top <- paste0(c("/", rep(" ", n + added_ws), "\\"), collapse = "")
+  slant_bottom <- paste0(c("\\", rep(" ", n + added_ws), "/"), collapse = "")
+  quote <- rep("", m)
+  for (i in seq_len(m)) {
+    if (substr(x[i], 1, 1) != top) {
+      x[i] <- string_pad(x[i], nchar(x[i]) + 1, "left")
+      if (m == 1) {
+        quote[i] <- paste0("<", string_pad(x[i], n + added_ws, "right"), ">")
+        next
+      }
+      if (i == 1) {
+        quote[i] <- paste0("/", string_pad(x[i], n + added_ws, "right"), "\\")
+      } else if (i == length(quote)) {
+        quote[i] <- paste0("\\", string_pad(x[i], n + added_ws, "right"), "/")
+      } else {
+        quote[i] <- paste0(side, string_pad(x[i], n + added_ws, "right"), side)
+      }
+    } else {
+      quote[i] <- paste0(side, string_pad(x[i], n + added_ws, "left"), side)
+    }
+  }
+  c(empty_to_avoid_rlang_header, top_, quote, bottom_)
+}
+
+#' @export
+#' @rdname bubble_say
+bubble_think <- function(x, width = 60) {
+  top <- bottom <- "-"
+  left <- "("
+  right <- ")"
   empty_to_avoid_rlang_header <- ""
-  x <- strwrap(x, width = width)
+  added_ws <- 2L
+  x <- strwrap(x, width = width - 4)
   n <- max(nchar(x))
   m <- length(x)
-  top <- bottom <- paste0(c("+", rep("-", n + 4), "+"), collapse = "")
+  top_ <- paste0(rep(top, n + added_ws), collapse = "")
+  bottom_ <- paste0(rep(bottom, n + added_ws), collapse = "")
   quote <- rep("", m)
   for (i in seq_len(m)) {
-    if (substr(x[i], 1, 1) != "-") {
-      quote[i] <- paste0("|", string_pad(x[i], n + 4, "right"), "|")
+    if (substr(x[i], 1, 1) != top) {
+      z <- string_pad(x[i], nchar(x[i]) + 1, "left")
+      quote[i] <- paste0(left, string_pad(z, n + added_ws, "right"), right)
     } else {
-      quote[i] <- paste0("|", string_pad(x[i], n + 4, "left"), "|")
+      quote[i] <- paste0(left, string_pad(x[i], n + added_ws, "left"), right)
     }
   }
-  c(empty_to_avoid_rlang_header, top, quote, bottom)
+  top_ <- string_pad(top_, nchar(top_) + 1, "both")
+  bottom_ <- string_pad(bottom_, nchar(bottom_) + 1, "both")
+  c(empty_to_avoid_rlang_header, top_, quote, bottom_)
 }
 
 #' Make the tail part of a thought bubble
-#' 
+#'
 #' @export
 #' @param animal (character) a string
 #' @param thought_sym (character) scalar character to use for the
@@ -42,12 +94,16 @@ bubble <- function(x, width = 60) {
 #' @param max_char_length (numeric) length of the maximum line. this is used
 #' to determine how much whitespace padding to add to the left of
 #' `thought_sym`
-#' @examplesIf interactive()
+#' @details `bubble_tail` uses the animal as input so that the tail is put
+#' close to the top of the animal, whereas `bubble_tail2` just puts the tail
+#' about a 1/3 of the way from the left most character given the max
+#' character length
+#' @examples
 #' bubble_tail(animals[["chicken"]])
 #' cat(bubble_tail(animals[["chicken"]]), sep = "\n")
 #' cat(bubble_tail(animals[["chicken"]]), sep = "\n")
 #' cat(bubble_tail(animals[["chicken"]], "%"), sep = "\n")
-#' 
+#'
 #' bubble_tail2(59)
 #' cat(bubble_tail2(59), sep = "\n")
 #' cat(bubble_tail2(11), sep = "\n")
@@ -58,7 +114,7 @@ bubble_tail <- function(animal, thought_sym = "o") {
   n_first_spaces <- length(gregexpr("\\s", animal_split[1])[[1]])
   c(
     string_pad(thought_sym, n_first_spaces - 2, "left"),
-    string_pad(thought_sym, (n_first_spaces - 2) + 2, "left")
+    string_pad(thought_sym, (n_first_spaces - 2) + 1, "left")
   )
 }
 
@@ -67,14 +123,20 @@ bubble_tail <- function(animal, thought_sym = "o") {
 bubble_tail2 <- function(max_char_length, thought_sym = "o") {
   c(
     string_pad(thought_sym, floor((max_char_length + 4) / 3), "left"),
-    string_pad(thought_sym, floor((max_char_length + 4) / 3) + 2, "left")
+    string_pad(thought_sym, floor((max_char_length + 4) / 3) + 1, "left")
   )
 }
 
 string_pad <- function(string, n, side) {
   fmt <- switch(side,
     left = paste0("%", n, "s"),
-    right = paste0("%-", n, "s")
+    right = paste0("%-", n, "s"),
+    NULL
   )
-  sprintf(fmt, string)
+  if (side == "both") {
+    string <- string_pad(string, n, "left")
+    string_pad(string, nchar(string) + 1, "right")
+  } else {
+    sprintf(fmt, string)    
+  }
 }

R/say.R

@@ -1,3 +1,112 @@
+#' say/think factory
+#' @param thought_sym (character) scalar character to use for the
+#' speech bubble tail (see <https://en.wikipedia.org/wiki/Speech_balloon>).
+#' default: "o"
+#' @param say_or_think (character)
+#' @keywords internal
+say_think <- function(thought_sym, say_or_think) {
+  function(
+      what = "Hello world!", by = "cow", type = NULL,
+      what_color = NULL, by_color = what_color, length = 18, fortune = NULL,
+      width = 60, ...) {
+    stopifnot("what must be length 1" = has_length(what, 1))
+
+    if (
+      crayon::has_color() == FALSE &&
+        (!is_null(what_color) || !is_null(by_color))
+    ) {
+      inform(c(
+        "Colors cannot be applied in this environment :(",
+        "Try using a terminal or RStudio/Positron/etc."
+      ))
+      what_color <- NULL
+      by_color <- NULL
+    } else {
+      what_color <- check_color(what_color)
+      by_color <- check_color(by_color)
+    }
+
+    if (is_null(type)) {
+      if (interactive()) {
+        type <- "message"
+      } else {
+        type <- "print"
+      }
+    }
+
+    if (what == "catfact") {
+      rlang::check_installed("jsonlite")
+      what <- jsonlite::fromJSON(catfact_api)$fact
+      by <- "cat"
+    }
+
+    who <- get_who(by, length = length)
+
+    if (!is_null(fortune)) {
+      rlang::check_installed("fortunes")
+      what <- "fortune"
+    }
+
+    if (what == "time") {
+      what <- as.character(Sys.time())
+    }
+
+    if (what == "fortune") {
+      rlang::check_installed("fortunes")
+      if (is_null(fortune)) {
+        fortune <- sample(1:360, 1)
+      }
+      what <- as.character(fortune(which = fortune, ...))
+      what <- what[!are_na(what)] # remove missing pieces (e.g. "context")
+      what <- gsub("<x>", "\n", paste(what, collapse = "\n "))
+    }
+
+    if (by == "hypnotoad" && what == "Hello world!") {
+      what <- "All Glory to the HYPNO TOAD!"
+    }
+
+    if (what == "rms") {
+      rlang::check_installed("rmsfact")
+      what <- rmsfact::rmsfact()
+    }
+
+    if (what %in% fillerama_what) {
+      abort("sorry, fillerama API is gone, sorry :(")
+    }
+
+    what_bubbled <- switch(say_or_think,
+      say = bubble_say(x = what, width = width),
+      think = bubble_think(x = what, width = width),
+      abort("only 'say' and 'think' supported in say_think()")
+    )
+    what_styled <- color_text(what_bubbled, what_color)
+    what_tail <- bubble_tail(who, thought_sym = thought_sym)
+    tail_styled <- color_text(what_tail, what_color)
+    who_styled <- color_text(who, by_color)
+    what_who <- paste(c(what_styled, tail_styled, who_styled), collapse = "\n")
+
+    if (type == "warning") {
+      if (nchar(what_who) < 100) {
+        wl <- 100
+      } else if (nchar(what_who) > 8170) {
+        wl <- 8170
+      } else {
+        wl <- nchar(what_who) + 1
+      }
+      warn_op <- options(warning.length = wl)
+      on.exit(options(warn_op))
+    }
+
+    switch(type,
+      message = message(what_who),
+      warning = warning(what_who),
+      print = cat(what_who),
+      string = what_who
+    )
+  }
+}
+
+
 #' Sling messages and warnings with flair
 #'
 #' @export
@@ -39,8 +148,6 @@
 #' string which is used as a pattern passed to [grep()] (and a random one is
 #' selected upton multiple matches). Passed on to the `which` parameter of
 #' `fortunes::fortune`
-#' @param thought_sym (character) scalar character to use for the
-#' speech bubble tail (see <https://en.wikipedia.org/wiki/Speech_balloon>)
 #' @param width (integer/numeric) width of each line. default: 60
 #' @param ... Further args passed on to `fortunes::fortune()`
 #'
@@ -129,98 +236,8 @@
 #' # Using the catfacts API
 #' library(jsonlite)
 #' say("catfact", "cat")
-say <- function(
-    what = "Hello world!", by = "cow", type = NULL,
-    what_color = NULL, by_color = what_color, length = 18, fortune = NULL,
-    thought_sym = "o", width = 60, ...) {
-  stopifnot("what must be length 1" = has_length(what, 1))
-
-  if (
-    crayon::has_color() == FALSE &&
-      (!is_null(what_color) || !is_null(by_color))
-  ) {
-    inform(c(
-      "Colors cannot be applied in this environment :(",
-      "Try using a terminal or RStudio/Positron/etc."
-    ))
-    what_color <- NULL
-    by_color <- NULL
-  } else {
-    what_color <- check_color(what_color)
-    by_color <- check_color(by_color)
-  }
-
-  if (is_null(type)) {
-    if (interactive()) {
-      type <- "message"
-    } else {
-      type <- "print"
-    }
-  }
-
-  if (what == "catfact") {
-    rlang::check_installed("jsonlite")
-    what <- jsonlite::fromJSON(catfact_api)$fact
-    by <- "cat"
-  }
-
-  who <- get_who(by, length = length)
-
-  if (!is_null(fortune)) {
-    rlang::check_installed("fortunes")
-    what <- "fortune"
-  }
-
-  if (what == "time") {
-    what <- as.character(Sys.time())
-  }
-
-  if (what == "fortune") {
-    rlang::check_installed("fortunes")
-    if (is_null(fortune)) {
-      fortune <- sample(1:360, 1)
-    }
-    what <- as.character(fortune(which = fortune, ...))
-    what <- what[!are_na(what)] # remove missing pieces (e.g. "context")
-    what <- gsub("<x>", "\n", paste(what, collapse = "\n "))
-  }
-
-  if (by == "hypnotoad" && what == "Hello world!") {
-    what <- "All Glory to the HYPNO TOAD!"
-  }
-
-  if (what == "rms") {
-    rlang::check_installed("rmsfact")
-    what <- rmsfact::rmsfact()
-  }
-
-  if (what %in% fillerama_what) {
-    abort("sorry, fillerama API is gone, sorry :(")
-  }
+say <- say_think(thought_sym = "\\", say_or_think = "say")
 
-  what_bubbled <- bubble(x = what, width = width)
-  what_styled <- color_text(what_bubbled, what_color)
-  what_tail <- bubble_tail(who, thought_sym = thought_sym)
-  tail_styled <- color_text(what_tail, what_color)
-  who_styled <- color_text(who, by_color)
-  what_who <- paste(c(what_styled, tail_styled, who_styled), collapse = "\n")
-
-  if (type == "warning") {
-    if (nchar(what_who) < 100) {
-      wl <- 100
-    } else if (nchar(what_who) > 8170) {
-      wl <- 8170
-    } else {
-      wl <- nchar(what_who) + 1
-    }
-    warn_op <- options(warning.length = wl)
-    on.exit(options(warn_op))
-  }
-
-  switch(type,
-    message = message(what_who),
-    warning = warning(what_who),
-    print = cat(what_who),
-    string = what_who
-  )
-}
+#' @export
+#' @rdname say
+think <- say_think(thought_sym = "o", say_or_think = "think")