# ---- Stepper ---------------------------------------------------------------- stepper_row <- function(ns, id, label) { shiny::div( class = "d-flex justify-content-between align-items-center py-3 border-bottom", shiny::span(label, class = "fw-semibold"), shiny::div( class = "d-flex align-items-center gap-3", shiny::actionButton(ns(paste0(id, "_minus")), "−", class = "btn btn-outline-secondary rounded-circle p-0", style = "width:44px;height:44px;font-size:1.3rem;line-height:1" ), shiny::uiOutput(ns(paste0(id, "_disp")), inline = TRUE), shiny::actionButton(ns(paste0(id, "_plus")), "+", class = "btn btn-outline-secondary rounded-circle p-0", style = "width:44px;height:44px;font-size:1.3rem;line-height:1" ) ) ) } stepper_server <- function(id, input, output, default = NA_integer_) { val <- reactiveVal(default) observeEvent(input[[paste0(id, "_plus")]], { v <- val(); val(if (is.na(v)) 1L else v + 1L) }, ignoreInit = TRUE) observeEvent(input[[paste0(id, "_minus")]], { v <- val(); if (!is.na(v) && v > 0) val(v - 1L) }, ignoreInit = TRUE) output[[paste0(id, "_disp")]] <- renderUI({ v <- val() shiny::tags$span(class = "stepper-val", if (is.na(v)) "–" else as.character(v)) }) val } # ---- Info popover ----------------------------------------------------------- info_icon <- function(title, content) { bslib::popover( trigger = shiny::icon("circle-info", style = paste( "cursor:pointer;color:#6c757d;font-size:.8em;", "margin-left:.35rem;vertical-align:middle" ) ), title = title, content, placement = "auto" ) } # ---- Button-group selector (trait 1-4, strength 1-9, methods) -------------- btn_group_row <- function(ns, id, label, choices, info = NULL, stacked = FALSE) { label_el <- shiny::tagList(label, if (!is.null(info)) info_icon(info$title, info$content)) if (stacked) { shiny::div( class = "py-2 border-bottom", shiny::div(class = "fw-semibold mb-2", label_el), shiny::uiOutput(ns(paste0(id, "_btns"))) ) } else { shiny::div( class = "d-flex justify-content-between align-items-center py-2 border-bottom", shiny::span(class = "fw-semibold", label_el), shiny::uiOutput(ns(paste0(id, "_btns")), inline = TRUE) ) } } btn_group_server <- function(id, ns, input, output, choices, default = NA) { val <- reactiveVal(default) lapply(seq_along(choices), function(i) { observeEvent(input[[paste0(id, "_", i)]], { if (identical(val(), choices[[i]])) val(NA) else val(choices[[i]]) }, ignoreInit = TRUE) }) output[[paste0(id, "_btns")]] <- renderUI({ v <- val() shiny::div( class = "d-flex flex-wrap gap-1", lapply(seq_along(choices), function(i) { selected <- !is.na(v) && identical(v, choices[[i]]) cls <- if (selected) "btn btn-sm btn-primary" else "btn btn-sm btn-outline-secondary" shiny::actionButton(ns(paste0(id, "_", i)), names(choices)[i], class = cls, style = "min-width:38px;min-height:38px") }) ) }) val } trait_row <- function(ns, id, label, info = NULL) btn_group_row(ns, id, label, stats::setNames(1:4, 1:4), info = info) trait_server <- function(id, ns, input, output) btn_group_server(id, ns, input, output, stats::setNames(1:4, 1:4)) STRENGTH_INFO <- list( title = "Volksstärke (1–9)", content = shiny::tagList( shiny::tags$p("Schätzung der Bienenmenge nach Liebefeld-Methode:"), shiny::tags$table(class = "table table-sm table-borderless mb-0", shiny::tags$tbody( shiny::tags$tr(shiny::tags$td(shiny::tags$strong("1–2"), .noWS = "after"), shiny::tags$td("sehr schwaches Volk")), shiny::tags$tr(shiny::tags$td(shiny::tags$strong("3–4"), .noWS = "after"), shiny::tags$td("schwaches bis mittleres Volk")), shiny::tags$tr(shiny::tags$td(shiny::tags$strong("5–6"), .noWS = "after"), shiny::tags$td("mittleres bis starkes Volk")), shiny::tags$tr(shiny::tags$td(shiny::tags$strong("7–9"), .noWS = "after"), shiny::tags$td("sehr starkes Volk")) ) ), shiny::tags$p(class = "mt-2 mb-0 text-muted small", "Winterüberwinterung: mind. 4–5 anstreben.") ) ) strength_row <- function(ns, id = "strength") btn_group_row(ns, id, "Volksstärke", stats::setNames(1:9, 1:9), info = STRENGTH_INFO, stacked = TRUE) strength_server <- function(id = "strength", ns, input, output) btn_group_server(id, ns, input, output, stats::setNames(1:9, 1:9)) # ---- Toggle (checkbox styled as switch) ------------------------------------ toggle_row <- function(ns, id, label) { shiny::div( class = "bk-check d-flex justify-content-between align-items-center py-3 border-bottom", shiny::tags$label(class = "fw-semibold", `for` = ns(id), label), shiny::checkboxInput(ns(id), NULL, value = FALSE) ) } # ---- Section card ----------------------------------------------------------- section_card <- function(header = NULL, ...) { bslib::card( class = "mb-3", if (!is.null(header)) bslib::card_header(header), bslib::card_body(class = "px-2 py-0", ...) ) } # ---- Collapsible card (Bootstrap collapse) ---------------------------------- collapsible_card <- function(header, ..., collapse_id, open = FALSE) { shiny::tags$div(class = "card mb-3", shiny::tags$div( class = paste("card-header d-flex justify-content-between align-items-center collapse-toggle", if (!open) "collapsed"), `data-bs-toggle` = "collapse", `data-bs-target` = paste0("#", collapse_id), `aria-expanded` = tolower(as.character(open)), shiny::tags$span(class = "fw-semibold small text-uppercase text-muted", header), shiny::tags$i(class = "fa fa-chevron-down collapse-chevron text-muted ms-2") ), shiny::tags$div( id = collapse_id, class = if (open) "collapse show" else "collapse", shiny::tags$div(class = "card-body px-2 py-0", ...) ) ) }