# Präambel ####

AKZENT_FARBE = "#8B2635"

PFAD_DOWNLOAD_SKRIPT  = "../API/get_data_csas_fp.R"
PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R"

CSAS_FP_ERGAENZUNGSHINWEIS = paste0(
  "Die Fremdbeurteilung durch den Partner (CSAS-FP) ist laut Testmanual als Ergaenzung ",
  "zum diagnostischen Urteil zu verstehen und sollte nur zusammen mit der Selbstbeurteilung ",
  "(CSAS-E) der betroffenen Person eingesetzt werden, nicht als eigenstaendiges Diagnoseinstrument. ",
  "Bei deutlicher Abweichung zwischen Selbst- und Fremdbericht sollten weiterfuehrende ",
  "diagnostische Informationen eingeholt werden."
)

CSAS_FP_DISCLAIMER = paste0(
  "Diese Auswertung ist ein Hilfsmittel fuer klinisches Fachpersonal und ersetzt ",
  "keine klinische Diagnose. Die Interpretation obliegt der behandelnden Person. ",
  "Der Cutoff von 5 erfuellten DSM-5-Kriterien ist laut Testmanual eine pragmatische, ",
  "bewusst konservative Konvention und keine validierte diagnostische Schwelle. ",
  "Diese Fremdbeurteilung ersetzt keine Selbstbeurteilung (CSAS-E)."
)

CSAS_FP_KEINE_NORMWERTE_HINWEIS = paste0(
  "Fuer die Fremdbeurteilungsversion CSAS-FP liegen laut Testmanual keine Normwerte vor."
)

# Recoding-Tabelle der 18 Kernitems (Choice-Text nach Markdown-Bereinigung -> Wert 0-3).
CSAS_FP_CHOICE_TEXTE = c("stimmt nicht", "stimmt kaum", "stimmt eher", "stimmt genau")

# Fuer die Geraete-Matrix-Items ist nur relevant, ob Choice 1 ("nie") vorliegt.
CSAS_FP_GERAET_NIE_TEXT = c("nie")

CSAS_FP_GERAET_FELDER = c(
  "csas_fp_geraet_pc", "csas_fp_geraet_konsole",
  "csas_fp_geraet_tragbar", "csas_fp_geraet_handy"
)
CSAS_FP_GERAET_LABELS = c(
  csas_fp_geraet_pc       = "PC",
  csas_fp_geraet_konsole  = "Konsole",
  csas_fp_geraet_tragbar  = "Tragbares Geraet",
  csas_fp_geraet_handy    = "Handy/Smartphone"
)

# DSM-5-Kriterien: 9 Kriterien, je 2 zugehoerige Items (identische Zuordnung wie CSAS-E).
CSAS_FP_KRITERIEN = list(
  list(name = "Gedankliche Vereinnahmung",                    items = c(1, 8)),
  list(name = "Entzugserscheinungen",                         items = c(5, 7)),
  list(name = "Toleranzentwicklung",                          items = c(2, 4)),
  list(name = "Kontrollverlust",                               items = c(3, 10)),
  list(name = "Verhaltensbezogene Einengung",                  items = c(11, 15)),
  list(name = "Fortsetzung trotz psychosozialer Probleme",     items = c(6, 14)),
  list(name = "Luegen/Verheimlichen",                          items = c(13, 17)),
  list(name = "Dysfunktionale Gefuehlsregulation",             items = c(9, 12)),
  list(name = "Gefaehrdung/Verluste",                          items = c(16, 18))
)

# Einordnung nach Anzahl erfuellter DSM-5-Kriterien (0-9).
CSAS_FP_EINORDNUNG_FARBEN = list(
  "unauffaellig" = list(bg = "#E8F5E9", text = "#2E7D32", border = "#A5D6A7"),
  "riskant"      = list(bg = "#FFF3E0", text = "#E65100", border = "#FFCC80"),
  "pathologisch" = list(bg = "#FFEBEE", text = "#B71C1C", border = "#EF9A9A")
)

CSAS_FP_STUFE_BADGE_FARBEN = c(
  "0" = "#4CAF50",
  "1" = "#F48FB1",
  "2" = "#EF5350",
  "3" = "#B71C1C"
)
CSAS_FP_STUFE_BADGE_TEXT_FARBEN = c(
  "0" = "white",
  "1" = "#333333",
  "2" = "white",
  "3" = "white"
)

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 ####

bereinige_markdown = function(x) {
  x = gsub("\\*\\*", "", x)
  x = gsub("(?<!\\\\)\\*", "", x, perl = TRUE)
  x = gsub("\\\\\\.", ".", x)
  x = trimws(x)
  x
}

# Itemnummer vom Rest des Rohlabels trennen. Rohlabel beginnt mit
# Nummer + escaptem Punkt, z.B. "1\\. Mein Partner beschaeftigt sich ...".
trenne_itemnummer = function(rohlabel) {
  if (is.null(rohlabel) || length(rohlabel) == 0 || is.na(rohlabel[1])) {
    return(list(nr = NA_character_, text = NA_character_))
  }
  rohlabel = as.character(rohlabel[1])
  m = regmatches(rohlabel, regexec("^(\\d+)\\\\\\.\\s*", rohlabel))[[1]]
  if (length(m) == 2) {
    nr   = m[2]
    rest = sub("^(\\d+)\\\\\\.\\s*", "", rohlabel)
  } else {
    nr   = NA_character_
    rest = rohlabel
  }
  list(nr = nr, text = bereinige_markdown(rest))
}

# Bestimmt den 1-basierten Index innerhalb von choice_texte, der zum
# Rohwert der Zelle passt. Deckt drei Kodierungsformate ab: haven-labelled,
# reiner (bereinigter) Text, und reiner numerischer 1-basierter Index.
# Gibt bei fehlendem Wert index = NA (kein Fehler); bei unbekanntem
# Speicherformat ok = FALSE mit Fehlermeldung.
hole_item_wert = function(spalte, zeilenwert, choice_texte, feldname = "") {
  choice_texte_bereinigt = bereinige_markdown(choice_texte)

  if (length(zeilenwert) == 0 || is.na(zeilenwert[1])) {
    return(list(ok = TRUE, index = NA_integer_))
  }

  if (haven::is.labelled(spalte)) {
    lbl_attr = attr(spalte, "labels")
    if (is.null(lbl_attr) || length(lbl_attr) == 0) {
      return(list(ok = FALSE, meldung = paste0(
        "Unbekanntes Kodierungsformat in Spalte ", feldname,
        " (haven_labelled ohne labels-Attribut), bitte manuell pruefen.")))
    }
    lbl_namen_bereinigt = bereinige_markdown(names(lbl_attr))
    roh = suppressWarnings(as.numeric(zeilenwert[1]))
    if (is.na(roh)) {
      return(list(ok = FALSE, meldung = paste0(
        "Unbekanntes Kodierungsformat in Spalte ", feldname,
        " (Rohwert nicht numerisch), bitte manuell pruefen.")))
    }
    pos_in_labels = which(as.vector(lbl_attr) == roh)
    if (length(pos_in_labels) == 0) {
      return(list(ok = FALSE, meldung = paste0(
        "Unbekanntes Kodierungsformat in Spalte ", feldname,
        " (Rohwert nicht im labels-Attribut gefunden), bitte manuell pruefen.")))
    }
    label_text = lbl_namen_bereinigt[pos_in_labels[1]]
    idx = match(label_text, choice_texte_bereinigt)
    return(list(ok = TRUE, index = if (is.na(idx)) NA_integer_ else as.integer(idx)))
  }

  if (is.character(zeilenwert)) {
    txt = bereinige_markdown(as.character(zeilenwert[1]))
    idx = match(txt, choice_texte_bereinigt)
    return(list(ok = TRUE, index = if (is.na(idx)) NA_integer_ else as.integer(idx)))
  }

  roh_numerisch = suppressWarnings(as.numeric(zeilenwert[1]))
  if (!is.na(roh_numerisch) && roh_numerisch == round(roh_numerisch) && roh_numerisch >= 1) {
    return(list(ok = TRUE, index = as.integer(roh_numerisch)))
  }

  list(ok = FALSE, meldung = paste0(
    "Unbekanntes Kodierungsformat in Spalte ", feldname, ", bitte manuell pruefen."))
}

# Reine Anzeige-Hilfsfunktion (keine Recoding-Logik): liefert den
# bereinigten Anzeigetext einer Zelle, unabhaengig vom Kodierungsformat.
hole_anzeige_text = function(spalte, zeilenwert) {
  if (length(zeilenwert) == 0 || is.na(zeilenwert[1])) return(NA_character_)
  if (haven::is.labelled(spalte)) {
    lbl_attr = attr(spalte, "labels")
    if (!is.null(lbl_attr) && length(lbl_attr) > 0) {
      roh = suppressWarnings(as.numeric(zeilenwert[1]))
      pos = which(as.vector(lbl_attr) == roh)
      if (length(pos) > 0) return(bereinige_markdown(names(lbl_attr)[pos[1]]))
    }
    return(as.character(zeilenwert[1]))
  }
  if (is.character(zeilenwert)) return(bereinige_markdown(as.character(zeilenwert[1])))
  as.character(zeilenwert[1])
}

parse_hhmm_minuten = function(text) {
  text = trimws(as.character(text))
  if (length(text) == 0 || is.na(text) || text == "") return(NA_real_)
  m = regmatches(text, regexec("^([0-9]{1,2}):([0-9]{2})$", text))[[1]]
  if (length(m) != 3) return(NA_real_)
  stunden = as.numeric(m[2])
  minuten = as.numeric(m[3])
  if (is.na(stunden) || is.na(minuten) || minuten > 59) return(NA_real_)
  stunden * 60 + minuten
}

format_minuten_hhmm = function(minuten) {
  if (is.na(minuten)) return("k. A.")
  h = floor(minuten / 60)
  m = round(minuten %% 60)
  if (m == 60) { m = 0; h = h + 1 }
  sprintf("%d Std. %02d Min.", h, m)
}

# Kernitem-Feldname fuer Nummer i (1-18).
csas_fp_item_feld = function(i) paste0("csas_fp_", sprintf("%02d", i))

make_kriterien_balken = function(anzahl) {
  ggplot() +
    geom_rect(aes(xmin = -0.5, xmax = 1.5, ymin = 0, ymax = 1), fill = "#E8F5E9", color = NA) +
    geom_rect(aes(xmin = 1.5,  xmax = 4.5, ymin = 0, ymax = 1), fill = "#FFF3E0", color = NA) +
    geom_rect(aes(xmin = 4.5,  xmax = 9.5, ymin = 0, ymax = 1), fill = "#FFEBEE", color = NA) +
    geom_rect(aes(xmin = -0.5, xmax = 9.5, ymin = 0, ymax = 1),
              fill = NA, color = "#9E9E9E", linewidth = 0.6) +
    geom_segment(aes(x = anzahl, xend = anzahl, y = -0.25, yend = 1.25),
                 color = AKZENT_FARBE, linewidth = 2.5) +
    geom_label(aes(x = anzahl, y = 1.6, label = paste0(anzahl, " / 9")),
               fill = AKZENT_FARBE, color = "white", fontface = "bold",
               linewidth = 0, size = 4) +
    annotate("text", x = 0.5, y = -0.55, label = "0-1: unauffaellig",
             color = "#2E7D32", size = 3.0, hjust = 0.5) +
    annotate("text", x = 3,   y = -0.55, label = "2-4: riskant",
             color = "#E65100", size = 3.0, hjust = 0.5) +
    annotate("text", x = 7,   y = -0.55, label = "5-9: pathologisch",
             color = "#B71C1C", size = 3.0, hjust = 0.5) +
    scale_x_continuous(limits = c(-1, 10), breaks = 0:9) +
    scale_y_continuous(limits = c(-0.8, 2.0)) +
    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(),
      plot.margin        = margin(t = 5, r = 10, b = 15, l = 10)
    ) +
    labs(x = "Anzahl erfuellter DSM-5-Kriterien (0-9)", y = NULL)
}

csas_fp_einordnung = function(anzahl_kriterien) {
  if (anzahl_kriterien <= 1) {
    list(
      key   = "unauffaellig",
      titel = "Unauffaellig",
      text  = paste0(
        anzahl_kriterien, " von 9 DSM-5-Kriterien erfuellt. Kein Hinweis auf ",
        "problematisches Computerspielverhalten aus Sicht des Partners."
      )
    )
  } else if (anzahl_kriterien <= 4) {
    list(
      key   = "riskant",
      titel = "Riskant / moegliche Gefaehrdung",
      text  = paste0(
        anzahl_kriterien, " von 9 DSM-5-Kriterien erfuellt. Aus Sicht des Partners ",
        "bestehen Hinweise auf ein riskantes Spielverhalten."
      )
    )
  } else {
    list(
      key   = "pathologisch",
      titel = "Pathologisch / Verdacht auf Internet Gaming Disorder (IGD)",
      text  = paste0(
        anzahl_kriterien, " von 9 DSM-5-Kriterien erfuellt. Aus Sicht des Partners ",
        "bestehen deutliche Hinweise auf ein pathologisches Spielverhalten. ",
        "Der Cutoff von 5 Kriterien ist laut Testmanual eine pragmatische, bewusst ",
        "konservative Konvention und keine harte Diagnoseschwelle."
      )
    )
  }
}


# 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;
}
.ergaenzung-box {
  background: #FFF3E0; border: 2px solid #E65100; border-left: 8px solid #E65100;
  border-radius: 6px; padding: 14px 20px; margin-bottom: 20px;
  color: #7A2E00; box-shadow: 0 1px 4px rgba(0,0,0,.15);
}
.ergaenzung-titel { font-weight: 800; font-size: 1.02rem; margin-bottom: 4px; }
.ergaenzung-text  { font-size: 0.92em; line-height: 1.5; }
.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; }
.kontext-zeile {
  display: flex; gap: 8px; align-items: baseline;
  padding: 4px 0; color: #444; font-size: 0.93em;
}
.kontext-label { font-weight: 600; color: #333; min-width: 220px; }
.geraet-zeile {
  display: flex; gap: 8px; align-items: baseline;
  padding: 4px 0; color: #444; font-size: 0.93em; border-bottom: 1px solid #F0F0F0;
}
.geraet-label { font-weight: 600; color: #333; min-width: 180px; }
.geraet-nie { color: #2E7D32; }
.geraet-genutzt { color: #B71C1C; font-weight: 600; }
.einordnung-box {
  border-radius: 6px; padding: 14px 18px; margin: 12px 0;
  border-left: 5px solid;
}
.einordnung-titel { font-weight: 700; font-size: 1.05rem; margin-bottom: 6px; }
.einordnung-text { font-size: 0.93em; line-height: 1.55; }
.einordnung-disclaimer {
  font-size: 0.82em; color: #777; font-style: italic;
  margin-top: 10px; border-top: 1px solid rgba(0,0,0,.1); padding-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: 26px; 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-0 { background: #4CAF50; color: white; }
.stufe-badge-1 { background: #F48FB1; color: #333333; }
.stufe-badge-2 { background: #EF5350; color: white; }
.stufe-badge-3 { background: #B71C1C; color: white; }
.score-zahl  { font-size: 2.2rem; font-weight: 800; color: #8B2635; }
.cutoff-info { font-size: 0.88em; color: #555; margin-top: 4px; }
.kriterien-tabelle { width: 100%; border-collapse: collapse; font-size: 0.9em; }
.kriterien-tabelle th, .kriterien-tabelle td {
  text-align: left; padding: 6px 10px; border-bottom: 1px solid #F0F0F0;
}
.kriterien-tabelle th { color: #8B2635; font-weight: 700; }
.badge-erfuellt-ja  { color: #B71C1C; font-weight: 700; }
.badge-erfuellt-nein { color: #2E7D32; font-weight: 600; }
.info-block { font-size: 0.86em; color: #666; font-style: italic; margin-top: 6px; }
.freitext-block { font-size: 0.92em; color: #333; }
"

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("CSAS-FP – Computerspielabhaengigkeitsskala, Fremdbeurteilung durch den Partner"),
    tags$p("Auswertung nach Testmanual, DSM-5-Kriterien-basiert")
  ),

  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 = "Chiffre der Zielperson",
                  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_csas_fp_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_ergaenzung_titel = fp_text(bold = TRUE, font.size = 11,
                                 color = "#7A2E00", shading.color = "#FFE0B2")
  fp_ergaenzung_text  = fp_text(font.size = 10,
                                 color = "#7A2E00", shading.color = "#FFF3E0")

  doc = body_add_fpar(doc, fpar(ftext("CSAS-FP - Einzelauswertung (Fremdbeurteilung)", fp_titel)))
  doc = body_add_fpar(doc, fpar(
    ftext("Chiffre der Zielperson: ", fp_label),
    ftext(erg$chiffre,                fp_normal),
    ftext("     Ausfuelldatum: ",     fp_label),
    ftext(erg$datum_str,              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("Wichtiger Hinweis", fp_ergaenzung_titel)))
  doc = body_add_fpar(doc, fpar(ftext(CSAS_FP_ERGAENZUNGSHINWEIS, fp_ergaenzung_text)))
  doc = body_add_par(doc, "", style = "Normal")

  doc = body_add_fpar(doc, fpar(ftext("Kopfdaten (Partner)", fp_abschnitt)))
  doc = body_add_fpar(doc, fpar(
    ftext("Alter des Partners: ", fp_label),
    ftext(erg$alter_text,         fp_normal)
  ))
  doc = body_add_fpar(doc, fpar(
    ftext("Geschlecht des Partners: ", fp_label),
    ftext(erg$geschlecht_text,         fp_normal)
  ))
  doc = body_add_par(doc, "", style = "Normal")

  doc = body_add_fpar(doc, fpar(ftext("Geraetenutzung des Partners", fp_abschnitt)))
  for (f in CSAS_FP_GERAET_FELDER) {
    doc = body_add_fpar(doc, fpar(
      ftext(paste0(CSAS_FP_GERAET_LABELS[[f]], ": "), fp_label),
      ftext(erg$geraet_texte[[f]],                     fp_normal)
    ))
  }
  doc = body_add_par(doc, "", style = "Normal")

  if (erg$fall == "kein_spiel") {
    doc = body_add_fpar(doc, fpar(ftext(
      "Kein Computerspielverhalten des Partners in den letzten 12 Monaten berichtet ",
      fp_normal)))
    doc = body_add_fpar(doc, fpar(ftext(
      "(alle Geraetetypen 'nie'). CSAS-Summenwert und DSM-5-Kriterien sind fuer diesen ",
      "Fall nicht relevant (Ableitung aus der Bogenlogik).", fp_normal)))
    doc = body_add_par(doc, "", style = "Normal")
    doc = body_add_fpar(doc, fpar(ftext(CSAS_FP_DISCLAIMER, fp_disclaimer)))
    return(doc)
  }

  if (erg$fall == "unvollstaendig") {
    doc = body_add_fpar(doc, fpar(ftext(
      "Die 18 Kernitems sind nicht vollstaendig beantwortet. Eine Auswertung von ",
      "CSAS-Summenwert und DSM-5-Kriterien ist daher nicht moeglich.",
      fp_text(font.size = 11, bold = TRUE, color = "#E65100"))))
    doc = body_add_par(doc, "", style = "Normal")
    doc = body_add_fpar(doc, fpar(ftext(CSAS_FP_DISCLAIMER, fp_disclaimer)))
    return(doc)
  }

  doc = body_add_fpar(doc, fpar(ftext("Mittlere taegliche Spielzeit des Partners", fp_abschnitt)))
  doc = body_add_fpar(doc, fpar(
    ftext(paste0(erg$spielzeit_text, "  (", round(erg$spielzeit_minuten), " Minuten)"), fp_normal)
  ))
  doc = body_add_par(doc, "", style = "Normal")

  doc = body_add_fpar(doc, fpar(ftext("CSAS-Summenwert", fp_abschnitt)))
  doc = body_add_fpar(doc, fpar(
    ftext(paste0(erg$summenwert, " / 54"),
          fp_text(bold = TRUE, font.size = 12, color = AKZENT_FARBE))
  ))
  doc = body_add_par(doc, "", style = "Normal")

  ein_key   = erg$einordnung$key
  ein_farbe = CSAS_FP_EINORDNUNG_FARBEN[[ein_key]]
  fp_ein_titel = fp_text(bold = TRUE, font.size = 12,
                          color = ein_farbe$text, shading.color = ein_farbe$bg)
  fp_ein_text  = fp_text(font.size = 11,
                          color = ein_farbe$text, shading.color = ein_farbe$bg)

  doc = body_add_fpar(doc, fpar(ftext("DSM-5-Kriterien", fp_abschnitt)))
  for (i in seq_along(CSAS_FP_KRITERIEN)) {
    k = CSAS_FP_KRITERIEN[[i]]
    erfuellt = erg$kriterien_erfuellt[i]
    fp_ja_nein = if (isTRUE(erfuellt))
      fp_text(bold = TRUE, font.size = 10, color = "#B71C1C")
    else
      fp_text(font.size = 10, color = "#2E7D32")
    doc = body_add_fpar(doc, fpar(
      ftext(paste0(i, ". ", k$name, " (Items ", paste(k$items, collapse = ", "), "): "), fp_normal),
      ftext(if (isTRUE(erfuellt)) "erfuellt" else "nicht erfuellt", fp_ja_nein)
    ))
  }
  doc = body_add_par(doc, "", style = "Normal")

  doc = body_add_fpar(doc, fpar(ftext("Einordnung", fp_abschnitt)))
  doc = body_add_fpar(doc, fpar(
    ftext(paste0(erg$anzahl_kriterien, " von 9 Kriterien erfuellt: ", erg$einordnung$titel),
          fp_ein_titel)
  ))
  doc = body_add_fpar(doc, fpar(ftext(erg$einordnung$text, fp_ein_text)))
  doc = body_add_par(doc, "", style = "Normal")

  doc = body_add_fpar(doc, fpar(ftext("Normwerte", fp_abschnitt)))
  doc = body_add_fpar(doc, fpar(ftext(CSAS_FP_KEINE_NORMWERTE_HINWEIS, fp_normal)))
  doc = body_add_par(doc, "", style = "Normal")

  doc = body_add_fpar(doc, fpar(ftext("CSAS-FP Einzelitems", fp_abschnitt)))
  for (i in seq_len(18)) {
    stufe     = erg$item_werte[i]
    stufe_key = if (!is.na(stufe) && stufe >= 0L && stufe <= 3L) as.character(stufe) else "0"
    antwort   = if (!is.na(stufe)) CSAS_FP_CHOICE_TEXTE[stufe + 1L] else "k. A."
    item_txt  = if (!is.na(erg$item_texte[i])) erg$item_texte[i] else paste0("Item ", i)

    fp_badge = fp_text(
      color         = CSAS_FP_STUFE_BADGE_TEXT_FARBEN[[stufe_key]],
      bold          = TRUE,
      shading.color = CSAS_FP_STUFE_BADGE_FARBEN[[stufe_key]],
      font.size     = 10
    )
    doc = body_add_fpar(doc, fpar(
      ftext(paste0(i, ". ", item_txt, "  "), fp_normal),
      ftext(paste0(" ", antwort, " "), fp_badge)
    ))
  }
  doc = body_add_par(doc, "", style = "Normal")

  doc = body_add_fpar(doc, fpar(ftext("Genannte Spiele des Partners", fp_abschnitt)))
  doc = body_add_fpar(doc, fpar(ftext(erg$spiele_text, fp_normal)))
  doc = body_add_par(doc, "", style = "Normal")

  doc = body_add_fpar(doc, fpar(ftext(CSAS_FP_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)))
    }
  })

  # Skripte werden NICHT beim App-Start gesourct, nur beim Klick auf "Auswerten".
  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 Chiffre eingeben."))
    }
    if (!(nchar(trimws(input$pseudonym)) > 0 || grepl("^[A-Z][0-9]{6}$", chiffre))) {
      return(list(error = paste0(
        "Ungueltige Chiffre. Erwartet: ein Grossbuchstabe + 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)))
    }

    ok = tryCatch({
      source(PFAD_DOWNLOAD_SKRIPT, local = FALSE)
      list(ok = TRUE)
    }, error = function(e) list(ok = FALSE, msg = e$message))
    if (!ok$ok) return(list(error = paste0("Fehler im Download-Skript: ", ok$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)

    ok = 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 (!ok$ok) return(list(error = paste0("Fehler im Pseudonym-Skript: ", ok$msg)))

    if (!exists("daten_csas_fp", envir = .GlobalEnv)) {
      return(list(error = paste0(
        "Objekt 'daten_csas_fp' 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     = get("daten_csas_fp", envir = .GlobalEnv)
    pseudo_df = get("pseudo",        envir = .GlobalEnv)

    if (!("created" %in% names(daten))) {
      return(list(error = paste0(
        "Erwartete Spalte 'created' (Ausfuelldatum) in 'daten_csas_fp' nicht gefunden. ",
        "Bitte pruefen, unter welchem Namen das Ausfuelldatum vorliegt.")))
    }

    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 CSAS-FP-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_parsed = tryCatch(as.POSIXct(zeile[["created"]][1]), error = function(e) NA)
    if (length(datum_parsed) == 0 || is.na(datum_parsed)) {
      return(list(error = paste0(
        "Das Ausfuelldatum ('created') konnte nicht geparst werden. ",
        "Rohwert: '", as.character(zeile[["created"]][1]), "'. Bitte manuell pruefen.")))
    }
    datum_str = format(datum_parsed, "%d.%m.%Y")
    datum_yyyymmdd = format(datum_parsed, "%Y%m%d")

    # --- Kopfdaten des Partners ---
    alter_roh   = zeile[["csas_fp_alter"]][1]
    alter_text  = if (is.null(alter_roh) || is.na(alter_roh)) "k. A." else as.character(alter_roh)

    geschlecht_text = hole_anzeige_text(daten[["csas_fp_geschlecht"]], zeile[["csas_fp_geschlecht"]])
    geschlecht_text = if (is.na(geschlecht_text)) "k. A." else geschlecht_text

    # --- Geraetenutzung des Partners ---
    geraet_texte = list()
    geraet_ist_nie = logical(length(CSAS_FP_GERAET_FELDER))
    names(geraet_ist_nie) = CSAS_FP_GERAET_FELDER

    for (f in CSAS_FP_GERAET_FELDER) {
      r = hole_item_wert(daten[[f]], zeile[[f]], CSAS_FP_GERAET_NIE_TEXT, feldname = f)
      if (!r$ok) return(list(error = r$meldung))
      geraet_ist_nie[[f]] = isTRUE(r$index == 1L)
      anzeige = hole_anzeige_text(daten[[f]], zeile[[f]])
      geraet_texte[[f]] = if (is.na(anzeige)) "k. A." else anzeige
    }

    alle_geraete_nie = all(geraet_ist_nie)

    # --- Freitext: genannte Spiele ---
    unbekannt_roh = zeile[["csas_fp_spiele_unbekannt"]][1]
    spiele_unbekannt = !is.null(unbekannt_roh) && !is.na(unbekannt_roh) &&
      suppressWarnings(as.numeric(unbekannt_roh)) == 1

    if (isTRUE(spiele_unbekannt)) {
      spiele_text = "Namen der Spiele laut Angabe nicht bekannt"
    } else {
      spielnamen = sapply(c("csas_fp_spiel1", "csas_fp_spiel2", "csas_fp_spiel3"), function(f) {
        v = zeile[[f]][1]
        if (is.null(v) || is.na(v) || trimws(as.character(v)) == "") return(NA_character_)
        bereinige_markdown(as.character(v))
      })
      spielnamen = spielnamen[!is.na(spielnamen)]
      spiele_text = if (length(spielnamen) == 0)
        "Keine Angabe" else paste(spielnamen, collapse = ", ")
    }

    basis = list(
      chiffre          = chiffre,
      datum_str        = datum_str,
      datum_yyyymmdd   = datum_yyyymmdd,
      info_mehrere     = info_mehrere,
      alter_text       = alter_text,
      geschlecht_text  = geschlecht_text,
      geraet_texte     = geraet_texte,
      spiele_text      = spiele_text,
      error            = NULL
    )

    # Fall 1: Kein Spielverhalten -> Kernitems und Spielzeit wurden per
    # showif gar nicht angezeigt.
    if (alle_geraete_nie) {
      return(c(basis, list(fall = "kein_spiel")))
    }

    # --- Kernitems (18) ---
    item_texte  = character(18)
    item_nrn    = character(18)
    item_werte  = integer(18)
    item_antw   = character(18)

    for (i in seq_len(18)) {
      f = csas_fp_item_feld(i)
      lab = trenne_itemnummer(attr(daten[[f]], "label"))
      item_texte[i] = lab$text
      item_nrn[i]   = if (!is.na(lab$nr)) lab$nr else as.character(i)

      r = hole_item_wert(daten[[f]], zeile[[f]], CSAS_FP_CHOICE_TEXTE, feldname = f)
      if (!r$ok) return(list(error = r$meldung))
      item_werte[i] = if (is.na(r$index)) NA_integer_ else as.integer(r$index - 1L)
      item_antw[i]  = if (!is.na(item_werte[i])) CSAS_FP_CHOICE_TEXTE[item_werte[i] + 1L] else NA_character_
    }

    # Fall 2: nicht alle 18 Kernitems vollstaendig beantwortet.
    if (any(is.na(item_werte))) {
      return(c(basis, list(
        fall        = "unvollstaendig",
        item_texte  = item_texte,
        item_nrn    = item_nrn,
        item_werte  = item_werte,
        item_antw   = item_antw
      )))
    }

    # --- Fall 3: vollstaendige Auswertung ---
    summenwert = sum(item_werte)

    werktag_min    = parse_hhmm_minuten(zeile[["csas_fp_stunden_werktag"]][1])
    wochenende_min = parse_hhmm_minuten(zeile[["csas_fp_stunden_wochenende"]][1])
    spielzeit_minuten = if (is.na(werktag_min) || is.na(wochenende_min))
      NA_real_ else (werktag_min * 5 + wochenende_min * 2) / 7
    spielzeit_text = format_minuten_hhmm(spielzeit_minuten)

    kriterien_erfuellt = sapply(CSAS_FP_KRITERIEN, function(k) {
      werte_k = item_werte[k$items]
      any(werte_k == 3, na.rm = TRUE)
    })
    anzahl_kriterien = sum(kriterien_erfuellt)
    einordnung = csas_fp_einordnung(anzahl_kriterien)

    c(basis, list(
      fall                = "vollstaendig",
      item_texte          = item_texte,
      item_nrn            = item_nrn,
      item_werte          = item_werte,
      item_antw           = item_antw,
      summenwert          = summenwert,
      spielzeit_minuten   = spielzeit_minuten,
      spielzeit_text      = spielzeit_text,
      kriterien_erfuellt  = kriterien_erfuellt,
      anzahl_kriterien    = anzahl_kriterien,
      einordnung          = einordnung
    ))
  })

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

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

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

    geraet_ui = lapply(CSAS_FP_GERAET_FELDER, function(f) {
      div(class = "geraet-zeile",
        div(class = "geraet-label", CSAS_FP_GERAET_LABELS[[f]]),
        div(erg$geraet_texte[[f]])
      )
    })

    kopf_und_geraete = tagList(
      div(class = "ergaenzung-box",
        div(class = "ergaenzung-titel", "Wichtiger Hinweis zur Fremdbeurteilung"),
        div(class = "ergaenzung-text", CSAS_FP_ERGAENZUNGSHINWEIS)
      ),

      div(class = "abschnitt-karte",
        div(class = "abschnitt-titel", "CSAS-FP – Fremdbeurteilung durch den Partner"),

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

        tags$hr(),

        tags$h5("Kopfdaten des Partners"),
        div(class = "kontext-zeile",
          div(class = "kontext-label", "Alter des Partners:"),
          div(erg$alter_text)
        ),
        div(class = "kontext-zeile",
          div(class = "kontext-label", "Geschlecht des Partners:"),
          div(erg$geschlecht_text)
        ),

        tags$hr(),

        tags$h5("Geraetenutzung des Partners"),
        div(geraet_ui)
      )
    )

    if (erg$fall == "kein_spiel") {
      return(tagList(
        kopf_und_geraete,
        div(class = "abschnitt-karte",
          div(class = "abschnitt-titel", "Auswertung"),
          div(class = "alert-warnung",
            paste0(
              "Kein Computerspielverhalten des Partners in den letzten 12 Monaten ",
              "berichtet (alle Geraetetypen 'nie'). CSAS-Summenwert und DSM-5-Kriterien ",
              "sind fuer diesen Fall nicht relevant."
            )
          ),
          div(class = "info-block",
            "Hinweis: Diese Einordnung ist eine Ableitung aus der Bogenlogik ",
            "(showif-Steuerung in formr), keine woertliche Aussage des Testmanuals.")
        )
      ))
    }

    if (erg$fall == "unvollstaendig") {
      return(tagList(
        kopf_und_geraete,
        div(class = "abschnitt-karte",
          div(class = "abschnitt-titel", "Auswertung"),
          div(class = "alert-warnung",
            "Die 18 Kernitems sind nicht vollstaendig beantwortet. Eine Auswertung von ",
            "CSAS-Summenwert und DSM-5-Kriterien ist daher nicht moeglich."
          )
        )
      ))
    }

    ein_key = erg$einordnung$key

    kriterien_zeilen = lapply(seq_along(CSAS_FP_KRITERIEN), function(i) {
      k = CSAS_FP_KRITERIEN[[i]]
      erfuellt = erg$kriterien_erfuellt[i]
      werte_k  = erg$item_werte[k$items]
      tags$tr(
        tags$td(paste0(i, ". ", k$name)),
        tags$td(paste0("Items ", paste(k$items, collapse = ", "),
                       " (Werte: ", paste(werte_k, collapse = ", "), ")")),
        tags$td(
          if (isTRUE(erfuellt))
            span(class = "badge-erfuellt-ja", "erfuellt")
          else
            span(class = "badge-erfuellt-nein", "nicht erfuellt")
        )
      )
    })

    items_ui = lapply(seq_len(18), function(i) {
      stufe = erg$item_werte[i]
      sk    = if (!is.na(stufe) && stufe >= 0L && stufe <= 3L) as.character(stufe) else "0"
      antw  = if (!is.na(erg$item_antw[i])) erg$item_antw[i] else "k. A."

      div(class = "item-zeile",
        div(class = "item-nr",   paste0(erg$item_nrn[i], ".")),
        div(class = "item-text", erg$item_texte[i]),
        span(class = paste0("stufe-badge stufe-badge-", sk), antw)
      )
    })

    tagList(
      kopf_und_geraete,

      div(class = "abschnitt-karte",
        div(class = "abschnitt-titel", "Spielzeit und CSAS-Summenwert"),

        div(class = "kontext-zeile",
          div(class = "kontext-label", "Mittlere taegliche Spielzeit des Partners:"),
          div(paste0(erg$spielzeit_text, " (", round(erg$spielzeit_minuten), " Minuten)"))
        ),

        tags$hr(),

        fluidRow(
          column(3,
            div(
              div(class = "score-zahl", erg$summenwert),
              div("CSAS-Summenwert (0-54)", style = "color:#555;")
            )
          ),
          column(9,
            div(class = "info-block", CSAS_FP_KEINE_NORMWERTE_HINWEIS)
          )
        )
      ),

      div(class = "abschnitt-karte",
        div(class = "abschnitt-titel", "DSM-5-Kriterien"),
        tags$table(class = "kriterien-tabelle",
          tags$thead(
            tags$tr(tags$th("Kriterium"), tags$th("Items"), tags$th("Erfuellt"))
          ),
          tags$tbody(kriterien_zeilen)
        ),

        tags$hr(),

        plotOutput("kriterien_plot", height = "160px"),

        div(class = paste0("einordnung-box"),
            style = paste0(
              "background:", CSAS_FP_EINORDNUNG_FARBEN[[ein_key]]$bg, ";",
              "border-color:", CSAS_FP_EINORDNUNG_FARBEN[[ein_key]]$border, ";",
              "color:", CSAS_FP_EINORDNUNG_FARBEN[[ein_key]]$text, ";"
            ),
          div(class = "einordnung-titel",
              paste0(erg$anzahl_kriterien, " von 9 Kriterien erfuellt: ", erg$einordnung$titel)),
          div(class = "einordnung-text", erg$einordnung$text)
        )
      ),

      div(class = "abschnitt-karte",
        div(class = "abschnitt-titel", "CSAS-FP Einzelitems"),
        div(items_ui)
      ),

      div(class = "abschnitt-karte",
        div(class = "abschnitt-titel", "Genannte Spiele des Partners"),
        div(class = "freitext-block", erg$spiele_text)
      )
    )
  })

  output$kriterien_plot = renderPlot({
    req(input$btn_suchen)
    erg = ergebnis_r()
    req(is.null(erg$error))
    req(identical(erg$fall, "vollstaendig"))
    make_kriterien_balken(erg$anzahl_kriterien)
  }, bg = "transparent")

  output$download_word = downloadHandler(
    filename = function() {
      erg = tryCatch(ergebnis_r(), error = function(e) NULL)
      hat_daten = is.list(erg) && is.null(erg$error) && !is.null(erg$datum_yyyymmdd)
      chiffre = if (hat_daten) erg$chiffre else "export"
      datum   = if (hat_daten) erg$datum_yyyymmdd else format(Sys.Date(), "%Y%m%d")
      paste0("CSASFP_", chiffre, "_", datum, ".docx")
    },
    content = function(file) {
      erg = tryCatch(ergebnis_r(), error = function(e) NULL)
      daten_ok = is.list(erg) && is.null(erg$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_csas_fp_docx(erg),
        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)