.plt.dist.facet <-
function(x, facet1, facet2, facet1.name, facet2.name,
         render = "density",
         bandwidth = "nrd0", kind = "both", histo = TRUE,
         fill_hist = "transparent", col_nrm = "transparent",
         fill_nrm = "transparent", col_gen, fill_gen, lwd = NULL,
         rug = FALSE, color_rug = "gray40", size_rug = 0.5,
         full_curve = TRUE, theme = getOption("theme"),
         x.min = NULL, x.max = NULL,
         stat = "count", breaks = NULL, bin_start = NULL, bin_width = NULL,
         bin_end = NULL, fill_area = TRUE,
         axis_fmt = "K", axis_x_pre = "", axis_y_pre = "",
         x.lab = NULL, y_axis = FALSE, n_row = NULL, n_col = NULL, quiet) {

  freqpoly <- render == "freq_poly"
  if (freqpoly) y_axis <- TRUE  # counts / proportions are the point of the y

  # save graphics state ONCE, restore on exit
  old.par <- par(no.readonly = TRUE)
  on.exit({
    ro <- c("cin", "cra", "csi", "cxy", "din", "page")
    par(old.par[setdiff(names(old.par), ro)])
  }, add = TRUE)

  # panel-strip label:  VarName = "level"  (quote non-numeric levels only),
  #   matching the faceted contour/smooth/hexbin forms
  .lab.lv <- function(nm, lv) {
    q <- ifelse(is.na(suppressWarnings(as.numeric(lv))),
                paste0('"', lv, '"'), lv)
    paste0(nm, " = ", q)
  }

  # -------------------------------------------------------------------------
  # build the panel grid: one distribution per facet cell
  if (!is.factor(facet1)) facet1 <- factor(facet1)
  lv1 <- levels(droplevels(facet1))

  if (!is.null(facet2)) {  # two facets: rows = facet2, cols = facet1
    if (!is.factor(facet2)) facet2 <- factor(facet2)
    lv2 <- levels(droplevels(facet2))
    nc <- length(lv1); nr <- length(lv2)
    cells <- expand.grid(c1 = lv1, c2 = lv2, stringsAsFactors = FALSE)
    cells <- cells[order(match(cells$c2, lv2), match(cells$c1, lv1)), ]
    sel <- Map(function(a, b) which(facet1 == a & facet2 == b),
               cells$c1, cells$c2)
    labs <- paste0(.lab.lv(facet1.name, cells$c1), ", ",
                   .lab.lv(facet2.name, cells$c2))
  }
  else {  # one facet: near-square grid unless n_row / n_col supplied
    k <- length(lv1)
    if (!is.null(n_col))      { nc <- n_col; nr <- ceiling(k / nc) }
    else if (!is.null(n_row)) { nr <- n_row; nc <- ceiling(k / nr) }
    else { nc <- ceiling(sqrt(k)); nr <- ceiling(k / nc) }
    sel <- lapply(lv1, function(a) which(facet1 == a))
    labs <- .lab.lv(facet1.name, lv1)
  }

  # -------------------------------------------------------------------------
  # first pass: per-panel estimates, and the shared x-range / y-max so panels
  #   are directly comparable
  est <- vector("list", length(sel))
  y.max <- 0
  xr <- NULL

  if (freqpoly) {
    # common bins across panels so the counts are comparable
    xa <- x[is.finite(x)]
    if (!is.null(bin_width) || !is.null(bin_start)) {
      if (is.null(bin_start)) bin_start <- pretty(range(xa))[1]
      if (is.null(bin_width))
        bin_width <- diff(graphics::hist(xa, plot = FALSE)$breaks[1:2])
      end <- if (!is.null(bin_end)) bin_end else max(xa)
      brk <- seq(bin_start, end, bin_width)
      while (max(brk) < max(xa)) brk <- seq(bin_start, max(brk) + bin_width,
                                            bin_width)
    } else if (!is.null(breaks)) brk <- breaks
    else brk <- graphics::hist(xa, plot = FALSE, breaks = "Sturges")$breaks
    for (i in seq_along(sel)) {
      xi <- x[sel[[i]]]; xi <- xi[is.finite(xi)]
      if (length(xi) < 1) next
      h <- graphics::hist(xi, breaks = brk, plot = FALSE)
      val <- if (stat == "proportion") h$counts / sum(h$counts) else h$counts
      est[[i]] <- list(mids = h$mids, val = val, bw = diff(brk)[1])
      y.max <- max(y.max, max(val))
    }
    xr <- range(brk)
  }
  else {  # density
    for (i in seq_along(sel)) {
      xi <- x[sel[[i]]]; xi <- xi[is.finite(xi)]
      if (length(xi) < 2 || stats::sd(xi) == 0) next  # too few / no spread
      h     <- graphics::hist(xi, plot = FALSE, breaks = "Sturges")
      d.gen <- suppressWarnings(stats::density(xi, bw = bandwidth))
      est[[i]] <- list(xi = xi, h = h, d.gen = d.gen,
                       mean = mean(xi), sd = stats::sd(xi))
      y.max <- max(y.max, max(d.gen$y), if (histo) max(h$density) else 0)
      xr <- range(c(xr, if (full_curve) range(d.gen$x) else range(xi)))
    }
  }
  if (is.null(xr)) {
    cat("\n"); stop(call. = FALSE, "\n------\n",
      "No facet cell has enough data to plot.\n\n")
  }
  if (is.null(x.min)) x.min <- xr[1]
  if (is.null(x.max)) x.max <- xr[2]

  # normal curve also contributes to y-max (evaluated on the shared grid)
  if (!freqpoly && kind %in% c("normal", "both")) {
    xx <- seq(x.min, x.max, length = 200)
    for (i in seq_along(est)) if (!is.null(est[[i]])) {
      dn <- stats::dnorm(xx, est[[i]]$mean, est[[i]]$sd)
      y.max <- max(y.max, max(dn))
    }
  }

  axT1 <- pretty(c(x.min, x.max))
  lbl.x <- .axis.format(axT1, axis_fmt, axis_x_pre, axis_y_pre = "no")
  ayT2 <- pretty(c(0, y.max))
  lbl.y <- .axis.format(ayT2, axis_fmt, axis_x_pre = "no", axis_y_pre)

  # -------------------------------------------------------------------------
  # draw the grid
  ax <- .axes_dim()
  col.bg  <- getOption("panel_fill")
  col.box <- getOption("panel_color")
  par(bg = getOption("window_fill"))
  par(oma = c(3.4, if (y_axis) 4.6 else 2.4, 1.0, 0.8))
  par(mfrow = c(nr, nc))
  par(mgp = c(3.5, 0.4, 0), tcl = -0.25)

  fill_gen_tr <- .maketrans(fill_gen, 100)

  for (i in seq_len(nr * nc)) {
    row.i <- ((i - 1) %/% nc) + 1
    col.i <- ((i - 1) %%  nc) + 1
    last.row  <- row.i == nr
    first.col <- col.i == 1

    par(mar = c(0.6, 0.6, 1.5, 0.5))
    plot.new()
    plot.window(xlim = c(x.min, x.max), ylim = c(0, y.max))
    rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4],
         col = col.bg, border = col.box)

    if (i <= length(est) && !is.null(est[[i]])) {
      e <- est[[i]]
      if (freqpoly) {
        # frequency polygon: bin values at midpoints, dropped to zero one bin
        #   beyond each end; optional fill under the line
        px <- c(e$mids[1] - e$bw, e$mids, e$mids[length(e$mids)] + e$bw)
        py <- c(0, e$val, 0)
        lwd.fp <- if (!is.null(lwd)) lwd else 1.35
        if (fill_area)
          polygon(px, py, col = fill_gen_tr, border = col_gen, lwd = lwd.fp)
        else
          lines(px, py, col = col_gen, lwd = lwd.fp)
      }
      else {
        if (histo)
          plot(e$h, add = TRUE, freq = FALSE, col = fill_hist,
               border = "transparent")
        if (kind %in% c("normal", "both")) {
          xx <- seq(x.min, x.max, length = 200)
          dn <- stats::dnorm(xx, e$mean, e$sd)
          lwd.nrm <- if (!is.null(lwd)) lwd
                     else if (fill_nrm == "transparent") 1.35 else 1
          polygon(c(x.min, xx, x.max), c(0, dn, 0), col = fill_nrm,
                  border = col_nrm, lwd = lwd.nrm)
        }
        if (kind %in% c("general", "both")) {
          lwd.gen <- if (!is.null(lwd)) lwd
                     else if (fill_gen == "transparent") 1.35 else 1
          polygon(e$d.gen, col = fill_gen_tr, border = col_gen, lwd = lwd.gen)
        }
        if (rug) rug(e$xi, col = color_rug, lwd = size_rug, ticksize = 0.05)
      }
    }

    if (last.row)
      axis(1, at = axT1, labels = lbl.x, cex.axis = ax$axis_x_size,
           col.axis = ax$axis_x_text_color)
    if (first.col && y_axis)
      axis(2, at = ayT2, labels = lbl.y, cex.axis = ax$axis_y_size,
           col.axis = ax$axis_y_text_color)
    if (i <= length(labs))
      title(main = labs[i], cex.main = getOption("lab_size") * 1.05,
            col.main = getOption("lab_color"), font.main = 1, line = 0.3)
    box(col = col.box)
  }

  # shared axis titles in the outer margin
  lab.cex <- getOption("lab_size") * 1.15
  mtext(x.lab, side = 1, outer = TRUE, line = 1.6, cex = lab.cex,
        col = getOption("lab_color"))
  if (y_axis) {
    y.lab <- if (!freqpoly) "Density"
             else if (stat == "proportion") "Proportion" else "Count"
    mtext(y.lab, side = 2, outer = TRUE, line = 2.8, cex = lab.cex,
          col = getOption("lab_color"))
  }

  # on.exit() restores par
}
