R/StatusTrafficLightBig.R

In irisweyermenkhoff/toyota-idv-functions: Risk Reporting and Toolbox Calculation Functions

#' Status traffic light
#'
#' This function creates html to render reactive traffic lights in the ui
#' to enable the user to report the status with red, orange, green and neutral
#'
#' Per defualt the sizes of the traffic lights are defined in the css.
#'
#' @param name Name of traffic lights compound
#' @return HTML text for shiny ui
#' 
#'
#'
StatusTrafficLightBig <- function(name, color, neutral = TRUE) {
  if(neutral == TRUE) {
  
  id1 <- paste(name, "_1", sep = "")
  id2 <- paste(name, "_2", sep = "")
  id3 <- paste(name, "_3", sep = "")
  id4 <- paste(name, "_4", sep = "")
  
  check1=""
  check2=""
  check3=""
  check4=""
  
  if (is.null(color)){
    check1=""
    check2=""
    check3=""
    check4=""
  } else if (color == "red") {
    check1 = "checked='checked'"
  } else if (color == "orange"){
    check2 = "checked='checked'"
  } else if (color == "green"){
    check3 = "checked='checked'"
  } else if (color == "neutral"){
    check4 = "checked='checked'"
  } 
  
  
  tags$section( id=name,
    class = "ampelgross cf form-group shiny-input-radiogroup shiny-input-container",
    htmltools::HTML(paste0(
      '<input type="radio" name=',name,' id=',id1,' ', check1,' value="red">
        <label class="',glue(id1,"-label four col"),'" for="',id1,'" style="background-color:red;">
        </label> 
       </input>',
   
     '<input type="radio" name=',name,' id=',id2,' ', check2,' value="orange">
        <label class="',glue(id2,"-label four col"),'" for="',id2,'" style="background-color:orange;">
        </label> 
      </input>',
  
     '<input type="radio" name=',name,' id=',id3,' ', check3,' value="green">
        <label class="',glue(id3,"-label four col"),'" for="',id3,'" style="background-color:green;">
        </label> 
      </input>',
  
     '<input type="radio" name=',name,' id=',id4,' ', check4,' value="neutral">
        <label class="',glue(id4,"-label four col"),'" for="',id4,'" style="background-color:white;">
        </label> 
      </input>'
   ))
  ) 
  } else {
    id1 <- paste(name, "_1", sep = "")
    id2 <- paste(name, "_2", sep = "")
    id3 <- paste(name, "_3", sep = "")
    id4 <- paste(name, "_4", sep = "")
    
    check1=""
    check2=""
    check3=""
    check4=""
    
    if (is.null(color)){
      check1=""
      check2=""
      check3=""
    } else if (color == "red") {
      check1 = "checked='checked'"
    } else if (color == "orange"){
      check2 = "checked='checked'"
    } else if (color == "green"){
      check3 = "checked='checked'"
    } 
    
    tags$section( id=name,
      class = "ampelgross cf form-group shiny-input-radiogroup shiny-input-container",
      htmltools::HTML(paste0(
      '<input type="radio" name=',name,' id=',id1,' ', check1,' value="red">
        <label class="',glue(id1,"-label four col"),'" for="',id1,'" style="background-color:red;">
        </label> 
       </input>',
                    
       '<input type="radio" name=',name,' id=',id2,' ', check2,' value="orange">
        <label class="',glue(id2,"-label four col"),'" for="',id2,'" style="background-color:orange;">
        </label> 
      </input>',
                    
       '<input type="radio" name=',name,' id=',id3,' ', check3,' value="green">
        <label class="',glue(id3,"-label four col"),'" for="',id3,'" style="background-color:green;">
        </label> 
      </input>'
      ))
    )
  }
}