add homekeeper stack

2026-07-06 19:25:38 +02:00
commit 58983e6855
90 changed files with 6816 additions and 0 deletions
@@ -0,0 +1,156 @@
+# ---- 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", ...)
+    )
+  )
+}