homekeeper/beekeeper/R/widgets.R

# ---- 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", ...)
    )
  )
}