# Praeambel ####

PFAD_DOWNLOAD_SKRIPT  = "../API/get_data_vds23.R"   # liefert: daten_vds23
PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R"       # liefert: pseudo
AKZENT_FARBE          = "#8B2635"

VDS23_DISCLAIMER = paste0(
  "Diese Auswertung ist ein Hilfsmittel fuer klinisches Fachpersonal und ersetzt ",
  "keine klinische Diagnose. Es liegen keine Normwerte oder Cutoffs fuer dieses ",
  "Instrument vor; die dargestellten Werte sind deskriptive Positionsangaben auf ",
  "der 0 bis 5 Skala, keine Vergleichswerte gegen eine Referenzstichprobe. Die ",
  "Interpretation obliegt der behandelnden Person."
)
VDS23_DISCLAIMER = gsub("fuer", "für", VDS23_DISCLAIMER, fixed = TRUE)

VDS23_STUFEN_TEXTE = c("nicht", "kaum", "etwas", "deutlich", "sehr", "extrem")

# 6 Stufen (0-5), gruen -> dunkelrot. Generische Klassennamen .stufe-badge-0 .. -5,
# siehe app_css weiter unten.
VDS23_BADGE_FARBEN = c(
  "0" = "#4CAF50",  # gruen
  "1" = "#E6EE9C",  # helles Gelbgruen
  "2" = "#F48FB1",  # helles Rosa
  "3" = "#EF5350",  # mittleres Rot
  "4" = "#C62828",  # kraeftiges Rot
  "5" = "#4A0000"   # dunkles Rot
)
VDS23_BADGE_TEXT_FARBEN = c(
  "0" = "white", "1" = "#333333", "2" = "#333333",
  "3" = "white", "4" = "white",   "5" = "white"
)

# Item-Faktor-Zuordnung, fest aus dem Testmanual uebernommen (nicht aus dem
# Itemtext neu abgeleitet). 11 Items sind doppelt zugeordnet, 5 Items keinem
# Faktor (21, 43, 54, 55, 62).
vds23_faktoren = list(
  "1" = list(
    name = "Beziehung nimmt Schaden",
    items = c(3, 6, 7, 11, 12, 13, 14, 15, 16, 17, 18, 19, 22, 29, 30, 32, 37, 38, 44, 47, 48, 50, 51, 58, 59)
  ),
  "2" = list(
    name = "Abgrenzung gelingt nicht",
    items = c(17, 18, 23, 24, 25, 26, 40, 41, 42, 49, 52, 53, 60)
  ),
  "3" = list(
    name = "Bedürfnis-Frustration",
    items = c(33, 35, 39, 45, 51, 53, 56, 57, 58, 61)
  ),
  "4" = list(
    name = "Abgelehnt werden",
    items = c(2, 4, 5, 10, 15, 27, 28, 35, 38)
  ),
  "5" = list(
    name = "Einfluss-Verlust",
    items = c(8, 9, 31, 46, 49, 63)
  ),
  "6" = list(
    name = "Unterlegen sein",
    items = c(1, 20, 25, 33, 34, 36)
  )
)

# Kontrollsumme: 25 + 13 + 10 + 9 + 6 + 6 = 69 Zuordnungen bei 63 Items.
# Bei Abweichung sofort abbrechen statt still weiterzurechnen, das wuerde
# einen Copy-Paste-Fehler in der Struktur oben sonst verschleiern.
.vds23_kontrollsumme = sum(sapply(vds23_faktoren, function(f) length(f$items)))
if (.vds23_kontrollsumme != 69) {
  stop(
    "VDS23: Kontrollsumme der Item-Faktor-Zuordnung ist ", .vds23_kontrollsumme,
    ", erwartet 69. Bitte 'vds23_faktoren' pruefen (Copy-Paste-Fehler?)."
  )
}

VDS23_OHNE_FAKTOR = c(21, 43, 54, 55, 62)

vds23_itemtexte = c(
  "01" = "Ich allein bin",
  "02" = "Ich mit wenig vertrauten Personen zu tun habe",
  "03" = "Ich mit einer wichtigen Bezugsperson zu tun habe",
  "04" = "Ich nicht erkennen kann, worauf es ankommt",
  "05" = "Andere darauf achten, was ich wie tue",
  "06" = "Andere etwas von mir erwarten, das ich nicht kann",
  "07" = "Andere etwas von mir erwarten, das ich nicht will",
  "08" = "Ich Nein sagen müsste",
  "09" = "Ich Forderungen stellen müsste",
  "10" = "Ich Kontakt mit jemandem aufnehmen müsste, jemand ansprechen müsste",
  "11" = "Andere mich links liegen lassen",
  "12" = "Andere mich nicht akzeptieren, nicht aufnehmen",
  "13" = "Andere gegen mich vorgehen",
  "14" = "Andere mir etwas vorwerfen, mich kritisieren",
  "15" = "Andere mit mir konkurrieren, rivalisieren",
  "16" = "Andere kein Verständnis für mich haben",
  "17" = "Andere mich ausnutzen wollen",
  "18" = "Andere mich übervorteilen, betrügen wollen",
  "19" = "Andere nicht einsehen wollen, dass ich Recht habe",
  "20" = "Andere sich mir einfach entziehen",
  "21" = "Sich andere mit Ausreden rauswinden",
  "22" = "Andere mich beschämen (die mir peinlich sind)",
  "23" = "Ich meine Pflicht nicht erfülle, erfüllen kann",
  "24" = "Ich nicht erreiche, was ich will",
  "25" = "Mich in meinen Kräften oder Fähigkeiten überfordern",
  "26" = "Ich versage",
  "27" = "Ich im Mittelpunkt stehe",
  "28" = "Ich einen Fehler zugeben müsste",
  "29" = "Ich bei etwas Unrechtem ertappt werden",
  "30" = "Ich unangenehm auffalle",
  "31" = "Die Harmonie gestört ist",
  "32" = "Ich einen großen Verlust erleide",
  "33" = "Ich etwas hergeben muss",
  "34" = "Andere besser sind als ich",
  "35" = "Ich eine schwierige Entscheidung treffen sollte",
  "36" = "Ich tun muss, was andere mir anordnen",
  "37" = "Ich es nicht schaffe, attraktiv genug zu sein",
  "38" = "Mir meine Gefühle einen Strich durch die Rechnung machen",
  "39" = "Sehr intim sind",
  "40" = "Andere meine Grenzen überschreiten, übergriffig werden",
  "41" = "Ich eingeengt und unfrei bin",
  "42" = "Andere mir zu nahe kommen",
  "43" = "Ich nicht bekomme, was ich brauche, so viel wie ich brauche",
  "44" = "Ich im Stich gelassen werde",
  "45" = "Meine Forderungen abgelehnt werden",
  "46" = "Sich andere nicht durch mich beeinflussen lassen",
  "47" = "Es mir nicht gelingt, die Kontrolle über mich zu bewahren",
  "48" = "Meine Liebesbeziehung in Gefahr ist",
  "49" = "Umgangsregeln nicht eingehalten werden",
  "50" = "Meine Gefühle verletzt werden",
  "51" = "Ich nicht gebraucht werde",
  "52" = "Meine Meinungsfreiheit eingeschränkt wird",
  "53" = "Meine Sicherheit und Existenz bedroht ist",
  "54" = "Mein Glaube angefochten wird",
  "55" = "Gefahr besteht, meine Familie zu verlieren",
  "56" = "Ich gehindert werde, meinen Genüssen nachzugehen",
  "57" = "Ich wichtige innere Gebote nicht eingehalten habe",
  "58" = "Ich wichtige Verbote überschritten habe",
  "59" = "Ich in einem großen Konflikt stehe",
  "60" = "Die ewig wiederkehrenden Probleme mit einer wichtigen Bezugsperson auftreten",
  "61" = "Ein sexuelles Problem auftritt",
  "62" = "Meine Wünsche erfüllt, meine Bedürfnisse befriedigt werden",
  "63" = "Jemand gut zu mir ist"
)

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


# Infrastruktur ####

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)


# Helper ####

# OFFENER PUNKT FUER ERSTEN TESTLAUF (siehe Projekt-Notizen, Abschnitt 16.1):
# Ob formr mc-Felder beim Export den Choice-Text oder den 1-basierten
# Choice-Index liefert, ist fuer diese Instanz nicht verifiziert. Diese
# Funktion deckt beide Faelle robust ueber das labels-Attribut der
# ORIGINAL-Spalte ab (nicht ueber hartkodierte Zahlenwerte) und liefert bei
# unbekanntem Format NA statt einer geratenen Zahl.
vds23_wert_inhaltlich = function(rohwert, labels_attr) {
  mapping_text = c(
    "nicht" = 0L, "kaum" = 1L, "etwas" = 2L,
    "deutlich" = 3L, "sehr" = 4L, "extrem" = 5L
  )

  if (is.null(rohwert) || length(rohwert) == 0 || is.na(rohwert[1])) {
    return(list(wert = NA_integer_, status = "na"))
  }

  roh_chr   = trimws(as.character(rohwert[1]))
  roh_lower = tolower(roh_chr)
  roh_num   = suppressWarnings(as.numeric(roh_chr))

  # Fall A: Rohwert ist bereits direkt einer der 6 bekannten Choice-Texte.
  if (roh_lower %in% names(mapping_text)) {
    return(list(wert = unname(mapping_text[[roh_lower]]), status = "text_direkt"))
  }

  if (!is.null(labels_attr) && length(labels_attr) > 0) {
    lbl_namen = tolower(trimws(names(labels_attr)))
    lbl_werte = as.vector(labels_attr)

    pos = if (!is.na(roh_num)) which(lbl_werte == roh_num) else which(lbl_namen == roh_lower)

    if (length(pos) > 0) {
      choice_text = lbl_namen[pos[1]]
      # Fall B: Rohwert entspricht (ueber labels) einem bekannten Choice-Text.
      if (choice_text %in% names(mapping_text)) {
        return(list(wert = unname(mapping_text[[choice_text]]), status = "labels_text"))
      }
      # Fall C: Choice-Text nicht erkannt, aber die sortierte Position des
      # Rohwerts unter allen labels-Werten ergibt einen 1-basierten Index 1-6.
      lbl_sortiert = sort(lbl_werte)
      idx_pos = which(lbl_sortiert == lbl_werte[pos[1]])
      if (length(idx_pos) > 0 && idx_pos[1] >= 1 && idx_pos[1] <= 6) {
        return(list(wert = as.integer(idx_pos[1] - 1L), status = "labels_index"))
      }
    }
  }

  # Fall D: kein (nutzbares) labels-Attribut, Rohwert ist eine Zahl 1-6 ->
  # 1-basierter Index wird angenommen.
  if (!is.na(roh_num) && roh_num >= 1 && roh_num <= 6 && roh_num == round(roh_num)) {
    return(list(wert = as.integer(roh_num - 1L), status = "index_fallback"))
  }

  # Fall E: Rohwert ist bereits eine Zahl 0-5 (schon inhaltlich kodiert).
  if (!is.na(roh_num) && roh_num >= 0 && roh_num <= 5 && roh_num == round(roh_num)) {
    return(list(wert = as.integer(roh_num), status = "bereits_inhaltlich"))
  }

  list(wert = NA_integer_, status = "unbekannt")
}

# Faktor-Score = arithmetisches Mittel der zugeordneten Item-Rohwerte
# (0-5), kein Reverse-Coding. na.rm = TRUE fuer den defensiven Fall
# einzelner fehlender Werte trotz Pflichtfeld-Annahme.
vds23_faktor_score = function(werte_vektor, item_nummern) {
  werte       = werte_vektor[item_nummern]
  n_vorhanden = sum(!is.na(werte))
  n_gesamt    = length(werte)
  score       = if (n_vorhanden > 0) mean(werte, na.rm = TRUE) else NA_real_
  list(score = score, n_vorhanden = n_vorhanden, n_gesamt = n_gesamt)
}

# Choice-Format lt. vds23.xlsx fuer vds23_top5_auswahl: "N. Itemtext" (z.B.
# "5. Andere darauf achten, was ich wie tue"). Trennzeichen zwischen mehreren
# Ausgewaehlten ist in dieser formr-Instanz weiterhin nicht live verifiziert,
# es wird defensiv an ",", ";" und "|" gesplittet. Der Itemtext wird pro
# Fragment IMMER aus der festen vds23_itemtexte-Tabelle nachgeschlagen (ueber
# die per Regex gezogene fuehrende Nummer), nicht aus dem Fragment selbst
# uebernommen - das liefert auch dann den vollen Text, wenn formr ein
# Fragment nur als blosse Nummer ("5" statt "5. Andere darauf achten ...")
# exportiert. Nur wenn weder eine fuehrende Nummer noch ein exakter
# Text-Treffer gefunden wird, bleibt es beim unveraenderten Rohtext statt
# einer Ratewert-Zuordnung.
vds23_parse_top5 = function(rohtext, itemtexte) {
  leer_ergebnis = data.frame(
    nummer = integer(0), text = character(0), roh = character(0),
    stringsAsFactors = FALSE
  )
  if (is.null(rohtext) || length(rohtext) == 0 || is.na(rohtext[1]) ||
      trimws(as.character(rohtext[1])) == "") {
    return(leer_ergebnis)
  }

  txt        = trimws(as.character(rohtext[1]))
  fragmente  = trimws(strsplit(txt, "[,;|]")[[1]])
  fragmente  = fragmente[nchar(fragmente) > 0]
  if (length(fragmente) == 0) return(leer_ergebnis)

  itemtexte_lower = tolower(trimws(itemtexte))

  zeilen = lapply(fragmente, function(frag) {
    frag_trim = trimws(frag)

    # Fall A: Fragment beginnt mit der Itemnummer (mit oder ohne Text
    # dahinter) - Text immer aus der Itemtexte-Tabelle nachschlagen.
    nr_match = regmatches(frag_trim, regexpr("^[0-9]{1,2}", frag_trim))
    if (length(nr_match) > 0 && nchar(nr_match) > 0) {
      nr  = as.integer(nr_match)
      key = sprintf("%02d", nr)
      if (nr >= 1 && nr <= 63 && key %in% names(itemtexte)) {
        return(data.frame(nummer = nr, text = unname(itemtexte[[key]]), roh = frag,
                           stringsAsFactors = FALSE))
      }
    }

    # Fall B: Fragment ist der vollstaendige Itemtext ohne fuehrende Nummer.
    frag_lower = tolower(frag_trim)
    treffer    = which(itemtexte_lower == frag_lower)
    if (length(treffer) == 1) {
      return(data.frame(nummer = as.integer(names(itemtexte)[treffer]),
                         text = unname(itemtexte[treffer]), roh = frag,
                         stringsAsFactors = FALSE))
    }

    data.frame(nummer = NA_integer_, text = NA_character_, roh = frag,
               stringsAsFactors = FALSE)
  })
  do.call(rbind, zeilen)
}

vds23_badge_klasse = function(wert) {
  if (is.na(wert)) return("stufe-badge-na")
  paste0("stufe-badge-", max(0L, min(5L, as.integer(wert))))
}

vds23_badge_text = function(wert) {
  if (is.na(wert)) return("k. A.")
  VDS23_STUFEN_TEXTE[max(0L, min(5L, as.integer(wert))) + 1L]
}

# Neutrale 0-5-Achse ohne Farbzonen (kein Cutoff dokumentiert), nur eine
# Markierung an der Position des Faktor-Mittelwerts.
vds23_achse_plot = function(score) {
  ggplot() +
    geom_segment(aes(x = 0, xend = 5, y = 0, yend = 0), color = "#BDBDBD", linewidth = 1.2) +
    geom_point(aes(x = 0:5, y = 0), color = "#9E9E9E", size = 2) +
    geom_segment(aes(x = score, xend = score, y = -0.35, yend = 0.35),
                 color = AKZENT_FARBE, linewidth = 2.2) +
    geom_label(aes(x = score, y = 0.8, label = format(round(score, 1), nsmall = 1)),
               fill = AKZENT_FARBE, color = "white", fontface = "bold",
               linewidth = 0, size = 4) +
    scale_x_continuous(limits = c(-0.3, 5.3), breaks = 0:5) +
    scale_y_continuous(limits = c(-0.6, 1.15)) +
    theme_minimal(base_size = 12) +
    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(),
      axis.title.x       = element_blank(),
      plot.margin        = margin(t = 5, r = 10, b = 5, l = 10)
    )
}


# UI ####

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; }
.faktor-score-block { display: flex; align-items: baseline; gap: 14px; margin-bottom: 6px; }
.faktor-score-zahl  { font-size: 2.0rem; font-weight: 800; color: #8B2635; }
.faktor-score-label { color: #555; font-size: 0.9em; }
.faktor-missing-hinweis { font-size: 0.85em; color: #E65100; margin-bottom: 8px; }
.item-zeile {
  display: flex; align-items: flex-start; gap: 10px;
  padding: 7px 0; border-bottom: 1px solid #F0F0F0;
}
.item-zeile:last-child { border-bottom: none; }
.item-nr   { font-weight: 600; color: #8B2635; min-width: 26px; flex-shrink: 0; }
.item-text-block { flex: 1; }
.item-text { color: #333; font-size: 0.92em; }
.item-beispiel {
  color: #777; font-size: 0.86em; font-style: italic; margin-top: 2px;
}
.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-0 { background-color: #4CAF50; color: white; }
.stufe-badge-1 { background-color: #E6EE9C; color: #333333; }
.stufe-badge-2 { background-color: #F48FB1; color: #333333; }
.stufe-badge-3 { background-color: #EF5350; color: white; }
.stufe-badge-4 { background-color: #C62828; color: white; }
.stufe-badge-5 { background-color: #4A0000; color: white; }
.stufe-badge-na { background-color: #E0E0E0; color: #555555; }
.ohne-faktor-hinweis { font-size: 0.85em; color: #777; font-style: italic; margin-bottom: 10px; }
.top5-liste { margin: 6px 0 0 0; padding-left: 20px; }
.top5-eintrag { padding: 3px 0; color: #333; font-size: 0.94em; }
.freitext-block { margin-bottom: 14px; }
.freitext-frage { font-weight: 600; color: #8B2635; font-size: 0.95em; margin-bottom: 3px; }
.freitext-antwort { color: #333; font-size: 0.93em; white-space: pre-wrap; line-height: 1.5; }
.qualitativ-hinweis {
  font-size: 0.82em; color: #777; font-style: italic;
  margin-bottom: 12px; border-bottom: 1px dashed #ddd; padding-bottom: 8px;
}
.disclaimer-zeile {
  font-size: 0.82em; color: #777; font-style: italic;
  margin-top: 10px; border-top: 1px solid rgba(0,0,0,.1); padding-top: 8px;
}
"

app_css = gsub("#8B2635", AKZENT_FARBE, app_css, fixed = TRUE)

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

  div(class = "app-header",
    tags$h2("VDS23 – Situationsanalyse"),
    tags$p("63 Items zu unangenehmen Situationen, 6 Faktoren, keine Normwerte")
  ),

  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_vds23_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_beispiel   = fp_text(font.size = 9.5, italic = TRUE, color = "#777777")
  fp_disclaimer = fp_text(font.size = 9, italic = TRUE, color = "#777777")

  doc = body_add_fpar(doc, fpar(ftext("VDS23, Situationsanalyse", fp_titel)))
  doc = body_add_fpar(doc, fpar(
    ftext("Chiffre: ",  fp_label),
    ftext(erg$chiffre,  fp_normal),
    ftext("   Ausfülldatum: ", 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"))
    ))
  }
  if (!is.null(erg$kodierwarnung)) {
    doc = body_add_fpar(doc, fpar(
      ftext(erg$kodierwarnung, fp_text(font.size = 10, italic = TRUE, color = "#BF360C"))
    ))
  }
  doc = body_add_par(doc, "", style = "Normal")

  for (fe in erg$faktor_ergebnisse) {
    doc = body_add_fpar(doc, fpar(ftext(fe$name, fp_abschnitt)))

    score_txt = if (is.na(fe$score)) "keine auswertbaren Items" else
      paste0(format(round(fe$score, 1), nsmall = 1), " auf der Skala 0 bis 5")
    doc = body_add_fpar(doc, fpar(
      ftext("Faktor-Mittelwert: ", fp_label),
      ftext(score_txt, fp_normal)
    ))
    if (!is.na(fe$score) && fe$n_vorhanden < fe$n_gesamt) {
      doc = body_add_fpar(doc, fpar(ftext(
        paste0("Faktor-Score basiert auf ", fe$n_vorhanden, " von ", fe$n_gesamt, " Items."),
        fp_text(font.size = 9.5, italic = TRUE, color = "#BF360C")
      )))
    }

    for (r in seq_len(nrow(fe$items))) {
      zeile     = fe$items[r, ]
      badge_key = if (is.na(zeile$wert)) NA_character_ else
        as.character(max(0L, min(5L, as.integer(zeile$wert))))
      if (is.na(badge_key)) {
        fp_badge = fp_text(color = "#555555", bold = TRUE, shading.color = "#E0E0E0", font.size = 10)
        badge_txt = "k. A."
      } else {
        fp_badge = fp_text(
          color = VDS23_BADGE_TEXT_FARBEN[[badge_key]], bold = TRUE,
          shading.color = VDS23_BADGE_FARBEN[[badge_key]], font.size = 10
        )
        badge_txt = VDS23_STUFEN_TEXTE[as.integer(badge_key) + 1L]
      }
      doc = body_add_fpar(doc, fpar(
        ftext(paste0(zeile$nummer, ". ", zeile$text, "  "), fp_normal),
        ftext(paste0(" ", badge_txt, " "), fp_badge)
      ))
      if (!is.na(zeile$beispiel)) {
        doc = body_add_fpar(doc, fpar(ftext(paste0("Beispiel: ", zeile$beispiel), fp_beispiel)))
      }
    }
    doc = body_add_par(doc, "", style = "Normal")
  }

  if (nrow(erg$ohne_faktor) > 0) {
    doc = body_add_fpar(doc, fpar(ftext(
      "Weitere erhobene Situationen (keinem Faktor zugeordnet)", fp_abschnitt)))
    for (r in seq_len(nrow(erg$ohne_faktor))) {
      zeile     = erg$ohne_faktor[r, ]
      badge_key = if (is.na(zeile$wert)) NA_character_ else
        as.character(max(0L, min(5L, as.integer(zeile$wert))))
      if (is.na(badge_key)) {
        fp_badge = fp_text(color = "#555555", bold = TRUE, shading.color = "#E0E0E0", font.size = 10)
        badge_txt = "k. A."
      } else {
        fp_badge = fp_text(
          color = VDS23_BADGE_TEXT_FARBEN[[badge_key]], bold = TRUE,
          shading.color = VDS23_BADGE_FARBEN[[badge_key]], font.size = 10
        )
        badge_txt = VDS23_STUFEN_TEXTE[as.integer(badge_key) + 1L]
      }
      doc = body_add_fpar(doc, fpar(
        ftext(paste0(zeile$nummer, ". ", zeile$text, "  "), fp_normal),
        ftext(paste0(" ", badge_txt, " "), fp_badge)
      ))
      if (!is.na(zeile$beispiel)) {
        doc = body_add_fpar(doc, fpar(ftext(paste0("Beispiel: ", zeile$beispiel), fp_beispiel)))
      }
    }
    doc = body_add_par(doc, "", style = "Normal")
  }

  doc = body_add_break(doc)
  doc = body_add_fpar(doc, fpar(ftext("Top5-Auswahl und Reflexionsfragen", fp_abschnitt)))
  doc = body_add_fpar(doc, fpar(ftext(
    "Qualitative Zusatzinformation, kein Zahlenwert.",
    fp_text(font.size = 9.5, italic = TRUE, color = "#777777")
  )))
  doc = body_add_par(doc, "", style = "Normal")

  doc = body_add_fpar(doc, fpar(ftext("Ausgewählte unangenehmste Situationen", fp_label)))
  if (nrow(erg$top5) == 0) {
    doc = body_add_fpar(doc, fpar(ftext("Keine Angabe.", fp_normal)))
  } else {
    for (r in seq_len(nrow(erg$top5))) {
      zeile = erg$top5[r, ]
      txt = if (!is.na(zeile$nummer)) paste0(zeile$nummer, ". ", zeile$text) else zeile$roh
      doc = body_add_fpar(doc, fpar(ftext(paste0("• ", txt), fp_normal)))
    }
  }
  doc = body_add_par(doc, "", style = "Normal")

  for (rf in erg$reflexionen) {
    if (is.na(rf$antwort)) next
    doc = body_add_fpar(doc, fpar(ftext(rf$frage, fp_label)))
    doc = body_add_fpar(doc, fpar(ftext(rf$antwort, fp_normal)))
    doc = body_add_par(doc, "", style = "Normal")
  }

  doc = body_add_fpar(doc, fpar(ftext(VDS23_DISCLAIMER, fp_disclaimer)))

  doc
}


# Server ####

server = function(input, output, session) {

  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 Chiffre oder Pseudonym eingeben."))
    }
    if (nchar(trimws(input$pseudonym)) == 0 && !grepl("^[A-Z][0-9]{6}$", chiffre)) {
      return(list(error = paste0(
        "Ungültige Chiffre. Erwartet: ein Großbuchstabe + 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_treffer = pseudo[pseudo$pseudonym == trimws(input$pseudonym), ]
        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_vds23", envir = .GlobalEnv)) {
      return(list(error = paste0(
        "Objekt 'daten_vds23' nach dem Sourcen nicht gefunden. Bitte Download-Skript prüfen.")))
    }
    if (!exists("pseudo", envir = .GlobalEnv)) {
      return(list(error = paste0(
        "Objekt 'pseudo' nach dem Sourcen nicht gefunden. Bitte Pseudonym-Skript prüfen.")))
    }

    daten     = get("daten_vds23", 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[daten$session %in% alle_session_ids, ]
    if (nrow(treffer_dat) == 0) {
      return(list(error = paste0(
        "Kein VDS23-Datensatz für Chiffre '", chiffre, "' gefunden. ",
        "(", length(alle_session_ids), " Pseudonym(e) geprüft)")))
    }

    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 Ausfüllungen gefunden (", n, " Einträge). ",
        "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")
    )

    # --- 63 Item-Werte + Beispieltexte ---
    werte_inhaltlich = integer(63)
    werte_status      = character(63)
    beispiel_texte    = character(63)

    for (i in seq_len(63)) {
      var          = paste0("vds23_", sprintf("%02d", i))
      var_beispiel = paste0(var, "_beispiel")

      roh      = if (var %in% names(zeile)) zeile[[var]][1] else NA
      lbl_attr = if (var %in% names(daten)) attr(daten[[var]], "labels") else NULL
      konv     = vds23_wert_inhaltlich(roh, lbl_attr)
      werte_inhaltlich[i] = konv$wert
      werte_status[i]     = konv$status

      beispiel_roh = if (var_beispiel %in% names(zeile)) zeile[[var_beispiel]][1] else NA
      beispiel_texte[i] = if (!is.na(beispiel_roh) &&
                               trimws(as.character(beispiel_roh)) != "") {
        trimws(as.character(beispiel_roh))
      } else {
        NA_character_
      }
    }

    # Debug-Ausgabe je Auswertung, damit die Umrechnung beim ersten echten
    # Testlauf mit formr-Daten gegengeprueft werden kann (Item 1 als Beispiel).
    message(
      "VDS23-DEBUG: Rohwert vds23_01 = '",
      if ("vds23_01" %in% names(zeile)) as.character(zeile[["vds23_01"]][1]) else "NA",
      "' -> inhaltlicher Wert = ", werte_inhaltlich[1],
      " (Status: ", werte_status[1], ")"
    )

    kodierwarnung = NULL
    n_unbekannt = sum(werte_status == "unbekannt")
    if (n_unbekannt > 0) {
      kodierwarnung = paste0(
        "Warnung: Die Kodierung konnte für ", n_unbekannt,
        " Item(s) nicht eindeutig bestimmt werden. Die betroffenen Items ",
        "werden als 'k. A.' angezeigt statt eines möglicherweise falschen Werts."
      )
    }

    faktor_ergebnisse = lapply(names(vds23_faktoren), function(fid) {
      fak = vds23_faktoren[[fid]]
      fs  = vds23_faktor_score(werte_inhaltlich, fak$items)
      items_df = data.frame(
        nummer   = fak$items,
        text     = unname(vds23_itemtexte[sprintf("%02d", fak$items)]),
        wert     = werte_inhaltlich[fak$items],
        beispiel = beispiel_texte[fak$items],
        stringsAsFactors = FALSE
      )
      list(id = fid, name = fak$name, score = fs$score,
           n_vorhanden = fs$n_vorhanden, n_gesamt = fs$n_gesamt, items = items_df)
    })

    ohne_faktor = data.frame(
      nummer   = VDS23_OHNE_FAKTOR,
      text     = unname(vds23_itemtexte[sprintf("%02d", VDS23_OHNE_FAKTOR)]),
      wert     = werte_inhaltlich[VDS23_OHNE_FAKTOR],
      beispiel = beispiel_texte[VDS23_OHNE_FAKTOR],
      stringsAsFactors = FALSE
    )

    top5_roh = if ("vds23_top5_auswahl" %in% names(zeile)) zeile[["vds23_top5_auswahl"]][1] else NA
    top5     = vds23_parse_top5(top5_roh, vds23_itemtexte)

    reflexion_felder = list(
      list(spalte = "vds23_reflexion_bezugspersonen_heute",
           frage  = "Heute: häufigste Verhaltensweisen der Bezugspersonen"),
      list(spalte = "vds23_reflexion_eigene_reaktion",
           frage  = "Eigene Reaktion darauf"),
      list(spalte = "vds23_reflexion_situationsausgang",
           frage  = "Ausgang der Situationen"),
      list(spalte = "vds23_reflexion_mutter_kindheit",
           frage  = "Kindheit, Mutter"),
      list(spalte = "vds23_reflexion_vater_kindheit",
           frage  = "Kindheit, Vater")
    )
    reflexionen = lapply(reflexion_felder, function(f) {
      roh = if (f$spalte %in% names(zeile)) zeile[[f$spalte]][1] else NA
      antwort = if (!is.na(roh) && trimws(as.character(roh)) != "") {
        trimws(as.character(roh))
      } else {
        NA_character_
      }
      list(frage = f$frage, antwort = antwort)
    })

    list(
      chiffre            = chiffre,
      ausfuelldatum      = datum_str,
      info_mehrere       = info_mehrere,
      kodierwarnung      = kodierwarnung,
      faktor_ergebnisse  = faktor_ergebnisse,
      ohne_faktor        = ohne_faktor,
      top5               = top5,
      reflexionen        = reflexionen,
      error              = NULL
    )
  })

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

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

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

    faktor_karten = lapply(seq_along(d$faktor_ergebnisse), function(idx) {
      fe = d$faktor_ergebnisse[[idx]]

      items_ui = lapply(seq_len(nrow(fe$items)), function(r) {
        zeile = fe$items[r, ]
        div(class = "item-zeile",
          div(class = "item-nr", paste0(zeile$nummer, ".")),
          div(class = "item-text-block",
            div(class = "item-text", zeile$text),
            if (!is.na(zeile$beispiel))
              div(class = "item-beispiel", paste0("Beispiel: ", zeile$beispiel))
          ),
          span(class = paste0("stufe-badge ", vds23_badge_klasse(zeile$wert)),
               vds23_badge_text(zeile$wert))
        )
      })

      div(class = "abschnitt-karte",
        div(class = "abschnitt-titel", paste0("Faktor ", fe$id, ": ", fe$name)),
        div(class = "faktor-score-block",
          div(class = "faktor-score-zahl",
              if (is.na(fe$score)) "–" else format(round(fe$score, 1), nsmall = 1)),
          div(class = "faktor-score-label", "Mittelwert auf der Skala 0 bis 5")
        ),
        if (!is.na(fe$score) && fe$n_vorhanden < fe$n_gesamt)
          div(class = "faktor-missing-hinweis",
              paste0("Faktor-Score basiert auf ", fe$n_vorhanden, " von ", fe$n_gesamt, " Items.")),
        plotOutput(paste0("gauge_", idx), height = "110px"),
        tags$hr(),
        div(items_ui)
      )
    })

    ohne_faktor_karte = div(class = "abschnitt-karte",
      div(class = "abschnitt-titel", "Weitere erhobene Situationen (keinem Faktor zugeordnet)"),
      div(class = "ohne-faktor-hinweis",
          "Diese Items fließen in keinen Faktor-Score ein."),
      div(lapply(seq_len(nrow(d$ohne_faktor)), function(r) {
        zeile = d$ohne_faktor[r, ]
        div(class = "item-zeile",
          div(class = "item-nr", paste0(zeile$nummer, ".")),
          div(class = "item-text-block",
            div(class = "item-text", zeile$text),
            if (!is.na(zeile$beispiel))
              div(class = "item-beispiel", paste0("Beispiel: ", zeile$beispiel))
          ),
          span(class = paste0("stufe-badge ", vds23_badge_klasse(zeile$wert)),
               vds23_badge_text(zeile$wert))
        )
      }))
    )

    top5_ui = if (nrow(d$top5) == 0) {
      div(style = "color:#777; font-style:italic;", "Keine Angabe.")
    } else {
      tags$ul(class = "top5-liste",
        lapply(seq_len(nrow(d$top5)), function(r) {
          zeile = d$top5[r, ]
          txt = if (!is.na(zeile$nummer)) paste0(zeile$nummer, ". ", zeile$text) else zeile$roh
          tags$li(class = "top5-eintrag", txt)
        })
      )
    }

    reflexionen_vorhanden = Filter(function(rf) !is.na(rf$antwort), d$reflexionen)
    reflexionen_ui = if (length(reflexionen_vorhanden) == 0) {
      div(style = "color:#777; font-style:italic;", "Keine Angaben zu den Reflexionsfragen vorhanden.")
    } else {
      lapply(reflexionen_vorhanden, function(rf) {
        div(class = "freitext-block",
          div(class = "freitext-frage", rf$frage),
          div(class = "freitext-antwort", rf$antwort)
        )
      })
    }

    qualitativ_karte = div(class = "abschnitt-karte",
      div(class = "abschnitt-titel", "Top5-Auswahl und Reflexionsfragen"),
      div(class = "qualitativ-hinweis",
          "Qualitative Zusatzinformation, kein Zahlenwert."),
      tags$h5("Ausgewählte unangenehmste Situationen"),
      top5_ui,
      tags$hr(),
      reflexionen_ui
    )

    tagList(
      div(class = "abschnitt-karte",
        div(class = "meta-block",
          tags$strong("Chiffre: "), d$chiffre,
          tags$span("   |   ", style = "color:#ccc;"),
          tags$strong("Ausfülldatum: "), d$ausfuelldatum
        )
      ),
      faktor_karten,
      ohne_faktor_karte,
      qualitativ_karte,
      div(class = "disclaimer-zeile", VDS23_DISCLAIMER)
    )
  })

  lapply(1:6, function(idx) {
    output[[paste0("gauge_", idx)]] = renderPlot({
      req(input$btn_suchen)
      d = ergebnis_r()
      req(is.null(d$error))
      fe = d$faktor_ergebnisse[[idx]]
      if (is.na(fe$score)) return(NULL)
      vds23_achse_plot(fe$score)
    }, bg = "transparent")
  })

  output$download_word = downloadHandler(
    filename = function() {
      d = tryCatch(ergebnis_r(), error = function(e) NULL)
      chiffre_esc = 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("VDS23_", chiffre_esc, "_", 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 oder Pseudonym eingeben und 'Auswerten' klicken.",
          style = "Normal")
        print(doc, target = file)
        return()
      }
      doc = tryCatch(
        erstelle_vds23_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)