# Präambel ####

PFAD_DOWNLOAD_SKRIPT  = "../API/get_data_bsl.R"    # liefert: daten_bsl
PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R"      # liefert: pseudo
PFAD_NORMTABELLEN     = "normtabellen"
AKZENT_FARBE          = "#8B2635"

BSL_DISCLAIMER = paste0(
  "Diese Auswertung ist ein Hilfsmittel fuer klinisches Fachpersonal und ersetzt ",
  "keine klinische Diagnose. Die Interpretation obliegt der behandelnden Person. ",
  "Fuer die BSL liegt keine dokumentierte klinische Cutoff-Schwelle vor, es wird ",
  "ausschliesslich der Prozentrang gegenueber der Referenzstichprobe berichtet."
)

BSL_KRITISCH_DISCLAIMER = paste0(
  "Kein automatisiertes klinisches Urteil, ersetzt keine klinische Einschaetzung."
)

# 5 Antwortstufen 0-4 (ueberhaupt nicht ... sehr stark), Verlauf gruen -> dunkelrot,
# analog zu den anderen 5-stufigen Instrumenten dieser App-Familie (z.B. PG-13-R).
BSL_BADGE_FARBEN = c(
  "0" = "#4CAF50",
  "1" = "#F48FB1",
  "2" = "#EF5350",
  "3" = "#B71C1C",
  "4" = "#4A0000"
)
BSL_BADGE_TEXT_FARBEN = c(
  "0" = "white",
  "1" = "#333333",
  "2" = "white",
  "3" = "white",
  "4" = "white"
)

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


# 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)
PFAD_NORMTABELLEN     = normalizePath(absPath(PFAD_NORMTABELLEN),     mustWork = FALSE)


# Helper ####

# Antworttext -> Punktwert, Hauptitems (bsl_001-bsl_105, inkl. Items 96-105 die nur deskriptiv sind).
BSL_TEXT_STUFEN_HAUPT = c(
  "überhaupt nicht" = 0L,
  "ein wenig"        = 1L,
  "ziemlich"         = 2L,
  "stark"            = 3L,
  "sehr stark"       = 4L
)

# Antworttext -> Punktwert, Ergaenzungsskala (bsl_erg_01-11).
BSL_TEXT_STUFEN_ERG = c(
  "gar nicht"        = 0L,
  "1 mal"            = 1L,
  "2 mal"            = 2L,
  "täglich"          = 3L,
  "mehrmals täglich" = 4L
)

# formr liefert bei Itemtyp mc erwartungsgemaess den Antworttext, moeglicherweise aber
# je nach Instanz-Konfiguration einen 1-basierten numerischen Index (choice1 -> 1 ... choice5 -> 5).
# Beide Faelle werden hier robust abgedeckt; ein nicht erkannter Wert ergibt NA statt Raten.
bsl_recode_item = function(wert, ergaenzungsskala = FALSE) {
  if (is.null(wert) || length(wert) == 0) return(NA_integer_)
  w = wert[1]
  if (is.na(w)) return(NA_integer_)

  tabelle = if (isTRUE(ergaenzungsskala)) BSL_TEXT_STUFEN_ERG else BSL_TEXT_STUFEN_HAUPT

  if (is.character(w) || is.factor(w)) {
    txt = tolower(trimws(gsub("\\*\\*", "", as.character(w))))
    pos = match(txt, tolower(trimws(names(tabelle))))
    if (!is.na(pos)) return(as.integer(unname(tabelle[pos])))

    # Fallback: Text ist tatsaechlich eine Zahl (z.B. weil als Zeichenkette exportiert).
    if (grepl("^-?[0-9]+(\\.[0-9]+)?$", txt)) {
      n     = suppressWarnings(as.numeric(txt))
      punkt = n - 1
      if (!is.na(punkt) && punkt >= 0 && punkt <= 4) return(as.integer(round(punkt)))
    }
    return(NA_integer_)
  }

  if (is.numeric(w)) {
    punkt = w - 1
    if (!is.na(punkt) && punkt >= 0 && punkt <= 4) return(as.integer(round(punkt)))
    return(NA_integer_)
  }

  NA_integer_
}

# Rueckrichtung: Punktwert (0-4) -> kanonischer Antworttext, unabhaengig davon ob die
# formr-Rohantwort ein Text oder ein numerischer Index war.
bsl_antwort_text = function(punktwert, ergaenzungsskala = FALSE) {
  if (is.na(punktwert)) return(NA_character_)
  tabelle = if (isTRUE(ergaenzungsskala)) BSL_TEXT_STUFEN_ERG else BSL_TEXT_STUFEN_HAUPT
  pos = which(tabelle == punktwert)
  if (length(pos) == 0) return(NA_character_)
  names(tabelle)[pos[1]]
}

# range_ticks 0,100,10 liefert erwartungsgemaess direkt einen numerischen Wert 0-100.
# Defensive Pruefung, falls doch Text/NA/ausserhalb des Bereichs geliefert wird.
bsl_recode_vas = function(wert) {
  if (is.null(wert) || length(wert) == 0) return(NA_real_)
  w = wert[1]
  if (is.na(w)) return(NA_real_)
  n = suppressWarnings(as.numeric(as.character(w)))
  if (is.na(n) || n < 0 || n > 100) return(NA_real_)
  n
}

# Itemtext aus dem label-Attribut der Original-Spalte, falls formr/get_data_bsl.R eines
# mitliefert. Kein Rateergebnis: ohne Attribut wird ein generischer Fallback verwendet,
# es wird kein Wortlaut erfunden.
bsl_item_label = function(original_col, fallback) {
  lbl = attr(original_col, "label")
  if (is.null(lbl) || length(lbl) == 0 || is.na(lbl[1]) ||
      nchar(trimws(as.character(lbl[1]))) == 0) {
    return(fallback)
  }
  text = as.character(lbl[1])
  text = gsub("\\*\\*", "", text)                  # Markdown-Bold-Sternchen entfernen
  text = gsub("\\\\(.)", "\\1", text, perl = TRUE)  # Markdown-Escapes (\\*, \\_, \\(, ...) aufloesen
  # formr haengt im label-Attribut manchmal die Itemnummer voran (z.B. "1. " oder "96. ").
  # Die App praefigiert die Nummer selbst separat vor dem Text, daher hier entfernen,
  # sonst erscheint sie doppelt ("96. 96. ... Text").
  text = sub("^\\d+[.)\\s]\\s*", "", trimws(text))
  trimws(text)
}

# 7 Subskalen mit Item-Zuordnung, Reverse-Coding (nur Dysphorie) und Rohwert-Maximum.
BSL_SUBSKALEN = list(
  selbstwahrnehmung = list(
    name    = "Selbstwahrnehmung",
    items   = c(1, 8, 12, 14, 15, 16, 17, 23, 33, 36, 43, 46, 54, 58, 61, 71, 75, 90, 92),
    reverse = integer(0),
    max     = 76,
    norm_key = "selbstwahrnehmung"
  ),
  affektregulation = list(
    name    = "Affektregulation",
    items   = c(4, 10, 30, 31, 32, 42, 47, 50, 56, 70, 73, 83, 91),
    reverse = integer(0),
    max     = 52,
    norm_key = "affektregulation"
  ),
  autoaggression = list(
    name    = "Autoaggression",
    items   = c(18, 22, 28, 35, 38, 62, 74, 82, 85, 87, 93, 94),
    reverse = integer(0),
    max     = 48,
    norm_key = "autoaggression"
  ),
  dysphorie = list(
    name    = "Dysphorie",
    items   = c(5, 21, 26, 39, 55, 63, 68, 72, 80, 95),
    reverse = c(21, 26, 39, 55, 63, 68, 72, 80, 95),
    max     = 40,
    norm_key = "dysphorie"
  ),
  soziale_isolation = list(
    name    = "Soziale Isolation",
    items   = c(3, 11, 13, 19, 24, 48, 51, 65, 69, 79, 84, 89),
    reverse = integer(0),
    max     = 48,
    norm_key = "soziale_isolation"
  ),
  intrusionen = list(
    name    = "Intrusionen",
    items   = c(20, 25, 41, 44, 52, 57, 59, 66, 67, 78, 81),
    reverse = integer(0),
    max     = 44,
    norm_key = "intrusionen"
  ),
  feindseligkeit = list(
    name    = "Feindseligkeit",
    items   = c(27, 40, 45, 53, 60, 64),
    reverse = integer(0),
    max     = 24,
    norm_key = "feindseligkeit"
  )
)

# Dysphorie-Umpolitems gehen auch in die Gesamtskala mit dem umgepolten Wert ein (4 - Punktwert),
# Item 5 bleibt in beiden Faellen unumgepolt (bestaetigte Nutzerentscheidung, kein Rateergebnis).
BSL_DYSPHORIE_REVERSE = c(21, 26, 39, 55, 63, 68, 72, 80, 95)

# Items, die nur in die Gesamtskala einfliessen, in keine Subskala.
BSL_NUR_GESAMT_ITEMS = c(2, 6, 7, 9, 29, 34, 37, 49, 76, 77, 86, 88)

# Gesamtskala = Summe Items 1-95 (mit Umpolung der Dysphorie-Umpolitems).
BSL_GESAMT_ITEMS = 1:95

# Einzelitems 1-95, nach Subskala gruppiert (zusaetzlich zu den aggregierten Balken), rein
# deskriptiv: Antworttext ist die tatsaechlich gegebene (nicht umgepolte) Antwort, die Umpolung
# betrifft nur die Summenbildung in bsl_score_skala, nicht die Anzeige des Einzelitems.
bsl_gruppiere_hauptitems = function(haupt_punkte, daten) {
  baue_item_liste = function(item_nrn) {
    lapply(sort(item_nrn), function(i) {
      col   = paste0("bsl_", sprintf("%03d", i))
      punkt = haupt_punkte[[as.character(i)]]
      list(
        nr        = i,
        text      = bsl_item_label(daten[[col]], paste0("Item ", i)),
        punktwert = punkt,
        antwort   = bsl_antwort_text(punkt, ergaenzungsskala = FALSE)
      )
    })
  }

  gruppen = lapply(BSL_SUBSKALEN, function(sk) {
    list(titel = sk$name, items = baue_item_liste(sk$items))
  })
  gruppen[["nur_gesamt"]] = list(
    titel = "Weitere Items (nur Gesamtskala, keiner Subskala zugeordnet)",
    items = baue_item_liste(BSL_NUR_GESAMT_ITEMS)
  )
  gruppen
}

# Missing-Regel: > 10% fehlende Items je Skala -> nicht auswertbar (Rohwert = NA).
bsl_score_skala = function(item_nrn, werte_punkte, reverse_nrn = integer(0),
                            max_missing_anteil = 0.10) {
  roh = sapply(item_nrn, function(i) {
    p = werte_punkte[[as.character(i)]]
    if (is.null(p) || is.na(p)) return(NA_integer_)
    if (i %in% reverse_nrn) return(4L - as.integer(p))
    as.integer(p)
  })
  anteil_fehlend = sum(is.na(roh)) / length(item_nrn)
  auswertbar = anteil_fehlend <= max_missing_anteil
  list(
    rohwert        = if (auswertbar) as.integer(sum(roh, na.rm = TRUE)) else NA_integer_,
    anteil_fehlend = anteil_fehlend,
    auswertbar     = auswertbar
  )
}

# Exakter Rohwert-Match gegen eine Normtabelle (Spalten: wert_spalte, prozentrang).
# Kein Interpolieren, kein Absturz bei fehlendem Rohwert (sollte bei voller Range nicht vorkommen).
bsl_norm_lookup = function(tabelle, rohwert, wert_spalte = "rohwert") {
  if (is.null(tabelle) || is.null(rohwert) || length(rohwert) == 0 || is.na(rohwert)) {
    return(NA_real_)
  }
  zeile = tabelle[tabelle[[wert_spalte]] == rohwert, , drop = FALSE]
  if (nrow(zeile) == 0) return(NA_real_)
  suppressWarnings(as.numeric(zeile$prozentrang[1]))
}

# Ein horizontaler ggplot2-Balken je Zeile (Gesamtskala + 7 Subskalen), Skala 0-100 (Prozentrang),
# bewusst ohne Referenzlinie. Beschriftung mit Rohwert und Prozentrang direkt am Balken.
bsl_profil_plot = function(gesamt, subskalen) {
  reihen = c(
    list(list(name = "Gesamtskala", daten = gesamt)),
    lapply(subskalen, function(sk) list(name = sk$name, daten = sk))
  )

  namen = vapply(reihen, function(r) r$name, character(1))
  pr = vapply(reihen, function(r) {
    d = r$daten
    if (d$auswertbar && !is.na(d$prozentrang)) d$prozentrang else 0
  }, numeric(1))
  label = vapply(reihen, function(r) {
    d = r$daten
    if (!d$auswertbar) return("nicht auswertbar (> 10% fehlende Werte)")
    if (is.na(d$rohwert)) return("keine Angabe")
    pr_txt = if (is.na(d$prozentrang)) "PR: k. A." else paste0("PR: ", round(d$prozentrang))
    paste0(d$rohwert, " / ", d$max, "   (", pr_txt, ")")
  }, character(1))

  df = data.frame(
    name  = factor(namen, levels = rev(namen)),
    pr    = pr,
    label = label,
    stringsAsFactors = FALSE
  )

  ggplot(df, aes(x = name, y = pr)) +
    geom_col(fill = AKZENT_FARBE, width = 0.6) +
    geom_text(aes(label = label), hjust = -0.02, size = 3.3, color = "#333333") +
    coord_flip(clip = "off") +
    scale_y_continuous(limits = c(0, 100), breaks = seq(0, 100, 20),
                        expand = expansion(mult = c(0, 0.6))) +
    labs(x = NULL, y = "Prozentrang") +
    theme_minimal(base_size = 12) +
    theme(
      panel.grid.major.y = element_blank(),
      panel.grid.minor   = element_blank(),
      plot.margin        = margin(t = 5, r = 150, b = 5, l = 5)
    )
}

# VAS-Prozentrang separat, gleiche Balkendarstellung wie die Subskalen.
bsl_vas_plot = function(vas) {
  pr_val = if (!is.na(vas$prozentrang)) vas$prozentrang else 0
  label = if (is.na(vas$rohwert)) {
    "keine Angabe"
  } else if (is.na(vas$prozentrang)) {
    paste0(vas$rohwert, " / 100   (PR: k. A.)")
  } else {
    paste0(vas$rohwert, " / 100   (PR: ", round(vas$prozentrang), ")")
  }

  df = data.frame(
    name  = factor("VAS Gesamtbefindlichkeit"),
    pr    = pr_val,
    label = label,
    stringsAsFactors = FALSE
  )

  ggplot(df, aes(x = name, y = pr)) +
    geom_col(fill = AKZENT_FARBE, width = 0.5) +
    geom_text(aes(label = label), hjust = -0.02, size = 3.3, color = "#333333") +
    coord_flip(clip = "off") +
    scale_y_continuous(limits = c(0, 100), breaks = seq(0, 100, 20),
                        expand = expansion(mult = c(0, 0.6))) +
    labs(x = NULL, y = "Prozentrang") +
    theme_minimal(base_size = 12) +
    theme(
      panel.grid.major.y = element_blank(),
      panel.grid.minor   = element_blank(),
      plot.margin        = margin(t = 5, r = 150, b = 5, l = 5)
    )
}

# Deskriptive Itemliste (Ergaenzungsskala und Items 96-105): Stufen-Badge + Antworttext,
# kein Summenscore, keine Norm.
bsl_item_liste_ui = function(items) {
  lapply(items, function(it) {
    if (!is.na(it$punktwert)) {
      sk = as.character(it$punktwert)
      badge_text = if (!is.na(it$antwort)) it$antwort else as.character(it$punktwert)
    } else {
      sk = "na"
      badge_text = "keine Angabe"
    }
    div(class = "item-zeile",
      div(class = "item-nr",   paste0(it$nr, ".")),
      div(class = "item-text", it$text),
      span(class = paste0("stufe-badge stufe-badge-", sk), badge_text)
    )
  })
}


# Datenaufbereitung ####

# 9 Normtabellen-CSVs, statisch beim App-Start geladen. Beim Fehlen einer Datei bricht die
# App mit einer klaren Fehlermeldung inkl. Dateiname ab, statt eine Tabelle stillschweigend
# zu ueberspringen.
BSL_NORM_DATEIEN = c(
  gesamtskala       = "gesamtskala.csv",
  selbstwahrnehmung = "selbstwahrnehmung.csv",
  affektregulation  = "affektregulation.csv",
  autoaggression    = "autoaggression.csv",
  dysphorie         = "dysphorie.csv",
  soziale_isolation = "soziale_isolation.csv",
  intrusionen       = "intrusionen.csv",
  feindseligkeit    = "feindseligkeit.csv",
  vas               = "vas_gesamtbefindlichkeit.csv"
)

bsl_lade_normtabellen = function(ordner, dateien) {
  tabs = list()
  for (nm in names(dateien)) {
    pfad = file.path(ordner, dateien[[nm]])
    if (!file.exists(pfad)) {
      stop(paste0(
        "Normtabelle fehlt: '", dateien[[nm]], "'. Erwartet unter: ", pfad, ". ",
        "Bitte alle 9 Normtabellen-CSVs gemaess Vorgabe in den Ordner '", ordner,
        "' legen, bevor die App gestartet wird."
      ))
    }
    tabs[[nm]] = read.csv(pfad, stringsAsFactors = FALSE)
  }
  tabs
}

BSL_NORMTABELLEN = bsl_lade_normtabellen(PFAD_NORMTABELLEN, BSL_NORM_DATEIEN)


# 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; }
.kritisch-block {
  background: #6D0000; color: white; border-radius: 6px;
  padding: 16px 20px; margin-bottom: 16px; border-left: 6px solid #FF6B6B;
}
.kritisch-block h4 { margin: 0 0 10px; font-size: 1.1rem; font-weight: 700; }
.kritisch-zeile {
  background: rgba(255,255,255,0.12); border-radius: 3px;
  padding: 8px 12px; margin: 6px 0; font-size: 0.92em; line-height: 1.5;
}
.kritisch-disclaimer {
  margin-top: 10px; font-size: 0.82em; opacity: 0.85; font-style: italic;
}
.subskala-titel-item {
  color: #8B2635; font-weight: 700; margin-top: 16px; margin-bottom: 4px;
  font-size: 0.95em; border-bottom: 1px solid #eee; padding-bottom: 3px;
}
.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; }
.stufe-badge-4  { background: #4A0000; color: white; }
.stufe-badge-na { background: #BBBBBB; color: white; }
"

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("BSL-105 – Borderline Symptom Liste"),
    tags$p("105-Item-Version | Einzelfall-Auswertung, ausschliesslich Prozentrang, kein Cutoff")
  ),

  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("kritisch_ui"),
    uiOutput("ergebnis_ui")
  )
)


# Word-Export ####

# Eine Item-Zeile (Nummer + Text + Antwort-Badge) im Word-Dokument, wiederverwendet fuer
# Einzelitems 1-95, Ergaenzungsskala und Items 96-105.
bsl_docx_item_zeile = function(doc, it, fp_normal) {
  stufe_key   = if (!is.na(it$punktwert)) as.character(it$punktwert) else NA_character_
  antwort_txt = if (!is.na(it$antwort)) it$antwort else "keine Angabe"
  fp_badge = fp_text(
    color         = if (!is.na(stufe_key)) BSL_BADGE_TEXT_FARBEN[[stufe_key]] else "#333333",
    bold          = TRUE,
    shading.color = if (!is.na(stufe_key)) BSL_BADGE_FARBEN[[stufe_key]] else "#BBBBBB",
    font.size     = 10
  )
  body_add_fpar(doc, fpar(
    ftext(paste0(it$nr, ". ", it$text, "  "), fp_normal),
    ftext(paste0(" ", antwort_txt, " "), fp_badge)
  ))
}

erstelle_bsl_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_klein          = fp_text(font.size = 9, italic = TRUE, color = "#777777")
  fp_disclaimer     = fp_text(font.size = 9, italic = TRUE, color = "#777777")
  fp_kritisch_titel = fp_text(color = "#B71C1C", bold = TRUE, font.size = 12)
  fp_kritisch_text  = fp_text(color = "#B71C1C", font.size = 10)

  doc = body_add_fpar(doc, fpar(ftext("BSL-105 – Einzelauswertung", 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 (length(erg$warnungen) > 0) {
    for (w in erg$warnungen) {
      doc = body_add_fpar(doc, fpar(ftext(w, fp_klein)))
    }
  }
  doc = body_add_par(doc, "", style = "Normal")

  if (length(erg$kritische_treffer) > 0) {
    doc = body_add_fpar(doc, fpar(ftext("Kritische Items", fp_kritisch_titel)))
    for (kt in erg$kritische_treffer) {
      doc = body_add_fpar(doc, fpar(
        ftext(paste0(kt$bezeichnung, ": ", kt$text), fp_kritisch_text)
      ))
      doc = body_add_fpar(doc, fpar(
        ftext(paste0("Antwort: ", kt$antwort, "  (", kt$schwelle_txt, ")"), fp_kritisch_text)
      ))
    }
    doc = body_add_fpar(doc, fpar(ftext(BSL_KRITISCH_DISCLAIMER, fp_klein)))
    doc = body_add_par(doc, "", style = "Normal")
  }

  doc = body_add_fpar(doc, fpar(ftext("Gesamtskala", fp_abschnitt)))
  ges = erg$gesamtskala
  ges_txt = if (!ges$auswertbar) {
    "nicht auswertbar (> 10% fehlende Werte)"
  } else {
    paste0(ges$rohwert, " / ", ges$max, "   Prozentrang: ",
           if (is.na(ges$prozentrang)) "k. A." else round(ges$prozentrang))
  }
  doc = body_add_fpar(doc, fpar(ftext(ges_txt, fp_normal)))
  doc = body_add_par(doc, "", style = "Normal")

  doc = body_add_fpar(doc, fpar(ftext("Subskalen", fp_abschnitt)))
  for (sk in erg$subskalen) {
    sk_txt = if (!sk$auswertbar) {
      "nicht auswertbar (> 10% fehlende Werte)"
    } else {
      paste0(sk$rohwert, " / ", sk$max, "   Prozentrang: ",
             if (is.na(sk$prozentrang)) "k. A." else round(sk$prozentrang))
    }
    doc = body_add_fpar(doc, fpar(
      ftext(paste0(sk$name, ": "), fp_label),
      ftext(sk_txt, fp_normal)
    ))
  }
  doc = body_add_par(doc, "", style = "Normal")

  doc = body_add_fpar(doc, fpar(ftext("VAS Gesamtbefindlichkeit", fp_abschnitt)))
  vas_txt = if (is.na(erg$vas$rohwert)) {
    "keine Angabe"
  } else {
    paste0(erg$vas$rohwert, " / 100   Prozentrang: ",
           if (is.na(erg$vas$prozentrang)) "k. A." else round(erg$vas$prozentrang))
  }
  doc = body_add_fpar(doc, fpar(ftext(vas_txt, fp_normal)))
  doc = body_add_par(doc, "", style = "Normal")

  doc = body_add_fpar(doc, fpar(ftext("Einzelitems 1–95 (nach Subskala gruppiert)", fp_abschnitt)))
  for (gruppe in erg$haupt_items) {
    doc = body_add_fpar(doc, fpar(ftext(gruppe$titel, fp_label)))
    for (it in gruppe$items) {
      doc = bsl_docx_item_zeile(doc, it, fp_normal)
    }
  }
  doc = body_add_par(doc, "", style = "Normal")

  doc = body_add_fpar(doc, fpar(ftext("Ergänzungsskala (deskriptiv, kein Summenscore)", fp_abschnitt)))
  for (it in erg$ergaenzung_items) {
    doc = bsl_docx_item_zeile(doc, it, fp_normal)
  }
  doc = body_add_par(doc, "", style = "Normal")

  doc = body_add_fpar(doc, fpar(ftext("Items 96–105 (deskriptiv, kein Summenscore)", fp_abschnitt)))
  for (it in erg$item_96_105) {
    doc = bsl_docx_item_zeile(doc, it, fp_normal)
  }

  doc = body_add_par(doc, "", style = "Normal")
  doc = body_add_fpar(doc, fpar(ftext(BSL_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 Patientenchiffre eingeben."))
    }
    if (!(nchar(trimws(input$pseudonym)) > 0 || grepl("^[A-Z][0-9]{6}$", chiffre))) {
      return(list(error = paste0(
        "Ungültige 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)))
    }

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

    treffer_ps = pseudo_df[pseudo_df$chiffre == chiffre, , drop = FALSE]
    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, , drop = FALSE]
    if (nrow(treffer_dat) == 0) {
      return(list(error = paste0(
        "Kein BSL-Datensatz für Chiffre '", chiffre, "' gefunden. ",
        "(", length(alle_session_ids), " Pseudonym(e) geprüft)")))
    }

    warnungen = character(0)
    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"
      )
      warnungen = c(warnungen, 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_posix = tryCatch(as.POSIXct(zeile[["created"]][1]), error = function(e) NULL)
    datum_ok    = !is.null(datum_posix) && length(datum_posix) > 0 && !is.na(datum_posix)
    ausfuelldatum = if (datum_ok) format(datum_posix, "%d.%m.%Y") else format(Sys.Date(), "%d.%m.%Y")
    ausfuelldatum_dateikennung = if (datum_ok) format(datum_posix, "%Y%m%d") else format(Sys.Date(), "%Y%m%d")

    # Hauptitems 1-105 -> Punktwerte (0-4), inkl. Items 96-105 (nur deskriptiv).
    haupt_punkte = setNames(
      lapply(1:105, function(i) {
        col = paste0("bsl_", sprintf("%03d", i))
        bsl_recode_item(zeile[[col]], ergaenzungsskala = FALSE)
      }),
      as.character(1:105)
    )

    # Ergaenzungsskala 1-11 -> Punktwerte (0-4).
    erg_punkte = setNames(
      lapply(1:11, function(i) {
        col = paste0("bsl_erg_", sprintf("%02d", i))
        bsl_recode_item(zeile[[col]], ergaenzungsskala = TRUE)
      }),
      as.character(1:11)
    )

    vas_rohwert = bsl_recode_vas(zeile[["bsl_vas"]])

    # 7 Subskalen: Rohwert -> Prozentrang, Missing-Regel (> 10% fehlend -> nicht auswertbar).
    subskalen_erg = lapply(BSL_SUBSKALEN, function(sk) {
      sc = bsl_score_skala(sk$items, haupt_punkte, sk$reverse)
      pr = if (sc$auswertbar) bsl_norm_lookup(BSL_NORMTABELLEN[[sk$norm_key]], sc$rohwert) else NA_real_
      list(
        name           = sk$name,
        rohwert        = sc$rohwert,
        max            = sk$max,
        anteil_fehlend = sc$anteil_fehlend,
        auswertbar     = sc$auswertbar,
        prozentrang    = pr
      )
    })

    # Gesamtskala = Summe Items 1-95 (mit Umpolung der Dysphorie-Umpolitems).
    gesamt_sc = bsl_score_skala(BSL_GESAMT_ITEMS, haupt_punkte, BSL_DYSPHORIE_REVERSE)
    gesamt_pr = if (gesamt_sc$auswertbar) {
      bsl_norm_lookup(BSL_NORMTABELLEN[["gesamtskala"]], gesamt_sc$rohwert)
    } else {
      NA_real_
    }
    gesamtskala = list(
      rohwert        = gesamt_sc$rohwert,
      max            = 380,
      anteil_fehlend = gesamt_sc$anteil_fehlend,
      auswertbar     = gesamt_sc$auswertbar,
      prozentrang    = gesamt_pr
    )

    vas_pr = bsl_norm_lookup(BSL_NORMTABELLEN[["vas"]], vas_rohwert, wert_spalte = "vas_wert")
    vas    = list(rohwert = vas_rohwert, prozentrang = vas_pr)

    # Einzelitems 1-95, nach Subskala gruppiert (zusaetzlich zur aggregierten Balkendarstellung).
    haupt_items = bsl_gruppiere_hauptitems(haupt_punkte, daten)

    # Ergaenzungsskala, rein deskriptiv (kein Summenscore, kein Cutoff, keine Norm).
    ergaenzung_items = lapply(1:11, function(i) {
      col   = paste0("bsl_erg_", sprintf("%02d", i))
      punkt = erg_punkte[[as.character(i)]]
      list(
        nr        = i,
        text      = bsl_item_label(daten[[col]], paste0("Ergänzungsitem ", i)),
        punktwert = punkt,
        antwort   = bsl_antwort_text(punkt, ergaenzungsskala = TRUE)
      )
    })

    # Items 96-105, rein deskriptiv (kein Summenscore, kein Cutoff, keine Norm).
    item_96_105 = lapply(96:105, function(i) {
      col   = paste0("bsl_", sprintf("%03d", i))
      punkt = haupt_punkte[[as.character(i)]]
      list(
        nr        = i,
        text      = bsl_item_label(daten[[col]], paste0("Item ", i)),
        punktwert = punkt,
        antwort   = bsl_antwort_text(punkt, ergaenzungsskala = FALSE)
      )
    })

    # Kritische Items: zwei unterschiedliche Schwellen (bewusst nicht identisch, siehe unten).
    # Hauptitems: Schwelle Stufe >= 2 ("ziemlich" oder staerker).
    kritisch_haupt_def = data.frame(
      item = c(18, 22, 62, 104),
      text = c(
        "... hatte ich Todessehnsucht",
        "... dachte ich an Selbstverletzungen",
        "... litt ich unter Selbstmordgedanken",
        "... hatte ich den Drang, mich selbst zu verletzen"
      ),
      schwelle = c(2L, 2L, 2L, 2L),
      stringsAsFactors = FALSE
    )
    # Ergaenzungsskala: Schwelle Stufe >= 1 ("1 mal" oder haeufiger) - abweichend niedriger
    # angesetzt, weil bei diesen beiden Items bereits ein einmaliges Vorkommnis klinisch
    # relevant ist.
    kritisch_erg_def = data.frame(
      item_nr = c(2L, 3L),
      text = c(
        "... äußerte ich mich gegenüber anderen, daß ich mich umbringen würde",
        "... machte ich einen Suizidversuch"
      ),
      schwelle = c(1L, 1L),
      stringsAsFactors = FALSE
    )

    kritische_treffer = list()
    for (i in seq_len(nrow(kritisch_haupt_def))) {
      item_nr = kritisch_haupt_def$item[i]
      punkt   = haupt_punkte[[as.character(item_nr)]]
      if (!is.na(punkt) && punkt >= kritisch_haupt_def$schwelle[i]) {
        kritische_treffer[[length(kritische_treffer) + 1]] = list(
          bezeichnung  = paste0("Item ", item_nr),
          text         = kritisch_haupt_def$text[i],
          antwort      = bsl_antwort_text(punkt, ergaenzungsskala = FALSE),
          schwelle_txt = paste0("Schwelle: Stufe >= ", kritisch_haupt_def$schwelle[i])
        )
      }
    }
    for (i in seq_len(nrow(kritisch_erg_def))) {
      item_nr = kritisch_erg_def$item_nr[i]
      punkt   = erg_punkte[[as.character(item_nr)]]
      if (!is.na(punkt) && punkt >= kritisch_erg_def$schwelle[i]) {
        kritische_treffer[[length(kritische_treffer) + 1]] = list(
          bezeichnung  = paste0("Ergänzungsitem ", item_nr),
          text         = kritisch_erg_def$text[i],
          antwort      = bsl_antwort_text(punkt, ergaenzungsskala = TRUE),
          schwelle_txt = paste0("Schwelle: Stufe >= ", kritisch_erg_def$schwelle[i])
        )
      }
    }

    list(
      error                      = NULL,
      chiffre                    = chiffre,
      ausfuelldatum              = ausfuelldatum,
      ausfuelldatum_dateikennung = ausfuelldatum_dateikennung,
      warnungen                  = warnungen,
      subskalen                  = subskalen_erg,
      gesamtskala                = gesamtskala,
      vas                        = vas,
      haupt_items                = haupt_items,
      ergaenzung_items           = ergaenzung_items,
      item_96_105                = item_96_105,
      kritische_treffer          = kritische_treffer
    )
  })

  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) || length(d$warnungen) == 0) return(NULL)
    tagList(lapply(d$warnungen, function(w) div(class = "alert-warnung", w)))
  })

  output$kritisch_ui = renderUI({
    req(input$btn_suchen)
    d = ergebnis_r()
    if (!is.null(d$error) || length(d$kritische_treffer) == 0) return(NULL)

    zeilen = lapply(d$kritische_treffer, function(kt) {
      div(class = "kritisch-zeile",
        tags$strong(paste0(kt$bezeichnung, ": ")), kt$text, tags$br(),
        tags$span(paste0("Antwort: ", kt$antwort, "  (", kt$schwelle_txt, ")"))
      )
    })

    div(class = "kritisch-block",
      tags$h4("Kritische Items – bitte gesondert beachten"),
      zeilen,
      div(class = "kritisch-disclaimer", BSL_KRITISCH_DISCLAIMER)
    )
  })

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

    ergaenzung_ui = bsl_item_liste_ui(d$ergaenzung_items)
    item96_105_ui = bsl_item_liste_ui(d$item_96_105)
    haupt_items_ui = lapply(d$haupt_items, function(gruppe) {
      tagList(
        div(class = "subskala-titel-item", gruppe$titel),
        bsl_item_liste_ui(gruppe$items)
      )
    })

    div(class = "abschnitt-karte",
      div(class = "abschnitt-titel", "BSL-105 – Auswertung"),

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

      tags$hr(),

      tags$h5("Gesamtskala und Subskalen (Prozentrang)"),
      plotOutput("profil_plot", height = "320px"),

      tags$hr(),

      tags$h5("VAS Gesamtbefindlichkeit"),
      plotOutput("vas_plot", height = "90px"),

      tags$hr(),

      tags$h5("Einzelitems 1–95 (nach Subskala gruppiert)"),
      div(haupt_items_ui),

      tags$hr(),

      tags$h5("Ergänzungsskala (11 Items, deskriptiv – kein Summenscore, keine Norm)"),
      div(ergaenzung_ui),

      tags$hr(),

      tags$h5("Items 96–105 (deskriptiv – kein Summenscore, keine Norm)"),
      div(item96_105_ui)
    )
  })

  # tryCatch hier bewusst NICHT nur zur Absicherung: Ein Rendering-Fehler soll als lesbarer
  # Text im Plotbereich erscheinen statt die Grafik nur stillschweigend leer zu lassen.
  output$profil_plot = renderPlot({
    req(input$btn_suchen)
    d = ergebnis_r()
    req(is.null(d$error))
    tryCatch(
      bsl_profil_plot(d$gesamtskala, d$subskalen),
      error = function(e) {
        ggplot() +
          annotate("text", x = 0, y = 0,
                   label = paste0("Fehler beim Erstellen der Grafik: ", e$message),
                   color = "#B71C1C", size = 4) +
          theme_void()
      }
    )
  }, bg = "transparent")

  output$vas_plot = renderPlot({
    req(input$btn_suchen)
    d = ergebnis_r()
    req(is.null(d$error))
    tryCatch(
      bsl_vas_plot(d$vas),
      error = function(e) {
        ggplot() +
          annotate("text", x = 0, y = 0,
                   label = paste0("Fehler beim Erstellen der Grafik: ", e$message),
                   color = "#B71C1C", size = 4) +
          theme_void()
      }
    )
  }, 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)
        d$chiffre else "export"
      datum_fn = if (is.list(d) && is.null(d$error) && !is.null(d$ausfuelldatum_dateikennung))
        d$ausfuelldatum_dateikennung else format(Sys.Date(), "%Y%m%d")
      paste0("BSL_", chiffre_esc, "_", datum_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_bsl_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)