R/threejs_brain.R

Defines functions print.threeBrain.save_brain format.threeBrain.save_brain plot.threeBrain.save_brain red_col green_col grey_col save_brain renderBrain threejsBrainOutput threejs_brain

Documented in renderBrain save_brain threejs_brain threejsBrainOutput

#' @title Create a Threejs Brain and View it in Browsers
#' @author Zhengjia Wang
#' @param ...,.list geometries inherit from AbstractGeom
#' @param width,height positive integers. Width and height of the widget.
#'   By default width=`100\%`, and height varies.
#' @param background character, background color such as \code{"#FFFFFF"} or \code{"white"}
#' @param cex positive number, relative text magnification level
#' @param default_colormap character, which color map name to display at startup
#' @param palettes named list, names corresponds to color-map names if you want to change color palettes
#' @param value_ranges named list, similar to \code{palettes}, value range for each values
#' @param value_alias named list, legend title for corresponding variable
#' @param surface_colormap a color map or its path generated by \code{create_colormap(gtype="surface")} to render surfaces vertices; see \code{\link{create_colormap}} for details.
#' @param voxel_colormap a color map or its path generated by \code{create_colormap(gtype="volume")} to render volume such as atlases; see \code{\link{create_colormap}} for details.
#' @param videos named list, names corresponds to color-map names, and items are generated from \code{\link{video_content}}
#' @param show_inactive_electrodes logical, whether to show electrodes with no values
#' @param timestamp logical, whether to show time-stamp at the beginning
#' @param side_canvas logical, enable side cameras to view objects from fixed perspective
#' @param side_zoom numerical, if side camera is enabled, zoom-in level, from 1 to 5
#' @param side_width positive integer, side panel size in pixels
#' @param side_shift integer of length two, side panel shift in pixels (`CSS style`: top, left)
#' @param side_display logical, show/hide side panels at beginning
#' @param title viewer title
#' @param control_panel logical, enable control panels for the widget
#' @param control_presets characters, presets to be shown in control panels
#' @param control_display logical, whether to expand/collapse control UI at the beginning
#' @param camera_center numerical, length of three, XYZ position where camera should focus at
#' @param camera_pos XYZ position of camera itself, default (0, 0, 500)
#' @param start_zoom numerical, positive number indicating camera zoom level
#' @param symmetric numerical, default 0, color center will be mapped to this value
#' @param tmp_dirname character path, internally used, where to store temporary files
#' @param token unique character, internally used to identify widgets in 'JavaScript' \code{'localStorage'}
#' @param debug logical, internally used for debugging
#' @param controllers list to override the settings, for example \code{proxy$get_controllers()}
#' @param browser_external logical, use system default browser (default) or built-in one.
#' @param global_data,global_files internally use, mainly to store orientation matrices and files.
#' @param qrcode 'URL' to show in the 'QR' code; can be a character string or a named list of \code{'url'} and \code{'text'} (hyper-reference text)
#' @param show_modal logical or \code{"auto"}, whether to show a modal instead of direct rendering the viewers; designed for users who do not have \code{'WebGL'} support; only used in shiny applications
#' @param widget_id character, internally used as unique identifiers for widgets;
#' only use it when you have multiple widgets in one website
#' @param enable_cache whether to enable cache, useful when rendering the viewers repeatedly in shiny applications
#' @param embed whether to try embedding the viewer in current run-time; default is false (will launch default web browser); set to true if running in \code{'rmarkdown'} or \code{'quarto'}, or to see the viewer in \code{'RStudio'} default panel.
#' @param custom_javascript customized temporary 'JavaScript' code that runs after ready state; available 'JavaScript' variables are:
#' \describe{
#' \item{\code{'groups'}}{input information about each group}
#' \item{\code{'geoms'}}{input information about each geometry}
#' \item{\code{'settings'}}{input information about canvas settings}
#' \item{\code{'scene'}}{'threejs' scene object}
#' \item{\code{'canvas'}}{canvas object}
#' \item{\code{'gui'}}{controls data panel}
#' \item{\code{'presets'}}{preset \code{'gui'} methods}
#' }
#'
#' @examples
#' if( interactive() ) {
#' library(threeBrain)
#'
#' # Please use `download_N27` to download N27 Collins template brain
#' n27_path <- file.path(default_template_directory(), "N27")
#' if( dir.exists(n27_path) ) {
#'
#'   brain <- threeBrain(path = n27_path, subject_code = "N27",
#'                              surface_types = c('pial', 'smoothwm'))
#'   print(brain)
#'
#'   brain$plot(
#'     background = "#000000",
#'     controllers = list(
#'       'Voxel Type' = 'aparc_aseg',
#'       'Surface Type' = 'smoothwm',
#'       'Blend Factor' = 1,
#'       'Right Opacity' = 0.3,
#'       'Overlay Sagittal' = TRUE
#'     ),
#'     show_modal = TRUE
#'   )
#'
#' }
#' }
#'
#' @export
threejs_brain <- function(
  ..., .list = list(), width = NULL, height = NULL, background = "#FFFFFF",
  cex = 1, timestamp = TRUE, title = "",

  # Args for the side panels
  side_canvas = FALSE, side_zoom = 1, side_width = 250, side_shift = c(0, 0),
  side_display = TRUE, # side_background = background,

  # for controls GUI
  control_panel = TRUE, control_presets = NULL, control_display = TRUE,

  # Main camera and scene center
  camera_center = c(0,0,0), camera_pos = c(500,0,0), start_zoom = 1,

  # For colors and animation
  symmetric = 0, default_colormap = 'Value', palettes = NULL,
  value_ranges = NULL, value_alias = NULL,
  show_inactive_electrodes = TRUE,
  # color palettes for volume rendering (datacube2)
  surface_colormap = system.file(
    'palettes', 'surface', 'ContinuousSample.json', package = 'threeBrain'),
  voxel_colormap = system.file(
    'palettes', 'datacube2', 'FreeSurferColorLUT.json', package = 'threeBrain'),

  videos = list(),

  # Builds, additional data, etc (misc)
  widget_id = 'threebrain_data', tmp_dirname = NULL,
  debug = FALSE, enable_cache = FALSE, token = NULL, controllers = list(),
  browser_external = TRUE, global_data = list(), global_files = list(),

  # QRCode
  qrcode = NULL,

  # customized js code
  custom_javascript = NULL,
  show_modal = "auto", embed = FALSE

){
  if(isTRUE(show_modal == 'auto')){
    if( is.null(shiny::getDefaultReactiveDomain()) ){
      show_modal <- FALSE
    } else {
      # check if rave is launched
      if( isNamespaceLoaded("rave") || isNamespaceLoaded("ravedash") ){
        show_modal <- FALSE
      } else {
        show_modal <- TRUE
      }
    }
  } else {
    show_modal <- isTRUE(as.logical(show_modal))
  }

  stopifnot2(length(camera_center) == 3 && is.numeric(camera_center), msg = 'camera_center must be a numeric vector of 3')
  stopifnot2(length(camera_pos) == 3 && is.numeric(camera_pos) && sum(abs(camera_pos)) > 0, msg = 'camera_pos must be a vector length of 3 and cannot be origin')

  # Inject global data
  global_container <- BlankGeom$new(name = '__blank__', group = GeomGroup$new(name = '__global_data'))
  sapply( names(global_data), function(nm){
    global_container$group$set_group_data(
      name = sprintf('__global_data__%s', nm),
      value = global_data[[ nm ]]
    )
  })
  sapply( names(global_files), function(nm){
    file_info <- as.list(global_files[[nm]])
    if(all(c("path", "absolute_path", "file_name", "is_new_cache", "is_cache") %in% names(file_info))){
      global_container$group$set_group_data(
        name = sprintf('__global_data__%s', nm),
        value = file_info,
        is_cached = TRUE,
        cache_if_not_exists = FALSE
      )
    }
  })

  # surface cmap
  if( 'colormap' %in% class(surface_colormap) ){
    f <- tempfile(fileext = '.json', pattern = "surface_palette_")
    save_colormap( surface_colormap, f )
    surface_colormap <- normalizePath(f)
  }
  global_container$group$set_group_data(
    name = '__global_data__.SurfaceColorLUT',
    value = list(
      'path' = normalizePath(surface_colormap, mustWork = FALSE),
      'absolute_path' = normalizePath(surface_colormap, mustWork = FALSE),
      'file_name' = filename(surface_colormap),
      'is_new_cache' = FALSE,
      'is_cache' = TRUE
    ),
    is_cached = TRUE,
    cache_if_not_exists = FALSE
  )

  # Voxel cmap
  if( 'colormap' %in% class(voxel_colormap) ){
    f <- tempfile(fileext = '.json', pattern = "volume_palette_")
    save_colormap( voxel_colormap, f )
    voxel_colormap <- normalizePath(f)
  }
  global_container$group$set_group_data(
    name = '__global_data__.VolumeColorLUT',
    value = list(
      'path' = normalizePath(voxel_colormap, mustWork = FALSE),
      'absolute_path' = normalizePath(voxel_colormap, mustWork = FALSE),
      'file_name' = filename(voxel_colormap),
      'is_new_cache' = FALSE,
      'is_cache' = TRUE
    ),
    is_cached = TRUE,
    cache_if_not_exists = FALSE
  )

  fs_colormap <- system.file(
    'palettes', 'FSColorLUT.json', package = 'threeBrain')
  global_container$group$set_group_data(
    name = '__global_data__.FSColorLUT',
    value = list(
      'path' = normalizePath(fs_colormap, mustWork = TRUE),
      'absolute_path' = normalizePath(fs_colormap, mustWork = TRUE),
      'file_name' = filename(fs_colormap),
      'is_new_cache' = FALSE,
      'is_cache' = TRUE
    ),
    is_cached = TRUE,
    cache_if_not_exists = FALSE
  )

  # Video contents
  if( length(videos) ){
    nms <- names(videos)
    sel <- !nms %in% ""
    if(length(nms) && any(sel)){
      videos <- videos[sel]
      nms <- nms[sel]
      videos <- lapply(nms, function(nm){
        x <- videos[[nm]]
        x$name <- stringr::str_replace_all(nm, "[^a-zA-Z0-9-_]", "_")
        x
      })
      names(videos) <- sapply(videos, "[[", 'name')
      global_container$group$set_group_data(
        name = '__global_data__.media_content',
        value = videos,
        is_cached = FALSE,
        cache_if_not_exists = FALSE
      )
    }

  }


  # Create element list
  geoms <- unlist(c(global_container, list(...), .list))
  # Remove illegal geoms
  is_geom <- vapply(geoms, function(x){ R6::is.R6(x) && inherits(x, 'AbstractGeom') }, FUN.VALUE = FALSE)
  geoms <- unlist(geoms[is_geom])

  groups <- unique(lapply(geoms, '[[', 'group'))
  groups <- groups[!vapply(groups, is.null, FUN.VALUE = FALSE)]

  # get color schema
  animation_types <- unique(unlist( lapply(geoms, function(g){ g$animation_types }) ))
  if(!is.list(palettes)){ palettes <- list() }
  pnames <- names(palettes)
  if(!is.list(value_ranges)){ value_ranges <- list() }

  color_maps <- sapply(animation_types, function(atype){
    c <- ColorMap$new(name = atype, .list = geoms, symmetric = symmetric,
                     alias = value_alias[[atype]])
    if( atype %in% pnames ){
      c$set_colors( palettes[[atype]] )
    }
    if( c$value_type == 'continuous' && length(value_ranges[[atype]]) >= 2 ){
      c$value_range <- value_ranges[[atype]][c(1,2)]
      if( length(value_ranges[[atype]]) >= 4 ){
        c$hard_range <- sort(value_ranges[[atype]][c(3,4)])
      }
    }
    c$to_list()
  }, USE.NAMES = TRUE, simplify = FALSE)

  if( length(animation_types) ){
    if( !length(default_colormap) || !default_colormap %in% animation_types){
      default_colormap <- animation_types[1]
    }
  }else{
    default_colormap <- NULL
  }

  # backgrounds
  background <- col2hexStr(background)
  # side_background = col2hexStr(side_background)



  # Check elements
  geoms <- lapply(geoms, function(g){ g$to_list() })

  # Check lib_path. whether running inside of shiny or standalone
  if(is.null(shiny::getDefaultReactiveDomain())){
    lib_path <- 'lib/'
  }else{
    lib_path <- ''
    if(is.null(token)){
      session <- shiny::getDefaultReactiveDomain()
      token <- session$userData$rave_id
    }

    # If in shiny, token is given or rave_id is given, we use fixed temp path
    # in this way to reduce redundency
    if( !is.null(token) && length(tmp_dirname) != 1 ){
      tmp_dirname <- token
    }
  }

  # Check cached json files
  if(length(tmp_dirname) != 1){
    tmp_dirname <- rand_string(10)
  }
  tmp_dir <- file.path(tempdir(), 'threebrain_cache', tmp_dirname)
  dir_create(tmp_dir)

  lapply(groups, function(g){
    if(length(g$cached_items)){
      dir_create(file.path(tmp_dir, g$cache_name()))
      for(f in g$cached_items){
        re <- g$group_data[[f]]
        file.copy(
          from = re$absolute_path,
          to = file.path(tmp_dir, g$cache_name(), re$file_name),
          overwrite = TRUE
        )
      }
    }
  })
  lapply(videos, function(x){
    if(!x$is_url){
      target <- file.path(
        tmp_dir, global_container$group$cache_name(), filename(x$path)
      )
      file.copy(x$path, target, overwrite = TRUE)
      if( x$temp ){
        unlink(x$path)
      }
    }
  })

  # This is a tricky part, if the widget is created from shiny, there might be multiple instance running and we cannot have any cross talk
  # TODO: Need to think on how to resolve conflicts.
  widget_id <- stringr::str_replace_all(widget_id, '[^a-zA-Z0-9]', '_')

  dependencies <- htmlDependency(
    name = widget_id,
    version = '0',
    src = tmp_dir,
    all_files = TRUE
  )

  # Get groups
  groups <- lapply(groups, function(g){ g$to_list() })


  # Generate settings
  settings <- list(
    title = paste(format(title), collapse = "\n"),
    side_camera = side_canvas,
    side_canvas_zoom = side_zoom,
    side_canvas_width = side_width,
    side_canvas_shift = side_shift,
    color_maps = color_maps,
    default_colormap = default_colormap,
    hide_controls = !control_panel,
    control_center = as.vector(camera_center),
    camera_pos = camera_pos,
    font_magnification = ifelse(cex > 0, cex, 1),
    start_zoom = ifelse(start_zoom > 0, start_zoom, 1),
    show_legend = TRUE,
    render_timestamp = isTRUE(timestamp),
    control_presets = control_presets,
    cache_folder = paste0(lib_path, widget_id, '-0/'),
    worker_script = paste0(lib_path, "three-brain-1.0.0/threebrain-worker.js"),
    lib_path = lib_path,
    default_controllers = controllers,
    debug = debug,
    enable_cache = enable_cache,
    background = background,
    # has_animation = v_count > 1,
    token = token,
    show_inactive_electrodes = isTRUE(show_inactive_electrodes),
    side_display = side_display,
    control_display = control_display,
    qrcode = qrcode,
    custom_javascript = custom_javascript
  )

  # Generate external file
  # sapply(names(external_files) , function(nm){
  #   data_uri(file = external_files[[nm]]);
  # }, simplify = F, USE.NAMES = T)


  x <- list(
    groups = groups,
    geoms = geoms
  )

  attr(x, 'TOJSON_ARGS') <- list(null = 'null', na = 'null')

  # Save x to $tmp_dir/config.json
  data_filename <- sprintf("config_%s.json", digest::digest(x))
  path <- file.path(tmp_dir, data_filename)

  writeLines(to_json2(x), path)

  htmlwidgets::createWidget(
    name = 'threejs_brain', x = list(
      data_filename = data_filename,
      settings = settings,
      force_render = !show_modal
    ), width = width, height = height, package = 'threeBrain', sizingPolicy = htmlwidgets::sizingPolicy(
      defaultWidth = '100%',
      browser.external = browser_external,
      defaultHeight = '100vh',
      viewer.paneHeight = 500,
      viewer.suppress = !isTRUE(embed),
      viewer.fill = TRUE,
      padding = '0px',
    ), dependencies = dependencies)
}


#' Shiny Output for threeBrain Widgets
#' @author Zhengjia Wang
#' @name threejsBrainOutput
#' @param outputId unique identifier for the widget
#' @param width,height width and height of the widget. By default width="100%",
#'   and height="500px".
#' @param reportSize whether to report widget size in shiny
#' \code{session$clientData}
NULL

#' @export
threejsBrainOutput <- function(outputId, width = '100%', height = '500px', reportSize = TRUE){
  htmlwidgets::shinyWidgetOutput(outputId, "threejs_brain", width, height, package = "threeBrain",
                                 reportSize = reportSize, inline = FALSE)
}


#' Shiny Renderer for threeBrain Widgets
#' @author Zhengjia Wang
#' @name renderBrain
#' @param expr R expression that calls three_brain function or Brain object
#' @param env environment of expression to be evaluated
#' @param quoted is expr quoted? Default is false.
NULL


#' @export
renderBrain <- function(expr, env = parent.frame(), quoted = FALSE) {
  if (!quoted) { expr <- substitute(expr) }
  htmlwidgets::shinyRenderWidget(expr, threejsBrainOutput, env, quoted = TRUE)
}


#' Save threeBrain widgets to local file system
#' @author Zhengjia Wang
#' @param widget generated from function 'threejs_brain'
#' @param path path to save the brain widget
#' @param title widget title.
#' @param as_zip whether to create zip file "compressed.zip".
#' @param ... ignored, used for backward compatibility
#' @export
save_brain <- function(widget, path, title = '3D Viewer', as_zip = FALSE, ...){
  # Backward compatible:
  # old: directory is specified, path = directory/filename
  # new: path is specified directory
  args <- list(...)
  if(missing(path)) {
    path <- file.path(c(args$directory, ".")[[1]], c(args$filename, 'index.html')[[1]])
  } else if ( !grepl(pattern = "\\.htm[l]{0,1}$", path, ignore.case = TRUE) ){
    path <- sprintf("%s.html", path)
  }

  widget$width <- args$width
  widget$height <- args$height

  # set up working directory
  wdir <- dir_create(tempfile())
  on.exit({ unlink(wdir, recursive = TRUE) })

  widget$x$settings$cache_folder <- "#"

  # selfcontained = FALSE to save all data information
  temp_file <- file.path(wdir, "_tmp.html")
  htmlwidgets::saveWidget(
    widget,
    file = temp_file,
    selfcontained = FALSE,
    title = title,
    libdir = "_lib"
  )

  # Use htmlwidgets to save all js and css to html
  html_text <- readLines(temp_file)

  # convert <script src=*> to <script>js file contents</script>
  js_lines <- which(grepl(
    x = html_text,
    pattern = '(src=.*js)'
  ))

  # convert link[rel=stylesheet] to <style>css file contents</style>
  css_lines <- which(grepl(
    x = html_text,
    pattern = '(href=.*css)'
  ))

  readlines_quiet <- function(path) {
    suppressWarnings({
      readLines(path)
    })
  }

  # perform self-contained conversion/replacement of JS
  if(length(js_lines) > 0) {
    html_text[js_lines] <- lapply(js_lines, function(js_line) {
      js_file <- sub(x = html_text[js_line],
                     pattern = '.*src=[":\'](.*\\.js).*',
                     replacement = "\\1")
      js_content <- paste0("<script>",
                           paste0(readlines_quiet(file.path(wdir, js_file)), collapse = "\n"),
                           "</script>",
                           collapse = "\n")
    })
  }


  # perform self-contained conversion/replacement of JS
  if(length(css_lines) > 0) {
    html_text[css_lines] <- lapply(css_lines, function(css_line) {
      css_file <- sub(x=html_text[css_line], pattern='.*href=[":\'](.*\\.css).*', replacement="\\1")
      css_content <- paste0(
        "<style>",
        paste0(readlines_quiet(file.path(wdir,css_file)), collapse="\n"),
        "</style>",
        collapse="\n"
      )
    })
  }

  # save self-contained html
  write(paste0(html_text, collapse = "\n"), file = temp_file)

  # htmlwidgets::saveWidget(
  #   widget,
  #   file = file.path(wdir, "_tmp.html"),
  #   selfcontained = TRUE,
  #   title = title,
  #   libdir = "lib"
  # )

  # modify the html so the data is injected as data URI
  index <- file.path(wdir, "_tmp.html")

  s <- readLines(index)
  m <- stringr::str_match(s, '^(.*)</head>(.*)$')
  idx <- which(!is.na(m[,1]))
  if(length(idx)) {
    idx <- idx[[1]]
  } else {
    idx <- 2L
  }
  pre <- s[seq_len(idx - 1)]
  post <- s[seq.int(idx, length(s))]

  # read in base64 of each files
  datapath_root <- file.path(wdir, "_lib", 'threebrain_data-0/')
  data_files <- list.files(datapath_root, all.files = FALSE, full.names = FALSE, recursive = TRUE, include.dirs = FALSE)

  # Make sure the parent path exists
  directory <- dir_create(dirname(path))
  if(length(data_files)) {
    # convert data into base64
    conn <- file(path, "w+")
    writeLines(pre, conn)

    DATAURI_MAX <- floor(65529 / 73 * 54) #72 / 4 * 3
    lapply(data_files, function(data_file) {
      data_abspath <- file.path(datapath_root, data_file)

      data_file <- gsub("[\\\\/]+", "/", x = data_file)
      data_file <- gsub("^[/]+", "", data_file)
      if(endsWith(data_file, "json")) {
        datauri_type <- 'application/json'
      } else {
        datauri_type <- 'application/octet-stream'
      }

      fsize0 <- file.size(data_abspath)
      fsize <- fsize0
      fin <- file(data_abspath, open = "rb")
      ii <- 0
      while(fsize > 0) {
        raws <- readBin(con = fin, what = "raw", n = min(fsize, DATAURI_MAX))
        writeLines(c(
          sprintf("<script type='text/plain;charset=UTF-8' data-for='#%s' data-partition='%d' data-type='%s' data-size='%.0f' data-start='%.0f' data-parition-size='%.0f'>", data_file, ii, datauri_type, fsize0, fsize0 - fsize, length(raws)),
          jsonlite::base64_enc(input = raws),
          "</script>"
        ), conn)
        fsize <- fsize - length(raws)
        ii <- ii + 1
      }
      close(fin)
    })

    writeLines(post, conn)
    close(conn)
  } else {
    file.copy(index, path, overwrite = TRUE)
  }
  unlink(wdir, recursive = TRUE)

  if(as_zip){
    wd <- getwd()
    on.exit({ setwd(wd) })
    setwd(directory)
    fname <- basename(path)
    zipfile <- paste0(fname, ".zip")
    utils::zip(zipfile, files = fname)
  }

  structure(
    normalizePath(path),
    class = 'threeBrain.save_brain'
  )
#
#   directory <- normalizePath(directory)

#
#
#   s <- paste(readLines(file.path(directory, filename)), collapse = '\n')
#
#
#   # s <- stringr::str_replace_all(s, '\\n', '')
#
#   m <- stringr::str_match(s, '<head(.*?)</head>')
#   if(length(m)){
#     m <- m[1,2]
#     css <- unlist(stringr::str_extract_all(m, '<link[^>]*>'))
#     js <- unlist(stringr::str_extract_all(m, '<script[^>]*></script>'))
#   }else{
#     css <- NULL
#     js <- NULL
#   }
#
#   json <- stringr::str_match(s, '<script type="application/json" data-for=[^>]*>(.*)</script>')
#   if(length(json)){
#     json <- json[1,2]
#   }else{
#     json <- NULL
#   }
#
#   as_shiny <- function(outputId, width = "100%", height = "100vh") {
#     f <- tempfile()
#     on.exit(unlink(f))
#     writeLines(c(
#       paste0(
#         '<div class="htmlwidget_container">\n\t<div id="',
#         outputId,
#         '" style="width:',
#         shiny::validateCssUnit(width),
#         ';height:',
#         shiny::validateCssUnit(height),
#         ';" class="threejs_brain html-widget">\n\t</div>\n</div>\n'
#       ),
#       paste0(
#         '<script type="application/json" data-for="',
#         outputId, '">',
#         json,
#         '</script>'
#       )
#     ), con = f, sep = "\n")
#     shiny::tagList(
#       shiny::singleton(shiny::HTML(c(css, js))),
#       shiny::includeHTML(f)
#     )
#   }
#
#
#
#
#   return(structure(list(
#     directory = directory,
#     index = index,
#     zipfile = file.path(directory, 'compressed.zip'),
#     has_zip = as_zip,
#     as_shiny = as_shiny
#   ), class = 'threeBrain_saved'))

}

grey_col <- function(...){
  if( rs_avail() ){
    cat("\033[38;5;246m", paste(..., sep = " ", collapse = "\n"),
        "\033[39m", sep = "")
  } else {
    cat(..., sep = " ")
  }
}

green_col <- function(...){
  if( rs_avail() ){
    cat("\033[38;5;35m", paste(..., sep = " ", collapse = "\n"),
        "\033[39m", sep = "")
  } else {
    cat(..., sep = " ")
  }
}

red_col <- function(...){
  if( rs_avail() ){
    cat("\033[38;5;215m", paste(..., sep = " ", collapse = "\n"),
        "\033[39m", sep = "")
  } else {
    cat(..., sep = " ")
  }
}

#' @export
plot.threeBrain.save_brain <- function(x, ...){
  x <- normalizePath(x, winslash = "/", mustWork = TRUE)
  x <- gsub("[\\\\/]+", "/", x)
  utils::browseURL(sprintf("file://%s", x))
}

#' @export
format.threeBrain.save_brain <- function(x, ...){
  path_exists <- file.exists(x)
  paste(
    c(
      "<Static 3D Viewer>\n",
      "Path : ", x, "\n",
      "Valid: ", as.character(path_exists), "\n",
      "To view the static viewer, use:\n",
      sprintf("  utils::browseURL('%s')", x)
    ),
    collapse = ""
  )
}

#' @export
print.threeBrain.save_brain <- function(x, ...){
  cat(format(x), "\n", sep = "")
  invisible(x)
}

Try the threeBrain package in your browser

Any scripts or data that you put into this service are public.

threeBrain documentation built on April 4, 2025, 1:36 a.m.