Badge Generator

#| '!! shinylive warning !!': |
#|   shinylive does not work in self-contained HTML documents.
#|   Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 720

suppressPackageStartupMessages({
    library(magrittr)
    library(shiny)
})

rsspdc_url <- "https://rsspdc.org"
types <- c("Specific Record", "Pipeline", "Software Package", "Web Service")
type_colours <- c("1b9e77", "d95f02", "e7298a", "7570b3")
names(type_colours) <- types 
badges <- c(
    none = "", bronze = "🥉", silver = "🥈", gold = "🥇", platinum = "🏆"
)

ui <- fluidPage(
    # see: https://stackoverflow.com/questions/78448126/copying-output-to-clipboard-in-r-shiny
    tags$script("
        Shiny.addCustomMessageHandler('txt', function (txt) {
            navigator.clipboard.writeText(txt);
        });
    "), # this is new
    fluidRow(
        column(
            width = 6,
            selectInput(
                inputId = "type", choices = types, selected = types[1],
                label = "Type"
            ),
            selectInput(
                inputId = "tier", choices = names(badges),
                selected = names(badges)[1],
                label = "Medal"
            ),
            numericInput(
                inputId = "total_score", label = "Total Score",
                value = 0,
                min = 0, max = 44, step = 1
            )
        ),
        column(
            width = 6,
            h2("Preview"),
            p(),
            htmlOutput(outputId = "html_preview")
        )
    ),
    fluidRow(
        tabsetPanel(
            id = "active_tab",
            tabPanel("URL", verbatimTextOutput(outputId = "url")),
            tabPanel("Markdown", verbatimTextOutput(outputId = "Markdown")),
            tabPanel("rSt", verbatimTextOutput(outputId = "rSt")),
            tabPanel("AsciiDoc", verbatimTextOutput(outputId = "AsciiDoc")),
            tabPanel("HTML", verbatimTextOutput(outputId = "html_raw"))
        ),
        actionButton("copy_link", "Copy to clipboard")
    )
)

server <- function(input, output, session) {

    encoded_url <- reactive({
        URLencode(paste0(
            "https://img.shields.io/badge/RSSPDC_",
            badges[input$tier], "_(", input$total_score, ")_-",
            input$type, "-", type_colours[input$type],
            "?link=", rsspdc_url,
            "&link=", rsspdc_url, "/checklists/",
            tolower(gsub(" ","-", input$type)), ".html"
        ))
    })
    output$url <- renderText({ encoded_url() })
    alt_text <- reactive({paste(
        "RSSPDC Badge", input$tier, input$total_score, input$type
    )})
    html_text <- reactive({
        paste0(
            '<img alt="', alt_text(), '" src="',
            encoded_url()
            ,'">'
        )
    })
    output$html_preview <- renderText({ html_text() })
    Markdown <- reactive({paste0(
        "[![", alt_text(), "](", encoded_url(), ")](", rsspdc_url, ")"
    )})
    rSt <- reactive({paste0(
        ".. image:: ", encoded_url(), "\n   :alt:", alt_text(),
        "\n   :target: ", rsspdc_url
    )})
    AsciiDoc <- reactive({paste0(
        "image:", encoded_url(), "[", alt_text(), ",link=", rsspdc_url, "]"
    )})
    output$Markdown <- renderText({ Markdown() })
    output$rSt <- renderText({ rSt() })
    output$AsciiDoc <- renderText({ AsciiDoc() })
    output$html_raw <- renderText({ html_text() })

    clipboard_text <- reactive({switch(
        input$active_tab,
        "URL" = encoded_url(), "Markdown" = Markdown(), "rSt" = rSt(),
        "AsciiDoc" = AsciiDoc(), "HTML" = html_text()
    )})
    
    observeEvent(input$copy_link, {
        session$sendCustomMessage("txt", clipboard_text())
    })
}

shinyApp(ui, server)