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,102 @@
+screen_queen_ui <- function(id) {
+  ns <- NS(id)
+  shiny::div(
+    shiny::uiOutput(ns("current_queen")),
+    section_card("Neue Königin erfassen",
+      shiny::div(class = "row g-2 py-2",
+        shiny::div(class = "col-6",
+          shiny::numericInput(ns("year"), "Jahrgang",
+            value = as.integer(format(Sys.Date(), "%Y")), min = 2000, max = 2100, step = 1)
+        ),
+        shiny::div(class = "col-6",
+          shiny::textInput(ns("breed"), "Rasse / Zucht")
+        )
+      ),
+      btn_group_row(ns, "color", "Markierungsfarbe",
+        c("Weiß" = "weiss", "Gelb" = "gelb", "Rot" = "rot", "Grün" = "gruen", "Blau" = "blau")
+      ),
+      shiny::div(class = "py-2",
+        shiny::uiOutput(ns("origin_sel")),
+        shiny::dateInput(ns("introduced"), "Eingeweiselt am",
+          value = Sys.Date(), language = "de", weekstart = 1),
+        shiny::textAreaInput(ns("notes"), "Notizen", rows = 2, width = "100%")
+      )
+    ),
+    shiny::div(class = "d-grid mt-2 mb-5",
+      shiny::actionButton(ns("save"), "Königin speichern", class = "btn btn-info btn-lg")
+    )
+  )
+}
+
+screen_queen_server <- function(id, db, nav) {
+  moduleServer(id, function(input, output, session) {
+    ns       <- session$ns
+    color_v  <- btn_group_server("color", ns, input, output,
+      c("Weiß" = "weiss", "Gelb" = "gelb", "Rot" = "rot", "Grün" = "gruen", "Blau" = "blau"))
+
+    output$current_queen <- renderUI({
+      req(nav$colony_id)
+      co <- db_colonies_get(db, nav$colony_id)
+      req(nrow(co) > 0, !is.na(co$current_queen_id))
+      q <- db_queens_get(db, co$current_queen_id)
+      req(nrow(q) > 0)
+      bslib::card(
+        class = "mb-3",
+        bslib::card_header("Aktuelle Königin"),
+        bslib::card_body(
+          shiny::div(class = "row g-2",
+            shiny::div(class = "col-4",
+              shiny::tags$small(class = "text-muted", "Jahrgang"), shiny::tags$br(),
+              shiny::tags$strong(q$year %||% "–")
+            ),
+            shiny::div(class = "col-4",
+              shiny::tags$small(class = "text-muted", "Rasse"), shiny::tags$br(),
+              shiny::tags$strong(q$breed %||% "–")
+            ),
+            shiny::div(class = "col-4",
+              shiny::tags$small(class = "text-muted", "Farbe"), shiny::tags$br(),
+              shiny::tags$strong(q$marked_color %||% "–")
+            )
+          ),
+          shiny::div(class = "mt-2",
+            shiny::actionButton(ns("supersede"), "Ablösen (neue Königin)",
+              class = "btn btn-sm btn-outline-warning")
+          )
+        )
+      )
+    })
+
+    observeEvent(input$supersede, {
+      req(nav$colony_id)
+      co <- db_colonies_get(db, nav$colony_id)
+      if (!is.na(co$current_queen_id)) db_queens_supersede(db, co$current_queen_id)
+    })
+
+    output$origin_sel <- renderUI({
+      cols <- db_colonies_list(db)
+      shiny::selectInput(ns("origin"), "Herkunft (Muttervolk)",
+        choices = c("Unbekannt" = "", setNames(cols$id, cols$name))
+      )
+    })
+
+    observeEvent(nav$screen, {
+      if (nav$screen == "queens") color_v(NA)
+    }, ignoreInit = TRUE)
+
+    observeEvent(input$save, {
+      req(nav$colony_id)
+      origin <- if (!is.null(input$origin) && input$origin != "")
+        as.integer(input$origin) else NA
+      db_queens_insert(db,
+        colony_id        = nav$colony_id,
+        year             = input$year,
+        breed            = input$breed,
+        origin_colony_id = origin,
+        marked_color     = color_v(),
+        notes            = input$notes,
+        introduced_at    = as.character(input$introduced)
+      )
+      nav$screen <- "colony"
+    })
+  })
+}