
# =============================================================================
# CSS Utility Layer
# =============================================================================

#' Get default line color for HTML output
#'
#' Returns CSS variable reference for HTML tinytable engine,
#' otherwise returns "black". When using custom CSS with the tinytable
#' engine, users should define --tt-line-color in their CSS.
#'
#' @param x A tinytable object
#' @return Character string: "var(--tt-line-color)" or "black"
#' @keywords internal
#' @noRd
get_default_line_color <- function(x) {
  use_css_var <- identical(x@output, "html") &&
                 identical(x@html_engine, "tinytable")
  if (use_css_var) {
    "var(--tt-line-color)"
  } else if (identical(x@output, "typst")) {
    # NULL leaves the paint out of the Typst stroke, so the document's own
    # styling supplies it. See Issue #679.
    NULL
  } else {
    "black"
  }
}

style_to_css <- function(row) {
  out <- character()

  row$align <- map_align(row$align, "css")
  row$alignv <- map_alignv(row$alignv, "css")

  # simple properties
  if (isTRUE(row$bold))      out <- c(out, "font-weight: bold")
  if (isTRUE(row$italic))    out <- c(out, "font-style: italic")
  if (isTRUE(row$monospace)) out <- c(out, "font-family: monospace")
  if (isTRUE(row$smallcap))  out <- c(out, "font-variant: small-caps")
  if (!is.na(row$align))     {
    out <- c(out, paste0("text-align: ", row$align))
  }
  if (!is.na(row$alignv))    out <- c(out, paste0("vertical-align: ", row$alignv))
  if (!is.na(row$fontsize))  out <- c(out, paste0("font-size: ", format_markup_unit(row$fontsize, "em")))
  if (!is.na(row$indent))    out <- c(out, paste0("padding-left: ", format_markup_unit(row$indent, "em")))
  if (!is.na(row$color)) {
    out <- c(out, paste0("color: ", standardize_colors(row$color, "hex")))
  }
  if (!is.na(row$background)) {
    out <- c(out, paste0("background-color: ", standardize_colors(row$background, "hex")))
  }
  if (!is.na(row$html_css)) {
    out <- c(out, html_css = row$html_css)
  }

  # text decorations can be multiple
  td <- c()
  if (isTRUE(row$underline)) td <- c(td, "underline")
  if (isTRUE(row$strikeout)) td <- c(td, "line-through")
  if (length(td)) out <- c(out, paste0("text-decoration: ", paste(td, collapse = " ")))

  # combine
  out <- paste(out, collapse = "; ")
  return(out)
}

# Vectorized counterpart used by the HTML backend. Keeping the property order
# identical to style_to_css() preserves byte-for-byte CSS output while avoiding
# one-row data-frame extraction and S3 dispatch for every styled cell.
styles_to_css <- function(x) {
  n <- nrow(x)
  if (n == 0L) {
    return(character())
  }

  css <- matrix("", nrow = n, ncol = 12L)
  css[which(x$bold %in% TRUE), 1L] <- "font-weight: bold"
  css[which(x$italic %in% TRUE), 2L] <- "font-style: italic"
  css[which(x$monospace %in% TRUE), 3L] <- "font-family: monospace"
  css[which(x$smallcap %in% TRUE), 4L] <- "font-variant: small-caps"

  align <- map_align(x$align, "css")
  idx <- which(!is.na(align))
  css[idx, 5L] <- paste0("text-align: ", align[idx])

  alignv <- map_alignv(x$alignv, "css")
  idx <- which(!is.na(alignv))
  css[idx, 6L] <- paste0("vertical-align: ", alignv[idx])

  idx <- which(!is.na(x$fontsize))
  css[idx, 7L] <- paste0("font-size: ", format_markup_unit(x$fontsize[idx], "em"))
  idx <- which(!is.na(x$indent))
  css[idx, 8L] <- paste0("padding-left: ", format_markup_unit(x$indent[idx], "em"))

  color <- normalize_colors(x$color, "hex", default = NA_character_)
  idx <- which(!is.na(color))
  css[idx, 9L] <- paste0("color: ", color[idx])
  background <- normalize_colors(x$background, "hex", default = NA_character_)
  idx <- which(!is.na(background))
  css[idx, 10L] <- paste0("background-color: ", background[idx])

  idx <- which(!is.na(x$html_css))
  css[idx, 11L] <- x$html_css[idx]
  decorations <- paste(
    ifelse(x$underline %in% TRUE, "underline", ""),
    ifelse(x$strikeout %in% TRUE, "line-through", "")
  )
  decorations <- trimws(decorations)
  idx <- which(nzchar(decorations))
  css[idx, 12L] <- paste0("text-decoration: ", decorations[idx])

  apply(css, 1L, function(z) paste(z[nzchar(z)], collapse = "; "))
}


# Borders are drawn on the ::before and ::after pseudo-elements by the
# stylesheet in inst/tinytable.css. The default HTML output loads that
# stylesheet from a CDN, where an older version may still draw solid rules
# only. Emitting these rules alongside the table's own CSS makes dashed and
# dotted rules work with any version of the stylesheet.
line_type_css <- function(table_id) {
  sprintf(
    '    #%s :is(td, th)[class*="tinytable_css_"]::before { border-top: calc(var(--border-top) * var(--line-width-top)) var(--line-type-top, solid) var(--line-color-top); border-right: calc(var(--border-right) * var(--line-width-right)) var(--line-type-right, solid) var(--line-color-right); border-left: calc(var(--border-left) * var(--line-width-left)) var(--line-type-left, solid) var(--line-color-left); }
    #%s :is(td, th)[class*="tinytable_css_"]::after { height: 0; background: none; border-bottom: calc(var(--border-bottom) * var(--line-width-bottom)) var(--line-type-bottom, solid) var(--line-color-bottom); }',
    table_id,
    table_id
  )
}


line_to_css <- function(
  border_top = 0,
  border_right = 0,
  border_bottom = 0,
  border_left = 0,
  color_top = "black",
  color_right = "black",
  color_bottom = "black",
  color_left = "black",
  width_top = .1,
  width_right = .1,
  width_bottom = .1,
  width_left = .1,
  type_top = "solid",
  type_right = "solid",
  type_bottom = "solid",
  type_left = "solid",
  trim_top_left = 0,
  trim_top_right = 0,
  trim_bottom_left = 0,
  trim_bottom_right = 0,
  trim_left_top = 0,
  trim_left_bottom = 0,
  trim_right_top = 0,
  trim_right_bottom = 0
) {
  width_bottom <- format_markup_num(width_bottom)
  width_left <- format_markup_num(width_left)
  width_right <- format_markup_num(width_right)
  width_top <- format_markup_num(width_top)
  trim_bottom_left <- format_markup_num(trim_bottom_left)
  trim_bottom_right <- format_markup_num(trim_bottom_right)
  trim_left_bottom <- format_markup_num(trim_left_bottom)
  trim_left_top <- format_markup_num(trim_left_top)
  trim_right_bottom <- format_markup_num(trim_right_bottom)
  trim_right_top <- format_markup_num(trim_right_top)
  trim_top_left <- format_markup_num(trim_top_left)
  trim_top_right <- format_markup_num(trim_top_right)

  out <- sprintf('
    position: relative;
    --border-bottom: %s;
    --border-left: %s;
    --border-right: %s;
    --border-top: %s;
    --line-color-bottom: %s;
    --line-color-left: %s;
    --line-color-right: %s;
    --line-color-top: %s;
    --line-width-bottom: %sem;
    --line-width-left: %sem;
    --line-width-right: %sem;
    --line-width-top: %sem;
    --line-type-bottom: %s;
    --line-type-left: %s;
    --line-type-right: %s;
    --line-type-top: %s;
    --trim-bottom-left: %s%%;
    --trim-bottom-right: %s%%;
    --trim-left-bottom: %s%%;
    --trim-left-top: %s%%;
    --trim-right-bottom: %s%%;
    --trim-right-top: %s%%;
    --trim-top-left: %s%%;
    --trim-top-right: %s%%;
    ',
    border_bottom, border_left, border_right, border_top,
    color_bottom, color_left, color_right, color_top,
    width_bottom, width_left, width_right, width_top,
    type_bottom, type_left, type_right, type_top,
    trim_bottom_left, trim_bottom_right, trim_left_bottom, trim_left_top,
    trim_right_bottom, trim_right_top, trim_top_left, trim_top_right
  )
  gsub("\\s+", " ", out)
}




#' Internal styling function
#'
#' @inheritParams style_tt
#' @keywords internal
#' @noRd
setMethod(
  f = "style_eval",
  signature = "tinytable_html",
  definition = function(
    x,
    i = NULL,
    j = NULL,
    bold = FALSE,
    italic = FALSE,
    monospace = FALSE,
    underline = FALSE,
    strikeout = FALSE,
    color = NULL,
    background = NULL,
    fontsize = NULL,
    align = NULL,
    alignv = NULL,
    line = NULL,
    line_color = NULL,
    line_width = 0.1,
    colspan = NULL,
    rowspan = NULL,
    indent = 0,
    ...
  ) {
    # Set default line color based on context
    if (is.null(line_color)) {
      line_color <- get_default_line_color(x)
    }
    # CSS rule will be handled by finalize() via template substitution
    # Removed duplicate html_setting call that was causing CSS duplication

    # Use populated @style_other / @style_lines from build_tt()
    inputs <- style_backend_inputs(x, STYLE_PROPS_HTML)
    other <- inputs$other
    lines <- inputs$lines


    # rowspan/colspan spans first
    if (!is.null(other) && nrow(other) > 0) {
      rowspan <- if ("rowspan" %in% names(other)) {
        ifelse(is.na(other$rowspan), 1, other$rowspan)
      } else {
        rep(1, nrow(other))
      }
      colspan <- if ("colspan" %in% names(other)) {
        ifelse(is.na(other$colspan), 1, other$colspan)
      } else {
        rep(1, nrow(other))
      }
      # Skip JavaScript spans for column group headers (negative i) since HTML already handles them via colspan
      idx <- which((rowspan > 1 | colspan > 1) & other$i >= 0)
      if (length(idx) > 0) {
        # Use the factory function approach instead of individual function names
        listeners <- sprintf(
          "      window.addEventListener('load', function () { tableFns_%s.spanCell(%s, %s, %s, %s) })",
          x@id,
          other$i[idx],
          other$j[idx],
          rowspan[idx],
          colspan[idx]
        )
        x@table_string <- lines_insert(
          x@table_string,
          paste(rev(listeners), collapse = "\n"),
          "tinytable span after",
          "after"
        )
      }
    }


    # Collect all styles per cell first, then consolidate
    cell_styles <- list()

    # Dashed and dotted rules need CSS rules which may be missing from an older
    # stylesheet loaded from the CDN. Inject a scoped override when used.
    needs_line_type_css <- FALSE

    # Process line styles - vectorized approach
    if (!is.null(lines) && nrow(lines) > 0) {
      # Use interaction() for compact cell keys
      lines$cell_key <- interaction(lines$i, lines$j, drop = TRUE)

      # Precompute direction booleans once (vectorized regex)
      has_t <- grepl("t", lines$line)
      has_r <- grepl("r", lines$line)
      has_b <- grepl("b", lines$line)
      has_l <- grepl("l", lines$line)

      # Precompute trim booleans once
      lines$line_trim <- ifelse(is.na(lines$line_trim), "", lines$line_trim)
      trim_l <- grepl("l", lines$line_trim)
      trim_r <- grepl("r", lines$line_trim)

      # Map colors to hex (preserve CSS variables, fallback to "black")
      lines$color_hex <- normalize_colors(
        lines$line_color, "hex", preserve_css_vars = TRUE
      )

      # Default widths
      lines$line_width <- ifelse(is.na(lines$line_width), 0.1, lines$line_width)

      # Default line type
      if (!"line_type" %in% names(lines)) {
        lines$line_type <- NA_character_
      }
      needs_line_type_css <- any(
        !is.na(lines$line_type) & lines$line_type != "solid"
      )

      # Aggregate per direction using tapply per cell_key
      cells_unique <- levels(lines$cell_key)

      # Helper to aggregate border flags (any TRUE)
      agg_any <- function(x, cell_key, has_dir) {
        tapply(has_dir, cell_key, any, default = FALSE)[cells_unique]
      }

      # Helper to aggregate widths (max)
      agg_max_width <- function(x, cell_key, has_dir, width) {
        tapply(
          ifelse(has_dir, width, NA),
          cell_key,
          function(v) if (all(is.na(v))) 0.1 else max(v, na.rm = TRUE),
          default = 0.1
        )[cells_unique]
      }

      # Helper to aggregate colors (first non-default)
      agg_first_color <- function(x_obj, cell_key, has_dir, color) {
        default_color <- get_default_line_color(x)
        tapply(
          ifelse(has_dir, color, NA_character_),
          cell_key,
          function(v) {
            v <- v[!is.na(v)]
            if (length(v) > 0) v[1] else default_color
          },
          default = default_color
        )[cells_unique]
      }

      # Helper to aggregate line types (first non-default, mirrors colors)
      agg_first_type <- function(cell_key, has_dir, type) {
        tapply(
          ifelse(has_dir, type, NA_character_),
          cell_key,
          function(v) {
            v <- v[!is.na(v)]
            if (length(v) > 0) v[1] else "solid"
          },
          default = "solid"
        )[cells_unique]
      }

      # Aggregate border flags
      border_top <- agg_any(lines, lines$cell_key, has_t)
      border_right <- agg_any(lines, lines$cell_key, has_r)
      border_bottom <- agg_any(lines, lines$cell_key, has_b)
      border_left <- agg_any(lines, lines$cell_key, has_l)

      # Aggregate widths
      width_top <- agg_max_width(lines, lines$cell_key, has_t, lines$line_width)
      width_right <- agg_max_width(lines, lines$cell_key, has_r, lines$line_width)
      width_bottom <- agg_max_width(lines, lines$cell_key, has_b, lines$line_width)
      width_left <- agg_max_width(lines, lines$cell_key, has_l, lines$line_width)

      # Aggregate colors
      color_top <- agg_first_color(lines, lines$cell_key, has_t, lines$color_hex)
      color_right <- agg_first_color(lines, lines$cell_key, has_r, lines$color_hex)
      color_bottom <- agg_first_color(lines, lines$cell_key, has_b, lines$color_hex)
      color_left <- agg_first_color(lines, lines$cell_key, has_l, lines$color_hex)

      # Aggregate line types
      type_top <- agg_first_type(lines$cell_key, has_t, lines$line_type)
      type_right <- agg_first_type(lines$cell_key, has_r, lines$line_type)
      type_bottom <- agg_first_type(lines$cell_key, has_b, lines$line_type)
      type_left <- agg_first_type(lines$cell_key, has_l, lines$line_type)

      # Aggregate trim flags (any TRUE, multiply by 3 at end)
      trim_top_left <- tapply(trim_l & has_t, lines$cell_key, any, default = FALSE)[cells_unique] * 3
      trim_top_right <- tapply(trim_r & has_t, lines$cell_key, any, default = FALSE)[cells_unique] * 3
      trim_bottom_left <- tapply(trim_l & has_b, lines$cell_key, any, default = FALSE)[cells_unique] * 3
      trim_bottom_right <- tapply(trim_r & has_b, lines$cell_key, any, default = FALSE)[cells_unique] * 3
      # line_trim only encodes "l"/"r", so both ends of a vertical border share
      # the same trim value: compute once per side and reuse.
      trim_left <- tapply(trim_l & has_l, lines$cell_key, any, default = FALSE)[cells_unique] * 3
      trim_left_top <- trim_left_bottom <- trim_left
      trim_right <- tapply(trim_r & has_r, lines$cell_key, any, default = FALSE)[cells_unique] * 3
      trim_right_top <- trim_right_bottom <- trim_right

      # Get first (i,j) per cell_key
      first_idx <- match(cells_unique, lines$cell_key)
      cell_i <- lines$i[first_idx]
      cell_j <- lines$j[first_idx]

      # Filter to cells with at least one border
      has_border_mask <- border_top | border_right | border_bottom | border_left

      if (any(has_border_mask)) {
        # Build consolidated data.frame
        line_params <- data.frame(
          i = cell_i[has_border_mask],
          j = cell_j[has_border_mask],
          border_top = as.integer(border_top[has_border_mask]),
          border_right = as.integer(border_right[has_border_mask]),
          border_bottom = as.integer(border_bottom[has_border_mask]),
          border_left = as.integer(border_left[has_border_mask]),
          color_top = color_top[has_border_mask],
          color_right = color_right[has_border_mask],
          color_bottom = color_bottom[has_border_mask],
          color_left = color_left[has_border_mask],
          width_top = width_top[has_border_mask],
          width_right = width_right[has_border_mask],
          width_bottom = width_bottom[has_border_mask],
          width_left = width_left[has_border_mask],
          type_top = type_top[has_border_mask],
          type_right = type_right[has_border_mask],
          type_bottom = type_bottom[has_border_mask],
          type_left = type_left[has_border_mask],
          trim_top_left = trim_top_left[has_border_mask],
          trim_top_right = trim_top_right[has_border_mask],
          trim_bottom_left = trim_bottom_left[has_border_mask],
          trim_bottom_right = trim_bottom_right[has_border_mask],
          trim_left_top = trim_left_top[has_border_mask],
          trim_left_bottom = trim_left_bottom[has_border_mask],
          trim_right_top = trim_right_top[has_border_mask],
          trim_right_bottom = trim_right_bottom[has_border_mask],
          stringsAsFactors = FALSE
        )

        # Call line_to_css() once per cell via mapply (vectorized)
        css_results <- mapply(
          line_to_css,
          border_top = line_params$border_top,
          border_right = line_params$border_right,
          border_bottom = line_params$border_bottom,
          border_left = line_params$border_left,
          color_top = line_params$color_top,
          color_right = line_params$color_right,
          color_bottom = line_params$color_bottom,
          color_left = line_params$color_left,
          width_top = line_params$width_top,
          width_right = line_params$width_right,
          width_bottom = line_params$width_bottom,
          width_left = line_params$width_left,
          type_top = line_params$type_top,
          type_right = line_params$type_right,
          type_bottom = line_params$type_bottom,
          type_left = line_params$type_left,
          trim_top_left = line_params$trim_top_left,
          trim_top_right = line_params$trim_top_right,
          trim_bottom_left = line_params$trim_bottom_left,
          trim_bottom_right = line_params$trim_bottom_right,
          trim_left_top = line_params$trim_left_top,
          trim_left_bottom = line_params$trim_left_bottom,
          trim_right_top = line_params$trim_right_top,
          trim_right_bottom = line_params$trim_right_bottom,
          SIMPLIFY = TRUE,
          USE.NAMES = FALSE
        )

        # Filter non-empty CSS and build cell_styles list
        has_css <- nzchar(css_results)
        if (any(has_css)) {
          for (idx in which(has_css)) {
            cell_key <- paste(line_params$i[idx], line_params$j[idx], sep = "_")
            cell_styles[[cell_key]] <- list(
              i = line_params$i[idx],
              j = line_params$j[idx],
              css = "",
              css_before = "",
              css_after = "",
              has_border = TRUE,
              consolidated_line_css = css_results[idx]
            )
          }
        }
      }
    }

    # Process other styles - vectorized
    if (!is.null(other) && nrow(other) > 0) {
      css_rules <- styles_to_css(other)

      # Filter to non-empty CSS
      has_css <- nzchar(css_rules)
      if (any(has_css)) {
        other_final <- other[has_css, , drop = FALSE]
        css_final <- css_rules[has_css]
        # (i,j) keys are unique: @style_other has one row per cell
        cell_keys_final <- paste(other_final$i, other_final$j, sep = "_")

        # Build cell_styles entries
        for (idx in seq_along(css_final)) {
          cell_key <- cell_keys_final[idx]

          if (is.null(cell_styles[[cell_key]])) {
            cell_styles[[cell_key]] <- list(
              i = other_final$i[idx],
              j = other_final$j[idx],
              css = "",
              css_before = "",
              css_after = "",
              has_border = FALSE
            )
          }

          cell_styles[[cell_key]]$css <- css_final[idx]
        }
      }
    }

    # Early exit if no styles
    if (length(cell_styles) == 0) {
      return(x)
    }

    # Convert cell_styles list to data.frame for vectorized operations
    n_cells <- length(cell_styles)
    css_df <- data.frame(
      i = integer(n_cells),
      j = integer(n_cells),
      line_css = character(n_cells),
      other_css = character(n_cells),
      has_border = logical(n_cells),
      stringsAsFactors = FALSE
    )

    css_df$i <- vapply(cell_styles, `[[`, numeric(1), "i")
    css_df$j <- vapply(cell_styles, `[[`, numeric(1), "j")
    css_df$line_css <- vapply(
      cell_styles,
      function(z) z$consolidated_line_css %||% "",
      character(1)
    )
    css_df$other_css <- vapply(cell_styles, `[[`, character(1), "css")
    css_df$has_border <- vapply(cell_styles, `[[`, logical(1), "has_border")

    # Merge line_css and other_css
    has_line <- nzchar(css_df$line_css)
    has_other <- nzchar(css_df$other_css)

    css_df$merged_css <- ifelse(
      has_line & has_other,
      paste(css_df$line_css, css_df$other_css, sep = "; "),
      ifelse(has_line, css_df$line_css, css_df$other_css)
    )

    # Filter to non-empty CSS
    css_df <- css_df[nzchar(css_df$merged_css), , drop = FALSE]

    if (nrow(css_df) == 0) {
      return(x)
    }

    # Group by CSS rule and border status using interaction
    css_df$group_key <- interaction(css_df$merged_css, css_df$has_border, drop = TRUE)

    # For each group, collect cells (split() preserves the factor level order,
    # matching the previous per-level scan)
    css_groups <- lapply(split(css_df, css_df$group_key), function(group_rows) {
      list(
        css_rule = group_rows$merged_css[1],
        has_border = group_rows$has_border[1],
        i = group_rows$i,
        j = group_rows$j,
        first_j = group_rows$j[1],
        first_i = group_rows$i[1]
      )
    })

    # Generate CSS rules for each unique group
    # Sort groups by the first cell's coordinates to ensure deterministic ordering
    group_keys_sorted <- names(css_groups)
    if (length(group_keys_sorted) > 0) {
      # Two-key sort: column first, then row (a combined j * 10000 + i key
      # collides for tables with 10000+ rows)
      first_j <- sapply(css_groups, function(g) g$first_j, USE.NAMES = FALSE)
      first_i <- sapply(css_groups, function(g) g$first_i, USE.NAMES = FALSE)
      group_keys_sorted <- group_keys_sorted[order(first_j, first_i)]
    }

    style_arrays <- css_entries <- character(length(group_keys_sorted))
    for (group_idx in seq_along(group_keys_sorted)) {
      group_key <- group_keys_sorted[group_idx]
      group_data <- css_groups[[group_key]]
      css_rule <- group_data$css_rule
      has_border <- group_data$has_border

      # Generate unique ID for this CSS rule
      id_css <- get_id(stem = "tinytable_css_")

      # Generate position array for all cells with this styling
      cell_positions <- sprintf("{ i: '%s', j: %s }", group_data$i, group_data$j)
      arr <- c(
        "          {",
        " positions: [ ",
        paste(cell_positions, collapse = ", "),
        " ],",
        " css_id: '",
        id_css,
        "',",
        "}, "
      )
      arr <- paste(arr, collapse = "")
      style_arrays[group_idx] <- arr

      # Generate CSS entry - scoped to table ID to prevent CSS cascade conflicts
      table_id <- paste0("tinytable_", x@id)
      entry <- sprintf(
        "    #%s td.%s, #%s th.%s { %s }",
        table_id, id_css, table_id, id_css, css_rule
      )
      css_entries[group_idx] <- entry
    }

    if (needs_line_type_css) {
      css_entries <- c(line_type_css(paste0("tinytable_", x@id)), css_entries)
    }

    if (length(style_arrays) > 0) {
      x@table_string <- lines_insert_after_fixed(
        x@table_string,
        c("tinytable style arrays after", "tinytable css entries after"),
        c(
          paste(rev(style_arrays), collapse = "\n"),
          paste(rev(css_entries), collapse = "\n")
        )
      )
    }


    return(x)
  }
)
