R/helper_html.R

Defines functions add_colored_box add_colored_str

Documented in add_colored_box add_colored_str

#  Copyright (C) 2021 Y Hsu <yh202109@gmail.com>
#
#  This program is free software: you can redistribute it and/or modify
#  it under the terms of the GNU General Public license as published by
#  the Free software Foundation, either version 3 of the License, or
#  any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
#  GNU General Public License for more details
#
#  You should have received a copy of the GNU General Public license
#  along with this program. If not, see <https://www.gnu.org/license/>

############################################################
#' Add a string with specified color or background color.
#'
#' \code{add_colored_str} returns a string component generated by \code{htmltools}
#' with specified color and styles.
#'
#' @importFrom htmltools tags HTML
#'
#' @param text A string. default="".
#' @param color One of
#' \itemize{
#'   \item a color name, e.g. 'red'.
#'   \item a HEX color string, e.g. '#000000' or '#000000FF'.
#'   \item an RGB vector for the color of text
#' }
#' @param bgcolor One of
#' \itemize{
#'   \item a color name, e.g. 'red'.
#'   \item a HEX color string, e.g. '#000000' or '#000000FF'.
#'   \item an RGB vector for the color of text
#' }
#' @param alpha An integer between 1 and 255 for text alpha. default=255.
#' @param bgalpha An integer between 1 and 255 for background alpha. default=51.
#' @param fontsize A real number between 0.5 and 5.0 for font size. default=1.
#' @param bold A logical value for bold fonts. default=\code{FALSE}.
#' @param it A Boolean value for italic fonts. default=\code{FALSE}.
#'
#' @return a formatted string
#'
#' @examples
#' add_colored_str("warning: read this message carefully.", color = c(255, 0, 0))
#'
#' @export
#'

add_colored_str <- function(text = "",
                            color = c(51, 122, 183),
                            alpha = 255,
                            bgcolor = NULL,
                            bgalpha = 51,
                            fontsize = 1,
                            bold = FALSE,
                            it = FALSE
                            ) {
  fontsize = suppressWarnings(as.numeric(fontsize))
  if (is.null(text) | (!is.character(text))) {
    text <- ""
    warning("text should be a string")
  }
  colorrgb = mtb_color2rgb( color, alpha, outalpha=TRUE )
  colorrgb[4] = colorrgb[4]/255
  colorstr <- paste( "color: rgba(", paste(colorrgb, collapse = ","),"); ",sep="")
  if( !is.null(bgcolor) ){
    bgcolorrgb = mtb_color2rgb( bgcolor, bgalpha, outalpha=TRUE )
    bgcolorrgb[4] = bgcolorrgb[4]/255
    bgcolorstr <- paste( "background-color: rgba(", paste(bgcolorrgb, collapse = ","),"); ",sep="")
  }else{bgcolorstr=""}
  if( !(length(fontsize)==1) | is.na(fontsize) ){
    fontsize <- 1
  } else {
    fontsize <- min(max(fontsize, 0.5), 5)
  }
  fontwtstr = ifelse(bold==TRUE, "font-weight: bold;", "")
  fontwtstr = paste(fontwtstr, ifelse(it==TRUE, "font-style: italic;", ""), sep="")

  text <- mtb_cleanupstr(text)
  htmltools::tags$span(
    htmltools::HTML(text),
    style = paste(
      bgcolorstr, colorstr, fontwtstr,
      "margin: 3px auto 3px auto; font-size:", paste(floor(100 * fontsize), "%", sep=""),sep=""
    )
  )
}

############################################################
#' Add a box with specified color in an R Markdown file.
#'
#' \code{add_colored_box} returns a box component generated by \code{htmltools}
#' with specified color and styles.
#'
#' @importFrom htmltools tags HTML
#'
#' @param type One of:
#' \itemize{
#'  \item \code{NULL} for no default color or label
#'  \item 'blue-default' for a steel-blue box
#'  \item 'gray-info' for a gray box
#'  \item 'blue-info' for a blue box
#'  \item 'green-remainder' for a green box
#'  \item 'yellow-warning' for a yellow box
#'  \item 'red-stop' for a red box
#' }
#' @param label One of:
#' \itemize{
#'  \item \code{NULL} for no label if type is NULL or using label set by type
#'  \item A string shown on the top of box
#' }
#' @param info A string including the main message of the box
#' @param bgcolor NA or a length 3 vector with integer elements between 0 to 255
#' @param width NA or a number between 0.25 to 0.95
#' @param halign One of:
#' \itemize{
#'   \item \code{NA} for center aligned
#'   \item 'c' for center aligned
#'   \item 'r' for right aligned
#' }
#' @param top One of:
#' \itemize{
#'   \item NA
#'   \item \code{FALSE} for inline
#'   \item \code{TRUE} for top-of-page
#' }
#'
#' @examples
#' add_colored_box( type='blue-default', info='the document include information regarding...')
#'
#' @export
#'

add_colored_box = function(
  type = 'blue-default',
  label = '',
  info = 'place details here using info option',
  bgcolor = NULL,
  width = 0.5,
  halign = 'c',
  top = FALSE
){
  if( is.null(type) ){type="blue-default"}else{type=as.character(type)}
  if( !is.character(type)|length(type)!=1){ type="blue-default"; warning('Type should be a string.')}
  if( is.null(label) ){label=""}else{label=as.character(label)}
  if( !is.character(label)|length(label)!=1){ label=""; warning('Label should be a string.')}
  if( is.null(info) ){info = ""}else{info=as.character(info)}
  if( !is.character(info)|length(info)!=1 ){ info = ""; warning('Info should be a string.')}
  info = mtb_cleanupstr(info)
  width = as.numeric(width)
  if( length(width)!=1 ){ width = 0.5 }
  if( width > 0.95 ){ width = 0.95 }
  if( width < 0.25 ){ width = 0.25 }
  if( is.null(halign) ){ halign=''; warning('halign should be either c or r')}
  if( !is.character(halign) | !(halign=='c'|halign=='r') ){ halign=''; warning('halign should be either c or r')}
  if( halign == 'r' ){ width = min(width, 0.35); alignstr = 'position: absolute; right:0;'}else{alignstr=''}
  if( !is.logical(top) ){ top = FALSE; warning('top should be either TRUE or FALSE') }
  if( top ){ alignstr = paste(alignstr, 'top:0;')}
  lsttype = c('blue-default', 'blue-info','gray-info','green-reminder', 'yellow-warning','red-stop')
  typestr = c('&#9749;', '&#9749;', '&#9749;', '&#8986;', '&#9888;', '&#9940;')[lsttype==type]
  if(length(typestr)==0){typestr=''}
  if(label==""){ label = c('Note', 'Note', 'Note', 'Reminder', 'Warning', 'Stop')[lsttype==type]; if(length(label)==0) label="" }
  if( is.null(bgcolor) ){
    bgcolor = rbind( c(51, 122, 183), c(60,110,230), rep(110,3), c(110,230,60), c(230,200,60), c(230,110,60))[lsttype==type, ]
    if(length(bgcolor)==0){bgcolor=rep(120,3)}
  }
  if( !is.null(bgcolor) ){ bgcolorrgb = mtb_color2rgb( bgcolor )[1:3] }else{bgcolorrgb=rep(120,3)}
  htmltools::tags$div(htmltools::HTML(paste("<b> &nbsp; <span style='font-size:110%;'>", typestr, "</span><i>", label, "</i></b>", htmltools::tags$div(htmltools::HTML(info), style='background-color: rgba(255,255,255,0.75); padding: 10px 20px 10px 20px; border-radius: 0px 0px 5px 0px;'))),
           style=paste( alignstr, "background-color: rgba(", paste(bgcolorrgb, collapse=','), ", 0.2); margin: 3px auto 3px auto; width:", paste(floor(100*width),"%", sep=""), "; border-width: 0px 0px 0px 3px; border-color: rgba(", paste(bgcolorrgb, collapse=','), ",1); border-style: solid; padding: 1px 1px 1px 0px; border-radius: 0px 0px 5px 0px;"))
}

Try the mtb package in your browser

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

mtb documentation built on Oct. 21, 2022, 1:05 a.m.