# Präambel ####

PFAD_DOWNLOAD_SKRIPT  = "../API/get_data_ctq.R"
PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R"
AKZENT_FARBE = "#8B2635"

APP_VERZEICHNIS = normalizePath(getwd())
absPath = function(pfad) {
  if (grepl("^([A-Za-z]:[/\\\\]|/)", pfad)) return(pfad)
  file.path(APP_VERZEICHNIS, pfad)
}
PFAD_DOWNLOAD_SKRIPT  = normalizePath(absPath(PFAD_DOWNLOAD_SKRIPT),  mustWork = FALSE)
PFAD_PSEUDONYM_SKRIPT = normalizePath(absPath(PFAD_PSEUDONYM_SKRIPT), mustWork = FALSE)

CTQ_DISCLAIMER = paste0(
  "Diese Auswertung ist ein Hilfsmittel fuer klinisches Fachpersonal und ersetzt ",
  "keine klinische Diagnose. Die Interpretation obliegt der behandelnden Person. ",
  "Die angezeigte Klassifikation (None/Low/Moderate/Severe) stammt aus dem amerikanischen ",
  "CTQ-Manual (Bernstein & Fink, 1998) und liegt fuer die deutsche Fassung nicht als eigene ",
  "Norm vor; sie dient nur zur groben Orientierung, nicht als gesicherte deutsche Normierung. ",
  "Die Subskala Bagatellisierung/Verleugnung hat im Manual keine eigene Klassifikationsstufe ",
  "und ist als Validitaetshinweis (moegliche Verzerrung der uebrigen Angaben) zu lesen, nicht ",
  "als klinische Belastungsdimension."
)

CTQ_BADGE_FARBEN = c(
  "1" = "#4CAF50",
  "2" = "#FFC107",
  "3" = "#FF9800",
  "4" = "#E53935",
  "5" = "#4A0000"
)
CTQ_BADGE_TEXT_FARBEN = c(
  "1" = "white",
  "2" = "#333333",
  "3" = "white",
  "4" = "white",
  "5" = "white"
)

CTQ_KLASS_WORD_FARBEN = list(
  "None (or minimal)"    = list(bg = "#E8F5E9", text = "#2E7D32"),
  "Low (to moderate)"    = list(bg = "#FFF9C4", text = "#F57F17"),
  "Moderate (to severe)" = list(bg = "#FFF3E0", text = "#E65100"),
  "Severe (to extreme)"  = list(bg = "#FFEBEE", text = "#B71C1C")
)

library(shiny)
library(dplyr)
library(ggplot2)
library(haven)
library(officer)


# Infrastruktur ####

app_css = "
body { font-family: 'Segoe UI', Arial, sans-serif; background: #f5f5f5; }
.app-header {
  background: #8B2635; color: white; padding: 18px 24px 14px;
  margin-bottom: 20px; border-radius: 0 0 6px 6px;
}
.app-header h2 { margin: 0; font-size: 1.5rem; font-weight: 600; }
.app-header p  { margin: 4px 0 0; opacity: 0.85; font-size: 0.9rem; }
.input-panel {
  background: white; border-radius: 6px; padding: 16px 20px;
  margin-bottom: 16px; box-shadow: 0 1px 3px rgba(0,0,0,.12);
  display: flex; align-items: flex-end; gap: 12px; flex-wrap: wrap;
}
.input-panel .form-group { margin-bottom: 0; }
.input-panel label { font-weight: 600; color: #333; }
.btn-laden {
  background: #8B2635 !important; color: white !important;
  border: none !important; border-radius: 4px !important;
  padding: 8px 20px !important; font-weight: 600 !important; cursor: pointer;
}
.btn-laden:hover { background: #6d1e29 !important; }
.alert-fehler {
  background: #FFEBEE; border-left: 5px solid #C62828;
  padding: 12px 16px; border-radius: 4px; color: #B71C1C;
  margin-bottom: 12px; font-weight: 500;
}
.alert-warnung {
  background: #FFF3E0; border-left: 5px solid #E65100;
  padding: 10px 16px; border-radius: 4px; color: #BF360C;
  margin-bottom: 12px; font-size: 0.93em; font-weight: 500;
}
.abschnitt-karte {
  background: white; border-radius: 6px; padding: 20px 24px;
  margin-bottom: 16px; box-shadow: 0 1px 3px rgba(0,0,0,.12);
}
.abschnitt-titel {
  color: #8B2635; font-size: 1.15rem; font-weight: 700;
  border-bottom: 2px solid #8B2635; padding-bottom: 8px; margin-bottom: 14px;
}
.meta-block { margin-bottom: 10px; color: #555; font-size: 0.95em; }
.meta-block strong { color: #222; }
.subskala-karte {
  border-radius: 6px; padding: 14px 18px; margin-bottom: 12px;
  background: #FAFAFA; border: 1px solid #E8E8E8;
}
.subskala-titel { font-weight: 700; color: #333; font-size: 0.97rem; margin-bottom: 4px; }
.subskala-score { font-size: 1.9rem; font-weight: 800; color: #8B2635; display: inline-block; }
.klass-badge {
  display: inline-block; border-radius: 4px; padding: 3px 10px;
  font-weight: 600; font-size: 0.83em; margin-left: 10px; vertical-align: middle;
}
.klass-none     { background: #E8F5E9; color: #2E7D32; border: 1px solid #A5D6A7; }
.klass-low      { background: #FFF9C4; color: #B7770D; border: 1px solid #FFE082; }
.klass-moderate { background: #FFF3E0; color: #E65100; border: 1px solid #FFCC80; }
.klass-severe   { background: #FFEBEE; color: #B71C1C; border: 1px solid #EF9A9A; }
.disclaimer-box {
  font-size: 0.83em; color: #666; font-style: italic;
  background: #FAFAFA; border: 1px solid #E0E0E0;
  padding: 10px 14px; border-radius: 4px; margin-top: 8px;
}
.item-zeile {
  display: flex; align-items: flex-start; gap: 10px;
  padding: 7px 0; border-bottom: 1px solid #F0F0F0;
}
.item-nr   { font-weight: 600; color: #8B2635; min-width: 30px; flex-shrink: 0; }
.item-text { flex: 1; color: #333; font-size: 0.92em; }
.stufe-badge {
  border-radius: 4px; padding: 2px 9px; font-weight: 700;
  font-size: 0.82em; white-space: nowrap; display: inline-block; flex-shrink: 0;
}
.stufe-badge-1 { background: #4CAF50; color: white; }
.stufe-badge-2 { background: #FFC107; color: #333333; }
.stufe-badge-3 { background: #FF9800; color: white; }
.stufe-badge-4 { background: #E53935; color: white; }
.stufe-badge-5 { background: #4A0000; color: white; }
.sk-gruppe-titel {
  font-weight: 700; color: #555; font-size: 0.88em; text-transform: uppercase;
  letter-spacing: 0.05em; margin-top: 14px; margin-bottom: 4px;
}
.item-01-hinweis {
  font-size: 0.82em; color: #888; font-style: italic; margin-left: 4px;
}
"
app_css = gsub("#8B2635", AKZENT_FARBE, app_css, fixed = TRUE)


# Helper ####

clean_item_label = function(text) {
  if (is.null(text) || length(text) == 0 || is.na(text[1])) return(NA_character_)
  sub("^\\d+[.)\\s]\\s*", "", trimws(as.character(text[1])))
}

ctq_get_anker = function(original_col, wert) {
  if (is.null(wert) || length(wert) == 0 || is.na(wert[1])) return(NA_character_)
  lbl = attr(original_col, "labels")
  if (!is.null(lbl) && length(lbl) > 0) {
    pos = which(as.numeric(lbl) == as.numeric(wert[1]))
    if (length(pos) > 0) return(names(lbl)[pos[1]])
  }
  NA_character_
}

bagatellisierung_itemscore = function(rohwert) {
  if (is.na(rohwert)) return(NA_real_)
  if (rohwert == 5) return(1)
  return(0)
}

ctq_validiere_labels = function(daten_ctq) {
  anker_erwartet = c("überhaupt nicht", "sehr selten", "einige male",
                     "häufig", "sehr häufig")
  for (nr in 2:28) {
    var = paste0("ctq_", sprintf("%02d", nr))
    col = daten_ctq[[var]]
    lbl = attr(col, "labels")
    if (is.null(lbl) || length(lbl) < 5)
      stop(paste0(
        "Labels fuer ", var, " fehlen oder unvollstaendig (", length(lbl), " statt 5). ",
        "Bitte formr-Export pruefen."
      ))
    namen_norm = tolower(trimws(names(lbl)))
    fehlend = anker_erwartet[!anker_erwartet %in% namen_norm]
    if (length(fehlend) > 0)
      stop(paste0(
        "Labels fuer ", var, " nicht wie erwartet. ",
        "Fehlende Anker: [", paste(fehlend, collapse = ", "), "]. ",
        "Gefunden: [", paste(names(lbl), collapse = ", "), "]. ",
        "Bitte formr-Export pruefen."
      ))
  }
  invisible(TRUE)
}

ctq_klassifiziere = function(score, grenzen, labels) {
  if (is.na(score)) return(NA_character_)
  if (score <= grenzen[1]) return(labels[1])
  if (score <= grenzen[2]) return(labels[2])
  if (score <= grenzen[3]) return(labels[3])
  return(labels[4])
}

klass_css_klasse = function(klass_label) {
  if (is.null(klass_label) || is.na(klass_label)) return("")
  switch(klass_label,
    "None (or minimal)"    = "klass-none",
    "Low (to moderate)"    = "klass-low",
    "Moderate (to severe)" = "klass-moderate",
    "Severe (to extreme)"  = "klass-severe",
    ""
  )
}

berechne_sk_score = function(sk_name, sk, zeile, daten_ctq) {
  if (isTRUE(sk$sonderkodierung)) {
    item_scores = sapply(sk$items, function(nr) {
      var = paste0("ctq_", sprintf("%02d", nr))
      roh = as.numeric(zeile[[var]][1])
      bagatellisierung_itemscore(roh)
    })
    return(sum(item_scores, na.rm = TRUE))
  }
  item_scores = sapply(sk$items, function(nr) {
    var = paste0("ctq_", sprintf("%02d", nr))
    roh = as.numeric(zeile[[var]][1])
    if (is.na(roh)) return(NA_real_)
    if (nr %in% sk$invertiert) 6 - roh else roh
  })
  sum(item_scores, na.rm = TRUE)
}

make_ctq_gauge = function(score, x_min, x_max, titel, grenzen = NULL) {
  score_num = as.numeric(score)
  if (!is.null(grenzen)) {
    zone_df = data.frame(
      xmin = c(x_min - 0.5, grenzen + 0.5),
      xmax = c(grenzen + 0.5, x_max + 0.5),
      fill = c("#C8E6C9", "#FFF9C4", "#FFE0B2", "#FFCDD2"),
      stringsAsFactors = FALSE
    )
  } else {
    zone_df = data.frame(
      xmin = x_min - 0.5,
      xmax = x_max + 0.5,
      fill = "#E3F2FD",
      stringsAsFactors = FALSE
    )
  }
  ggplot() +
    geom_rect(data = zone_df,
              aes(xmin = xmin, xmax = xmax, ymin = 0, ymax = 1, fill = fill),
              color = NA) +
    scale_fill_identity() +
    geom_rect(aes(xmin = x_min - 0.5, xmax = x_max + 0.5, ymin = 0, ymax = 1),
              fill = NA, color = "#9E9E9E", linewidth = 0.6) +
    geom_segment(aes(x = score_num, xend = score_num, y = -0.25, yend = 1.25),
                 color = AKZENT_FARBE, linewidth = 2.5) +
    geom_label(aes(x = score_num, y = 1.6, label = paste0("Score: ", score_num)),
               fill = AKZENT_FARBE, color = "white", fontface = "bold",
               linewidth = 0, size = 4) +
    scale_x_continuous(
      limits = c(x_min - 1, x_max + 1),
      breaks = if (!is.null(grenzen)) sort(unique(c(x_min, grenzen, x_max)))
               else x_min:x_max
    ) +
    scale_y_continuous(limits = c(-0.8, 2.0)) +
    theme_minimal(base_size = 11) +
    theme(
      axis.text.y        = element_blank(),
      axis.ticks.y       = element_blank(),
      panel.grid.major.y = element_blank(),
      panel.grid.minor   = element_blank(),
      axis.title.y       = element_blank(),
      plot.margin        = margin(t = 5, r = 10, b = 5, l = 10)
    ) +
    labs(x = paste0(titel, " (", x_min, "-", x_max, ")"), y = NULL)
}


# Datenaufbereitung ####

ctq_subskalen = list(
  emotionale_vernachlaessigung = list(
    items          = c(2, 5, 7, 13, 19, 26, 28),
    invertiert     = c(2, 5, 7, 13, 19, 26, 28),
    label          = "Emotionale Vernachlässigung"
  ),
  sexueller_missbrauch = list(
    items          = c(20, 21, 23, 24, 27),
    invertiert     = c(),
    label          = "Sexueller Missbrauch"
  ),
  koerperlicher_missbrauch_vernachlaessigung = list(
    items          = c(4, 6, 9, 11, 12, 15, 17),
    invertiert     = c(),
    label          = "Körperlicher Missbrauch und Vernachlässigung"
  ),
  emotionaler_missbrauch = list(
    items          = c(3, 8, 14, 18, 25),
    invertiert     = c(),
    label          = "Emotionaler Missbrauch"
  ),
  bagatellisierung = list(
    items           = c(10, 16, 22),
    invertiert      = c(),
    label           = "Bagatellisierung/Verleugnung",
    sonderkodierung = TRUE
  )
)

ctq_klassifikation = list(
  emotionale_vernachlaessigung = list(
    grenzen = c(9, 14, 17),
    labels  = c("None (or minimal)", "Low (to moderate)", "Moderate (to severe)", "Severe (to extreme)")
  ),
  sexueller_missbrauch = list(
    grenzen = c(5, 7, 12),
    labels  = c("None (or minimal)", "Low (to moderate)", "Moderate (to severe)", "Severe (to extreme)")
  ),
  koerperlicher_missbrauch_vernachlaessigung = list(
    grenzen = c(7, 9, 12),
    labels  = c("None (or minimal)", "Low (to moderate)", "Moderate (to severe)", "Severe (to extreme)")
  ),
  emotionaler_missbrauch = list(
    grenzen = c(8, 12, 15),
    labels  = c("None (or minimal)", "Low (to moderate)", "Moderate (to severe)", "Severe (to extreme)")
  )
)

item_zu_skala = local({
  erg = list()
  for (sk_name in names(ctq_subskalen)) {
    for (nr in ctq_subskalen[[sk_name]]$items) {
      erg[[as.character(nr)]] = sk_name
    }
  }
  erg
})


# UI ####

ui = fluidPage(
  tags$head(
    tags$meta(charset = "UTF-8"),
    tags$style(HTML(app_css))
  ),

  div(class = "app-header",
    tags$h2("CTQ – Childhood Trauma Questionnaire"),
    tags$p("Bernstein & Fink, 1998 | Deutsche Fassung | Einzelauswertung")
  ),

  div(class = "container-fluid",

    div(class = "input-panel",
      div(style = "min-width: 360px; white-space: nowrap;",
        textInput("pseudonym",
                   label = tagList(
                     "Pseudonym",
                     tags$span(style = "font-weight: normal; font-style: italic; font-size: 0.78em; color: #888; margin-left: 4px; white-space: nowrap;",
                               "optional, hat Vorrang vor Chiffre")
                   ),
                   placeholder = "optional", width = "340px")
      ),
      div(style = "min-width: 200px;",
        textInput("chiffre", label = "Patientenchiffre",
                  placeholder = "z.B. P000123", width = "100%")
      ),
      actionButton("btn_suchen", "Auswerten", class = "btn btn-primary btn-laden"),
      div(style = "margin-left: auto;",
        downloadButton("download_word", "Word-Export (.docx)")
      )
    ),

    uiOutput("fehler_ui"),
    uiOutput("warnung_ui"),
    uiOutput("ergebnis_ui")
  )
)


# Word-Export ####

erstelle_ctq_docx = function(erg) {
  doc = read_docx()

  fp_titel      = fp_text(color = AKZENT_FARBE, bold = TRUE,  font.size = 18)
  fp_abschnitt  = fp_text(color = AKZENT_FARBE, bold = TRUE,  font.size = 13)
  fp_label      = fp_text(bold = TRUE,  font.size = 11)
  fp_normal     = fp_text(font.size = 11)
  fp_disclaimer = fp_text(font.size = 9, italic = TRUE, color = "#777777")
  fp_sk_titel   = fp_text(bold = TRUE, font.size = 12)

  doc = body_add_fpar(doc, fpar(
    ftext("CTQ – Childhood Trauma Questionnaire", fp_titel)
  ))
  doc = body_add_fpar(doc, fpar(
    ftext("Chiffre: ", fp_label), ftext(erg$chiffre, fp_normal),
    ftext("     Ausfuelldatum: ", fp_label), ftext(erg$ausfuelldatum, fp_normal)
  ))
  if (!is.null(erg$info_mehrere)) {
    doc = body_add_fpar(doc, fpar(
      ftext(erg$info_mehrere, fp_text(font.size = 10, italic = TRUE, color = "#555555"))
    ))
  }
  doc = body_add_par(doc, "", style = "Normal")

  doc = body_add_fpar(doc, fpar(ftext("Subskalen-Scores", fp_abschnitt)))

  for (sk_name in names(erg$sk_erg)) {
    sk_res = erg$sk_erg[[sk_name]]
    score_txt = as.character(sk_res$score)

    if (!is.na(sk_res$klass)) {
      klass_farbe = CTQ_KLASS_WORD_FARBEN[[sk_res$klass]]
      fp_klass = fp_text(bold = TRUE, font.size = 11,
                         color = klass_farbe$text, shading.color = klass_farbe$bg)
      doc = body_add_fpar(doc, fpar(
        ftext(paste0(sk_res$label, ":  "), fp_sk_titel),
        ftext(score_txt, fp_text(bold = TRUE, font.size = 13, color = AKZENT_FARBE)),
        ftext("   ", fp_normal),
        ftext(paste0(" ", sk_res$klass, " "), fp_klass)
      ))
    } else {
      doc = body_add_fpar(doc, fpar(
        ftext(paste0(sk_res$label, " (Validitaetshinweis):  "), fp_sk_titel),
        ftext(paste0(score_txt, " / 3"), fp_text(bold = TRUE, font.size = 13, color = AKZENT_FARBE))
      ))
    }
  }
  doc = body_add_par(doc, "", style = "Normal")

  doc = body_add_fpar(doc, fpar(ftext("Einzelitems", fp_abschnitt)))

  sk_reihenfolge = names(ctq_subskalen)
  for (sk_name in sk_reihenfolge) {
    sk_label = ctq_subskalen[[sk_name]]$label
    doc = body_add_fpar(doc, fpar(
      ftext(sk_label, fp_text(bold = TRUE, font.size = 11, color = "#555555"))
    ))
    items_dieser_sk = Filter(function(it) {
      !is.null(it$sk_name) && !is.na(it$sk_name) && it$sk_name == sk_name
    }, erg$items_erg)
    for (it in items_dieser_sk) {
      roh_key = if (!is.na(it$rohwert) && it$rohwert >= 1 && it$rohwert <= 5)
        as.character(as.integer(it$rohwert)) else "1"
      badge_farbe = CTQ_BADGE_FARBEN[[roh_key]]
      badge_text_farbe = CTQ_BADGE_TEXT_FARBEN[[roh_key]]
      fp_badge = fp_text(color = badge_text_farbe, bold = TRUE,
                         shading.color = badge_farbe, font.size = 10)
      item_txt = if (!is.na(it$item_text)) it$item_text else paste0("Item ", it$nr)
      anker_txt = if (!is.na(it$anker_text)) it$anker_text else paste0("Stufe ", it$rohwert)
      doc = body_add_fpar(doc, fpar(
        ftext(paste0(it$nr, ". ", item_txt, "  "), fp_normal),
        ftext(paste0(" ", anker_txt, " "), fp_badge)
      ))
    }
  }

  item1 = Filter(function(it) it$nr == 1, erg$items_erg)
  if (length(item1) > 0) {
    it = item1[[1]]
    doc = body_add_fpar(doc, fpar(
      ftext("Item 1 (nicht in Subskalenbildung einbezogen)",
            fp_text(bold = TRUE, font.size = 11, color = "#888888"))
    ))
    roh_key = if (!is.na(it$rohwert) && it$rohwert >= 1 && it$rohwert <= 5)
      as.character(as.integer(it$rohwert)) else "1"
    badge_farbe = CTQ_BADGE_FARBEN[[roh_key]]
    badge_text_farbe = CTQ_BADGE_TEXT_FARBEN[[roh_key]]
    fp_badge = fp_text(color = badge_text_farbe, bold = TRUE,
                       shading.color = badge_farbe, font.size = 10)
    item_txt = if (!is.na(it$item_text)) it$item_text else "Item 1"
    anker_txt = if (!is.na(it$anker_text)) it$anker_text else paste0("Stufe ", it$rohwert)
    doc = body_add_fpar(doc, fpar(
      ftext(paste0("1. ", item_txt, "  "), fp_normal),
      ftext(paste0(" ", anker_txt, " "), fp_badge)
    ))
  }

  doc = body_add_par(doc, "", style = "Normal")
  doc = body_add_fpar(doc, fpar(ftext(CTQ_DISCLAIMER, fp_disclaimer)))

  doc
}


# Server ####

server = function(input, output, session) {
  # --- pseudonym-support-injection v1 ---
  observe({
    query = parseQueryString(session$clientData$url_search)
    if (!is.null(query$pseudonym) && nchar(trimws(query$pseudonym)) > 0) {
      updateTextInput(session, "pseudonym", value = trimws(query$pseudonym))
    }
  })

  observe({
    query = parseQueryString(session$clientData$url_search)
    if (!is.null(query$chiffre) && nchar(trimws(query$chiffre)) > 0) {
      updateTextInput(session, "chiffre", value = toupper(trimws(query$chiffre)))
    }
  })

  ergebnis_r = eventReactive(input$btn_suchen, {

    chiffre = toupper(trimws(input$chiffre))

    if ((nchar(trimws(input$pseudonym)) == 0 && nchar(chiffre) == 0))
      return(list(error = "Bitte eine Patientenchiffre eingeben."))

    if (!(nchar(trimws(input$pseudonym)) > 0 || grepl("^[A-Z][0-9]{6}$", chiffre)))
      return(list(error = paste0(
        "Ungueltige Chiffre '", chiffre, "'. ",
        "Erwartet: ein Grossbuchstabe gefolgt von 6 Ziffern (z.B. P000123)."
      )))

    if (!file.exists(PFAD_DOWNLOAD_SKRIPT))
      return(list(error = paste0("Download-Skript nicht gefunden:\n", PFAD_DOWNLOAD_SKRIPT)))
    if (!file.exists(PFAD_PSEUDONYM_SKRIPT))
      return(list(error = paste0("Pseudonym-Skript nicht gefunden:\n", PFAD_PSEUDONYM_SKRIPT)))

    res_dl = tryCatch(
      { source(PFAD_DOWNLOAD_SKRIPT, local = FALSE); list(ok = TRUE) },
      error = function(e) list(ok = FALSE, msg = e$message)
    )
    if (!res_dl$ok)
      return(list(error = paste0("Fehler im Download-Skript: ", res_dl$msg)))

    db_ordner = local({
      ordner   = dirname(normalizePath(PFAD_PSEUDONYM_SKRIPT, mustWork = FALSE))
      gefunden = NULL
      for (i in 1:5) {
        if (file.exists(file.path(ordner, "pseudonyme.db"))) { gefunden = ordner; break }
        elternteil = dirname(ordner)
        if (elternteil == ordner) break
        ordner = elternteil
      }
      gefunden
    })

    alter_wd = getwd()
    wd_ziel  = if (!is.null(db_ordner)) db_ordner else
      dirname(normalizePath(PFAD_PSEUDONYM_SKRIPT, mustWork = FALSE))
    setwd(wd_ziel)
    on.exit(setwd(alter_wd), add = TRUE)

    res_ps = tryCatch(
      { source(PFAD_PSEUDONYM_SKRIPT, local = FALSE)
      if (nchar(trimws(input$pseudonym)) > 0) {
        .pw_wert = trimws(input$pseudonym)
        .pw_tab = get("pseudo", envir = .GlobalEnv)
        .pw_treffer = .pw_tab[.pw_tab$pseudonym == .pw_wert, ]
        if (nrow(.pw_treffer) > 0) chiffre = toupper(trimws(.pw_treffer$chiffre[1]))
      }; list(ok = TRUE) },
      error = function(e) list(ok = FALSE, msg = e$message)
    )
    if (!res_ps$ok)
      return(list(error = paste0("Fehler im Pseudonym-Skript: ", res_ps$msg)))

    if (!exists("daten_ctq", envir = .GlobalEnv))
      return(list(error = paste0(
        "Objekt 'daten_ctq' nach dem Sourcen nicht gefunden. ",
        "Bitte Download-Skript pruefen."
      )))
    if (!exists("pseudo", envir = .GlobalEnv))
      return(list(error = paste0(
        "Objekt 'pseudo' nach dem Sourcen nicht gefunden. ",
        "Bitte Pseudonym-Skript pruefen."
      )))

    daten_ctq = get("daten_ctq", envir = .GlobalEnv)
    pseudo_df = get("pseudo",    envir = .GlobalEnv)

    treffer_ps = pseudo_df[pseudo_df$chiffre == chiffre, ]
    if (nrow(treffer_ps) == 0)
      return(list(error = paste0(
        "Chiffre '", chiffre, "' wurde in der Pseudonym-Datenbank nicht gefunden."
      )))

    alle_session_ids = unique(treffer_ps$pseudonym)
    if (nchar(trimws(input$pseudonym)) > 0) alle_session_ids = trimws(input$pseudonym)

    treffer_dat = daten_ctq[daten_ctq$session %in% alle_session_ids, ]
    if (nrow(treffer_dat) == 0)
      return(list(error = paste0(
        "Kein CTQ-Datensatz fuer Chiffre '", chiffre, "' gefunden. ",
        "(", length(alle_session_ids), " Pseudonym(e) geprueft)"
      )))

    info_mehrere = NULL
    if (nrow(treffer_dat) > 1) {
      n           = nrow(treffer_dat)
      treffer_dat = treffer_dat[order(treffer_dat$created, decreasing = TRUE), ]
      datum_neu   = tryCatch(
        format(as.POSIXct(treffer_dat$created[1]), "%d.%m.%Y %H:%M"),
        error = function(e) "unbekanntes Datum"
      )
      info_mehrere = paste0(
        "Mehrere Ausfuellungen gefunden (", n, " Eintraege). ",
        "Angezeigt wird die neueste vom ", datum_neu, "."
      )
      treffer_dat = treffer_dat[1, , drop = FALSE]
    }

    zeile = treffer_dat[1, , drop = FALSE]
    datum_str = tryCatch(
      format(as.POSIXct(zeile[["created"]][1]), "%d.%m.%Y"),
      error = function(e) format(Sys.Date(), "%d.%m.%Y")
    )

    val_result = tryCatch(
      { ctq_validiere_labels(daten_ctq); list(ok = TRUE) },
      error = function(e) list(ok = FALSE, msg = e$message)
    )
    if (!val_result$ok)
      return(list(error = paste0("Label-Validierung fehlgeschlagen: ", val_result$msg)))

    sk_erg = lapply(names(ctq_subskalen), function(sk_name) {
      sk    = ctq_subskalen[[sk_name]]
      score = berechne_sk_score(sk_name, sk, zeile, daten_ctq)
      klass = if (!isTRUE(sk$sonderkodierung)) {
        ki = ctq_klassifikation[[sk_name]]
        ctq_klassifiziere(score, ki$grenzen, ki$labels)
      } else NA_character_
      list(
        name            = sk_name,
        label           = sk$label,
        score           = score,
        klass           = klass,
        n_items         = length(sk$items),
        sonderkodierung = isTRUE(sk$sonderkodierung)
      )
    })
    names(sk_erg) = names(ctq_subskalen)

    items_erg = lapply(1:28, function(nr) {
      var          = paste0("ctq_", sprintf("%02d", nr))
      original_col = daten_ctq[[var]]
      roh_wert     = as.numeric(zeile[[var]][1])
      sk_name      = item_zu_skala[[as.character(nr)]]
      list(
        nr         = nr,
        var        = var,
        item_text  = clean_item_label(attr(original_col, "label")),
        anker_text = ctq_get_anker(original_col, zeile[[var]]),
        rohwert    = roh_wert,
        sk_name    = sk_name,
        sk_label   = if (!is.null(sk_name)) ctq_subskalen[[sk_name]]$label else NA_character_
      )
    })

    list(
      chiffre      = chiffre,
      ausfuelldatum = datum_str,
      info_mehrere = info_mehrere,
      sk_erg       = sk_erg,
      items_erg    = items_erg,
      error        = NULL
    )
  })

  output$fehler_ui = renderUI({
    req(input$btn_suchen)
    d = ergebnis_r()
    if (!is.null(d$error)) div(class = "alert-fehler", d$error) else NULL
  })

  output$warnung_ui = renderUI({
    req(input$btn_suchen)
    d = ergebnis_r()
    if (!is.null(d$error) || is.null(d$info_mehrere)) return(NULL)
    div(class = "alert-warnung", d$info_mehrere)
  })

  output$ergebnis_ui = renderUI({
    req(input$btn_suchen)
    d = ergebnis_r()
    if (!is.null(d$error)) return(NULL)

    sk_karten = lapply(names(d$sk_erg), function(sk_name) {
      sk_res = d$sk_erg[[sk_name]]
      n_items = sk_res$n_items
      x_min = if (sk_res$sonderkodierung) 0 else n_items
      x_max = if (sk_res$sonderkodierung) 3 else n_items * 5
      grenzen = if (!sk_res$sonderkodierung && !is.null(ctq_klassifikation[[sk_name]]))
        ctq_klassifikation[[sk_name]]$grenzen else NULL
      plot_id = paste0("gauge_", sk_name)
      klass_badge_ui = if (!is.na(sk_res$klass)) {
        span(class = paste0("klass-badge ", klass_css_klasse(sk_res$klass)), sk_res$klass)
      } else NULL
      titel_gauge = if (sk_res$sonderkodierung)
        paste0(sk_res$label, " (Validitaetshinweis)")
      else sk_res$label

      div(class = "subskala-karte",
        div(class = "subskala-titel",
          sk_res$label,
          if (sk_res$sonderkodierung)
            tags$small(class = "item-01-hinweis", "(Validitaetshinweis, kein Belastungswert)")
        ),
        div(
          span(class = "subskala-score", sk_res$score),
          if (!sk_res$sonderkodierung)
            span(style = "color:#999; font-size:0.9rem; margin-left:4px;",
                 paste0("/ ", x_max))
          else
            span(style = "color:#999; font-size:0.9rem; margin-left:4px;", "/ 3"),
          klass_badge_ui
        ),
        plotOutput(plot_id, height = "130px")
      )
    })

    items_ui = lapply(names(ctq_subskalen), function(sk_name) {
      sk_label = ctq_subskalen[[sk_name]]$label
      items_dieser_sk = Filter(function(it) {
        !is.null(it$sk_name) && !is.na(it$sk_name) && it$sk_name == sk_name
      }, d$items_erg)
      item_zeilen = lapply(items_dieser_sk, function(it) {
        roh = it$rohwert
        roh_key = if (!is.na(roh) && roh >= 1 && roh <= 5)
          as.character(as.integer(roh)) else "1"
        anker_txt = if (!is.na(it$anker_text)) it$anker_text else paste0("Stufe ", roh)
        item_txt  = if (!is.na(it$item_text))  it$item_text  else paste0("Item ", it$nr)
        div(class = "item-zeile",
          div(class = "item-nr", paste0(it$nr, ".")),
          div(class = "item-text", item_txt),
          span(class = paste0("stufe-badge stufe-badge-", roh_key), anker_txt)
        )
      })
      tagList(
        div(class = "sk-gruppe-titel", sk_label),
        tagList(item_zeilen)
      )
    })

    item1_data = Filter(function(it) it$nr == 1, d$items_erg)
    item1_ui = if (length(item1_data) > 0) {
      it = item1_data[[1]]
      roh = it$rohwert
      roh_key = if (!is.na(roh) && roh >= 1 && roh <= 5)
        as.character(as.integer(roh)) else "1"
      anker_txt = if (!is.na(it$anker_text)) it$anker_text else paste0("Stufe ", roh)
      item_txt  = if (!is.na(it$item_text))  it$item_text  else "Item 1"
      tagList(
        div(class = "sk-gruppe-titel",
          "Item 1",
          tags$small(class = "item-01-hinweis", "(nicht in Subskalenbildung einbezogen)")
        ),
        div(class = "item-zeile",
          div(class = "item-nr", "1."),
          div(class = "item-text", item_txt),
          span(class = paste0("stufe-badge stufe-badge-", roh_key), anker_txt)
        )
      )
    } else NULL

    div(class = "abschnitt-karte",
      div(class = "abschnitt-titel", "CTQ – Childhood Trauma Questionnaire"),

      div(class = "meta-block",
        tags$strong("Chiffre: "), d$chiffre,
        tags$span("   |   ", style = "color:#ccc;"),
        tags$strong("Ausfuelldatum: "), d$ausfuelldatum
      ),

      tags$hr(),
      tags$h5("Subskalen-Scores"),

      fluidRow(
        column(6, sk_karten[[1]]),
        column(6, sk_karten[[2]])
      ),
      fluidRow(
        column(6, sk_karten[[3]]),
        column(6, sk_karten[[4]])
      ),
      fluidRow(
        column(6, offset = 3, sk_karten[[5]])
      ),

      tags$hr(),
      div(class = "disclaimer-box",
        tags$strong("Hinweis zur Klassifikation: "),
        paste0(
          "Die Einstufungen (None/Low/Moderate/Severe) entstammen ausschliesslich dem ",
          "amerikanischen CTQ-Manual (Bernstein & Fink, 1998). ",
          "Fuer die deutsche Fassung liegt keine eigene Norm vor. ",
          "Vollstaendiger Hinweis am Ende des Word-Exports."
        )
      ),

      tags$hr(),
      tags$h5("Einzelitems"),
      div(items_ui),
      item1_ui
    )
  })

  local({
    sk_names = names(ctq_subskalen)
    for (sk_name in sk_names) {
      local({
        sn = sk_name
        plot_id = paste0("gauge_", sn)
        output[[plot_id]] = renderPlot({
          req(input$btn_suchen)
          d = ergebnis_r()
          req(is.null(d$error))
          sk_res = d$sk_erg[[sn]]
          sk_def = ctq_subskalen[[sn]]
          n_items = length(sk_def$items)
          x_min = if (isTRUE(sk_def$sonderkodierung)) 0 else n_items
          x_max = if (isTRUE(sk_def$sonderkodierung)) 3 else n_items * 5
          grenzen = if (!isTRUE(sk_def$sonderkodierung))
            ctq_klassifikation[[sn]]$grenzen else NULL
          titel = if (isTRUE(sk_def$sonderkodierung))
            paste0(sk_def$label, " (Validitaetshinweis)") else sk_def$label
          make_ctq_gauge(sk_res$score, x_min, x_max, titel, grenzen)
        }, bg = "transparent")
      })
    }
  })

  output$download_word = downloadHandler(
    filename = function() {
      d = tryCatch(ergebnis_r(), error = function(e) NULL)
      chiffre_fn = if (is.list(d) && is.null(d$error) && nchar(d$chiffre) > 0)
        gsub("[^A-Za-z0-9]", "", d$chiffre) else "export"
      ausfuelldatum_fn = if (is.list(d) && is.null(d$error) && !is.null(d$ausfuelldatum))
        tryCatch(
          format(as.Date(d$ausfuelldatum, "%d.%m.%Y"), "%Y%m%d"),
          error = function(e) format(Sys.Date(), "%Y%m%d")
        )
      else
        format(Sys.Date(), "%Y%m%d")
      paste0("CTQ_", chiffre_fn, "_", ausfuelldatum_fn, ".docx")
    },
    content = function(file) {
      d        = tryCatch(ergebnis_r(), error = function(e) NULL)
      daten_ok = is.list(d) && is.null(d$error)
      if (!daten_ok) {
        doc = read_docx()
        doc = body_add_par(doc,
          "Kein Datensatz geladen. Bitte zuerst Chiffre eingeben und 'Auswerten' klicken.",
          style = "Normal")
        print(doc, target = file)
        return()
      }
      doc = tryCatch(
        erstelle_ctq_docx(d),
        error = function(e) {
          err_doc = read_docx()
          body_add_par(err_doc,
            paste0("Fehler beim Erstellen des Word-Dokuments: ", e$message),
            style = "Normal")
        }
      )
      print(doc, target = file)
    }
  )
}


# Start ####

shinyApp(ui, server)