.bc.main <-
function(x, y, by, stack100,
         fill, color, trans,
         fill_split, fill_scaled, fill_chroma, fill_palette, theme,
         horiz, gap, prop, scale_y,
         xlab, ylab, main,
         label_max, beside,
         rotate_x, offset,
         axis_fmt, axis_x_pre, axis_y_pre,
         break_x, sort,
         labels, labels_color, labels_size, labels_decimals,
         labels_pos, labels_cut,
         xlab_adj, ylab_adj, bm.adj, lm.adj, tm.adj, rm.adj,
         pad_y_min, pad_y_max,
         legend_title, legend_position, legend_labels,
         legend_horiz, legend_size, legend_abbrev, legend_adj,
         add, x1, x2, y1, y2, out_size, do_plot, use_plotly, quiet,
         shiny, digits_d, ...) {


  multi <- ifelse (is.data.frame(x), TRUE, FALSE)
  is.ord <- ifelse (is.ordered(x) || is.ordered(by), TRUE, FALSE)

  if (stack100) prop <- TRUE
  if (!is.null(by)  &&  prop) stack100 <- TRUE  # prop deprecated

  # if x is integer, not labeled correctly, set to factor
  if (!is.data.frame(x))
    if (length(unique(x)) != length(x)) if (!is.factor(x)) x <- factor(x)

  if ( (is.table(x) || is.matrix(x)) && is.null(legend_title) ) {
    cat("\n"); stop(call.=FALSE, "\n","------\n",
    "Need to specify a value for:  legend_title\n\n")
  }

  # --------------------------------------
  # axis values, axis labels, legend setup

  # get axis_x_cex, axis_y_cex
  axis_x_cex <- ifelse(is.null(getOption("axis_x_cex")),
    getOption("axis_cex"), getOption("axis_x_cex"))
  axis_y_cex <- ifelse(is.null(getOption("axis_y_cex")),
    getOption("axis_cex"), getOption("axis_y_cex"))
# adj <- .RSadj(axis_cex=axis_x_cex); axis_x_cex <- adj$axis_cex
# adj <- .RSadj(axis_cex=axis_y_cex); axis_y_cex <- adj$axis_cex

  # get lab_x_cex  lab_y_cex
  lab_cex <- getOption("lab_cex")
  lab_x_cex <- getOption("lab_x_cex")
  lab_y_cex <- getOption("lab_y_cex")
  lab_x_cex <- ifelse(is.null(lab_x_cex), lab_cex, lab_x_cex)
  lab_y_cex <- ifelse(is.null(lab_y_cex), lab_cex, lab_y_cex)
# adj <- .RSadj(lab_cex=lab_x_cex); lab_x_cex <- adj$lab_cex
# adj <- .RSadj(lab_cex=lab_y_cex); lab_y_cex <- adj$lab_cex
# if (shiny) {  # only current use of arg: shiny
#   axis_x_cex <- 1.08 * axis_x_cex
#   axis_y_cex <- 1.08 * axis_y_cex
#   lab_x_cex <- 1.15 * lab_x_cex
#   lab_y_cex <- 1.15 * lab_y_cex
# }

  gl <- .getlabels(xlab, ylab, main, by.nm=TRUE, lab_x_cex=lab_x_cex,
                   lab_y_cex=lab_y_cex, flip=horiz)
  x.name <- gl$xn;  x.lbl <- gl$xl;  y.lbl <- gl$yl
  x.lab <- ifelse (horiz, gl$yb, gl$xb)
  main.lab <- gl$mb
  sub.lab <- gl$sb
  by.name <- y.lbl
  if (!is.null(by) || is.data.frame(x))
    by.name <- getOption("byname")
  ylab_keep <- ifelse (is.null(ylab), FALSE, TRUE)

  if (ylab_keep) {
      y.lab <- ylab
  }
  else {  # First part of y-axis label
    if (!is.vector(x)) {
      txt <- "Proportion"
      if (!is.null(by) && prop && !beside) {
        txt <- paste("Cell % within")
      }
      if (is.null(y))
         if (!prop) ylab <- "Count" else ylab <- txt
    }
    else {
      y.lab <- x.name
      if (length(unique(x)) != length(x)) x.lab <- ""
    }
  }

  if (is.null(ylab))
    done <- FALSE
  else
    done <- ifelse (grepl("of", ylab, fixed=TRUE), TRUE, FALSE)

  if (!ylab_keep) {
    if ((!prop || is.null(by)) && is.null(y) && !done &&
         !is.vector(x))
      y.lab <- paste(ylab, "of", x.name)
    if (!is.null(by)) {
      if (!beside) {
        txt <- paste(ylab, "of", x.name)
        y.lab <- ifelse (!prop,
                         txt, paste(ylab, x.name, "by", by.name))
      }
      else {
        if (!prop)
          y.lab <- "Count"
        else
          y.lab <- "Percentage"
      }
    }
    if (!is.null(y)) y.lab <- getOption("yname")
  }

  if (is.matrix(x)) {  # get the variable names as counts entered directly
    options(xname = x.lab)
    options(byname = legend_title)
  }

  # get legend title, l.lab
  if (!is.null(legend_title))
    l.lab <- legend_title
  else
    if (horiz) {
      if (!is.null(by)) if (exists("x.lbl")) {
        if (length(x.lbl) == 0)
          l.lab <-  by.name
        else
          l.lab <- paste(by.name, ": ", x.lbl, sep="")
      }
    }
    else {
      if (!is.null(by)) if (exists("y.lbl")) {
        if (length(y.lbl) == 0)
          l.lab <-  by.name
        else
          l.lab <- paste(by.name, ": ", y.lbl, sep="")
      }
    }


  # --------------------------
  # get missing, data entered?

  x.miss <- sum(is.na(x))
  by.miss <- NULL
  by.miss <- if (!is.null(by)) sum(is.na(by))

  # entered counts typically integers as entered but stored as type double
  # if names(x) or rownames(x) is null, likely data from sample and c functions
  # y is getting data values directly from a data frame with counts entered
  entered.pre <- FALSE
  if (!is.matrix(x) && !is.null(names(x))) entered.pre <- TRUE
  if (is.matrix(x) && !is.null(rownames(x))) entered.pre <- TRUE
  entered <- ifelse (!is.integer(x) && is.double(x) && entered.pre, TRUE, FALSE)

  if (is.null(by) && beside && !entered) {
    cat("\n"); stop(call.=FALSE, "\n","------\n",
    "beside=TRUE  is not valid for analysis of only one variable.\n\n")
  }


  # -------------------------------------------
  # get y variable, either directly or tabulate

  # y is provided, no tabulation
  if (!is.null(y)) {
    entered <- TRUE

    if (horiz) {
      tmp <- y.lab; y.lab <- x.lab;  x.lab <- tmp
    }

    if (is.null(by)) {  # no by variable
      yn <- getOption("yname")
      if (!is.numeric(y) > 0) {
        cat("\n"); stop(call.=FALSE, "\n","------\n",
          "y-values, those from the 2nd unlabeled variable, ", yn, ",",
          " must be\n", " numeric\n\n",
          "A  by  variable is categorical, with only several unique values\n",
          "It appears that ", yn, " is a by variable\n",
          "As of lessR 3.5.6 to specify a  by  variable in the function call\n",
          "  precede its name with:  by=", "\n\n")
      }

      if (anyDuplicated(names(x)) > 0) {
        cat("\n"); stop(call.=FALSE, "\n","------\n",
          "The data contain duplicated values of variable: ", x.name, "\n\n")
      }

      x.temp <- x
      x <- y
      names(x) <- x.temp
      x <- as.table(x)
      if (prop) {
        x.count <- x  # save table of counts for possible bar display
        x <- x/sum(x)
      }
    }

    else {  # a by variable, y already aggregated

      ## drop rows with any NA in x, by, or y
      keep <- !is.na(x) & !is.na(by) & !is.na(y)
      x_use  <- x[keep]
      by_use <- by[keep]
      y_use  <- y[keep]

      ## use factors so we get consistent, ordered levels
      x_fac  <- factor(x_use)
      by_fac <- factor(by_use)

      ## build a 2D table of aggregated values: rows = by, cols = x
      tab <- xtabs(y_use ~ by_fac + x_fac, drop.unused.levels = FALSE)

      # ensure dimnames reflect a specific level ordering)
      unq.x  <- levels(x_fac)
      unq.by <- levels(by_fac)
      tab <- tab[unq.by, unq.x, drop = FALSE]

      names(dimnames(tab)) <- c(by.name, x.name)
      x <- tab

      if (stack100) {  # x = tabulate for counts
        x.count <- x  # save the table for possible bar display
        x <- prop.table(x, 2)  # 100% within each x (column)
      }
    }
  }  # end y is present


  if (!entered) {  # so tabulate
    if (!is.data.frame(x)) { # a single x variable

      if (is.null(by)) {
        x.temp <- x  # save counts, to be restored for text output
        x <- table(x, dnn=NULL)
        if (prop) {
          x.count <- x  # save table of counts for possible bar display
          x <- x/sum(x)
        }
      }
      else {  # a by variable
        if (length(x) == length(by))
          x.temp <- table(by, x, dnn=c(by.name, x.name))
        else {
          cat("\n"); stop(call.=FALSE, "\n","------\n",
          x.name, " and ", by.name, " must be of the same size\n\n",
          "Size of ", x.name, ": ", length(x), "\n",
          "Size of ", by.name, ": ", length(by), "\n\n", sep="")
        }
        x <- x.temp
        if (stack100) {
            x.count <- x  # save table of counts for possible bar display
            x <-prop.table(x, 2)  #  100% within bar chart
        }
      }
    }   # end single x value

    else {  # x is a data frame, so combine x's
      if (!is.factor(x[,1])) {
        resp <- unique(x[,1])
        for (i in 2:ncol(x)) resp <- union(resp, unique(x[,i]))
        resp <- sort(resp)  # sort removes any NA
      }
      else {  # is factor
        resp <- levels(x[,1])
        for (i in 2:ncol(x)) resp <- union(resp, levels(x[,i]))
      }
      n.resp <-length(resp)
      frq <- matrix(nrow=n.resp, ncol=ncol(x))  # all elements NA
      frq <- apply(frq, c(1, 2), function(x) 0)
      rownames(frq) <- as.character(resp)
      colnames(frq) <- names(x)

      # maybe an x not has a value in full set
      for (i in 1:ncol(x)) {
        tblx.i <- table(x[,i])
        k <- 0
        for (j in 1:n.resp) {
          if (rownames(frq)[j] %in% names(table(x[,i]))) {
            k <- k + 1
            frq[j,i] <- tblx.i[k]
          }
        }
      }  # end col i of x

      x <- as.table(frq)
      if (is.numeric(resp))
        wt <- resp
      else
        wt <- 1:n.resp
      wm <- double(length=ncol(x))
      for (i in 1:ncol(x)) wm[i] <- weighted.mean(wt, x[,i])

      if (sort != "0") {
        srt.dwn <- ifelse (sort == "-", TRUE, FALSE)
        m.o <- order(wm, decreasing=srt.dwn)
        x <- x[,m.o]
        wm <- wm[m.o]
      }
    }  # x is a data frame
  }  # end !entered so tabulated


  if (prop) {
    if (any(is.nan(x))) {
      cat("\n"); stop(call.=FALSE, "\n","------\n",
        "Some cells (frequencies) are zero\n",
        "Division to calculate proportions not possible\n",
        "Run analysis without  proportion  to identify the 0 cells\n\n")
    }
  }

  # ------------
  # sort options (x is numeric y)
  if (sort != "0") {
    srt.dwn <- ifelse (sort == "-", TRUE, FALSE)
    if (!is.matrix(x)) {
      x <- x[order(x, decreasing=srt.dwn)]
    }
    else {
      x.df <- as.data.frame.matrix(x, nrow=2)
      x.df <- x.df[order(apply(x.df, 2, sum), decreasing=srt.dwn)]
      x <- as.table(as.matrix(x.df))
    }
  }  # end sort

  n.levels <- ifelse (is.matrix(x), nrow(x), length(x))


# assign fill and color (edge) --------------------------------------------
  # assign fill
  if (!fill_scaled) {

    if (!is.null(fill_split)) {
      f.c <- character(length=2)
      if (!is.null(fill) && length(fill) == 2L) {
        # user-defined divergent scale: fill=c(lo_color, hi_color)
        f.c[1] <- fill[1]
        f.c[2] <- fill[2]
        fill <- NULL  # clear so value-proportional remap below can run
      } else {
        chroma <- ifelse (theme %in% c("gray", "white"), 0, 55)
        hue <- .get.h(theme)
        f.c[1] <- hcl(hue, chroma, l=30)
        f.c[2] <- hcl(hue, chroma, l=70)
      }
      fill_split_clr <- character(length=length(x))
      for (i in seq_along(x))
        fill_split_clr[i] <- ifelse(x[i] <= fill_split, f.c[1], f.c[2])
      fill <- fill_split_clr
    }

    if (is.null(fill)) {
      if (!is.null(by))   # need a sequential range if a by variable
        fill <- .color_range(.get_fill(theme), n.levels)
      else
        fill <- rep(getOption("bar_fill_discrete"), n.levels)  # uniform theme color
    }  # end missing fill

    # if specified fill is a sequence name like "reds", not a valid color name
    # so get convert the name to a sequential color palette
    if (length(fill) == 1L || .is.palette(fill[1L]))
      fill <- .color_range(fill, n.levels)

  }  # end no fill_scaled

  else {  # fill_scaled: luminance proportional to bar value
    # collapse expanded fill vector to 1-2 colors as .scale.clr expects
    if (!is.null(fill)) {
      fill_unique <- unique(fill)
      if (length(fill_unique) == 1L) fill <- fill_unique
      else if (length(fill_unique) > 2L) fill <- NULL
    }
    fill <- .scale.clr(x, fill, fill_split, fill_chroma, theme)
  }

  # transparency, need a valid color name here
  if (trans > 0)
    for (i in 1:length(fill)) fill[i] <- .maketrans(fill[i], (1-trans)*256)

  # assign color (edges)
  # by default, no color borders if a range
  if (identical(color, getOption("bar_color_discrete")))
    color <- "transparent"
  # see if apply a pre-defined color range to **color**
  col.clr <- .color_range(color, n.levels)  # see if range, NULL if not
  if (!is.null(col.clr)) color <- col.clr

# is.range.nm <- ifelse (length(.color_range(fill, n.clr=5)) > 1,
#                        TRUE, FALSE)
# if (!is.range.nm && !is.null(by) && !is.null(fill)) {
#   cat("\n"); stop(call.=FALSE, "\n------\n",
#     "For custom fill for a two-variable bar chart,\n",
#     " must specify a color range such as \"colors\" or \"grays\", \n\n")
# }


# preliminaries -----------------------------------------------------------

  add_top <- 0.05  # old version of pad_y_max, no longer a parameter
  if (length(labels_pos > 0))
    if (labels_pos == "out") add_top <- add_top + .06
  # a 2-D table is an instance of a matrix, a 1-D table is not
  max.y <- ifelse (is.matrix(x) && !beside,
                   max(colSums(x), na.rm=TRUE), max(x, na.rm=TRUE))
  max.y <- max.y + (add_top * max.y)

  if (any(x < 0, na.rm = TRUE)) {
    min.y <- ifelse (is.matrix(x) && !beside,
                     min(colSums(x), na.rm=TRUE), min(x, na.rm=TRUE))
    min.y <- min.y - abs(add_top * min.y)
  }
  else
    min.y <- 0

  if (is.null(legend_labels)) legend_labels <- row.names(x)
  for (i in 1:length(legend_labels))
    legend_labels[i] <- gsub("~", " ", legend_labels[i], fixed=TRUE)
  if (beside) legend_horiz <- FALSE
  if (is.matrix(x) && !beside) legend_horiz <- TRUE

  if (is.null(gap)) {  # ifelse does not work here when gap is a vector
    if (!is.null(by) && beside)
      gap <- c(0.1,1)
    else
      gap <- 0.2
  }

  # get the names
  the.names <- integer(length=0)
  if (length(dim(x)) == 0)
    the.names <- names(x)
  else {
    if (is.null(by))  # ifelse does not work
      the.names <- rownames(x)
    else
      the.names <- colnames(x)
  }

  # set las.value for labels horiz or vertical
  las.value <- 1
  if (horiz  &&  max(nchar(the.names), na.rm=TRUE) > 5) las.value <- 0


# value labels -----------------------------------------------------------

  # val.lab: use names from x, by columns, or y names
  if (is.null(by))
    val.lab <- names(x)
  else
    val.lab <- colnames(x)
  if (length(val.lab) == 0) val.lab <- colnames(x)  # read matrix directly
  if (!is.null(names(y))) val.lab <- names(y)

  # for each value label, partition into mx.x.val.ln lines if (break_x)
  mx.x.val.ln <- 1
  if (!break_x) {
    for (i in seq_along(val.lab)) {
      if (!is.na(val.lab[i])) {
        val.lab[i] <- gsub(" ", "~", val.lab[i])  # ~ , so no \n
      }
    }
  }
  stuff <- .get.val.ln(val.lab, x.name)
  val.lab <- stuff$val.lab
  mx.x.val.ln <- stuff$mx.val.ln

  mx.y.val.ln <- 1

  if (is.null(y)) if (horiz) {  # switch
    temp <- x.lab;  x.lab <- y.lab;  y.lab <- temp
    temp <- mx.x.val.ln;  mx.x.val.ln <- mx.y.val.ln;  mx.y.val.ln <- temp
  }

  # set max.val.width to get max width of y-axis labels for lm adjustment
  lblval.y <- character(length=0)
  if (is.null(scale_y)) {
    prety <- max(pretty(c(min.y, max.y)))
    mx.num <-  ifelse (!prop, as.character(prety), .fmt(prety, 2))
    max.y.width <- max(strwidth(mx.num, cex=axis_y_cex, units="inches"))

  }
  else {  # need scale to be defined to get y.coords, not done till later
    ax.num <- ifelse(horiz, 1, 2)  # location of numerical axis
    y.coords <- axTicks(ax.num, axp=scale_y)
    nd <- 0
    for (i in 1:length(y.coords))
      if (.num.dec(y.coords[i]) > nd) nd <- .num.dec(y.coords[i])
    if (nd > 2) nd <- 2  # only allow a few decimal digits
    for (i in 1: length(y.coords))
      lblval.y[i] <- as.character(.fmt(y.coords[i], nd))
    j <- which(nchar(lblval.y) == max(nchar(lblval.y)))[1]
    max.y.width <- max(strwidth(lblval.y[j], cex=axis_y_cex, units="inches"))
  }

  max.x.width <- NULL
  if (horiz  ||  rotate_x == 90) {  # "y"-axis is categorical (i.e., x-axis)
  val.split <- unlist(strsplit(val.lab, "\n"))  # break into separate words
    if (horiz)
      max.y.width <- max(strwidth(val.split, cex=axis_x_cex, units="inches"))
    else
      max.x.width <- max(strwidth(val.split, cex=axis_x_cex, units="inches"))
    # strwidth not work in R w/o RStudio until barplot, plot.new not enough
    in.RStudio <- ifelse (options("device") == "RStudioGD", TRUE, FALSE)
    if (!in.RStudio) {  # 1st attempt, undoubtedly can be improved
      if (horiz)
        max.y.width <- max(nchar(val.split)) / (11 / axis_x_cex)
      else
        max.x.width <- max(nchar(val.split)) / (11 / axis_x_cex)
    }
  }


  if (do_plot) {

  # ----------------
  # set up plot area

  margs <- .plt.marg(max.y.width, y.lab, x.lab, main.lab, sub.lab,
                rotate_x, mx.x.val.ln, mx.y.val.ln,
                lab_x_cex=lab_x_cex, lab_y_cex=lab_y_cex, max.x.width)
  lm <- margs$lm
  tm <- margs$tm
  rm <- margs$rm
  bm <- margs$bm
  n.lab_x.ln <- margs$n.lab_x.ln
  n.lab_y.ln <- margs$n.lab_y.ln

  if (horiz)
    rm <- rm + 0.1  # sometimes the max axis value goes off the plot
  else
    if (offset > 0.5) bm <- bm + (-0.05 + 0.2 * offset)  # offset kludge

  if (!exists("byname"))
    byname <- getOption("byname")
  if (legend_position == "right_margin"  &&  (is.matrix(x))) {
    if (!is.null(legend_abbrev)) {
      byname  <- abbreviate(byname, legend_abbrev)
      if (!is.null(legend_labels))
        legend_labels <- abbreviate(legend_labels, legend_abbrev)
    }
    mx.ch <- max(c(max(nchar(legend_labels)), nchar(byname)-2))
    exp.coef <- 0.065 + 0.45 * axis_x_cex
    rm <- rm + (.34 + (exp.coef * axis_x_cex))
    rm <- rm + (0.04 + 0.036*mx.ch)  # legend also moves over
    if (mx.ch > 18) rm <- rm + ((mx.ch - 18) * .06)
  }

  if (legend_position == "top")
    tm <- tm + (.25 + (0.446 * lab_cex))  # tm <- tm + .45

  # user manual adjustment
  bm <- bm + bm.adj
  lm <- lm + lm.adj
  tm <- tm + tm.adj
  rm <- rm + rm.adj

  orig.params <- par(no.readonly=TRUE)
  on.exit(par(orig.params))

  par(bg=getOption("window_fill"))
  par(mai=c(bm, lm, tm, rm))

#p(par("din")[1]-par("pin")[1])
  # new.scale to control bar width for small number of bars
  # set new.scale
  if ("numeric" %in% class(x)  &&  entered) x <- as.table(x)
  new.scale <- 0
  if (is.null(by)) if (nrow(x) <= 4) new.scale <- nrow(x)
  if (is.matrix(x)  &&  !beside) if (ncol(x) <= 4) new.scale <- ncol(x)
  if ("matrix" %in% class(x)  &&  entered) new.scale <- 0  # turned off for now
  # set width.bars, gap
  if (new.scale == 4) width.bars <- .17
  if (new.scale == 3) width.bars <- .22
  if (new.scale == 2) width.bars <- .28
  if (new.scale == 1) width.bars <- .30  # for only one category
  if (new.scale > 0) gap <- 0.246 + (0.687 * width.bars)

  yp <- pretty(c(min.y, max.y))
  y.adj_min <- pad_y_min * (yp[length(yp)] - yp[1])
  y.adj_max <- pad_y_max * (yp[length(yp)] - yp[1])
  min.y <- min.y - y.adj_min
  max.y <- max.y + y.adj_max

  # barplot run here only to establish usr coordinates, axTick values
  #  otherwise usr is just 0,1 for both axes
  # the barplot itself is not retained
  if (new.scale == 0) {
    if (!horiz)
      barplot(x, col="transparent", border="transparent",
        ylim=c(min.y,max.y), axisnames=FALSE,
        beside=beside, space=gap, axes=FALSE, ...)
    else
      barplot(x, col="transparent", border="transparent", horiz=TRUE,
        axisnames=FALSE,
        beside=beside, space=gap, axes=FALSE, xlim=c(min.y, max.y), ...)
  }
  else { # new.scale, need (0,1) limit on_cat axis for re-scale to work
    if (!horiz)
      barplot(x, col="transparent", border="transparent",
        ylim=c(min.y,max.y), axisnames=FALSE,
        beside=beside, space=gap, width=width.bars, xlim=c(0,1),
        axes=FALSE, ...)
    else {
      # when x is binary for a BPFM equivalent ylim may need extension
      x.coords <- barplot(x, col="transparent", border="transparent", horiz=TRUE,
        axisnames=FALSE,
        beside=beside, space=gap, width=width.bars, xlim=c(min.y, max.y),
        ylim=c(0,1), axes=FALSE, plot=FALSE, ...)
      up.lim <- ifelse (max(x.coords) > 1, max(x.coords) + .1, 1)
      barplot(x, col="transparent", border="transparent", horiz=TRUE,
        axisnames=FALSE,
        beside=beside, space=gap, width=width.bars, xlim=c(min.y, max.y),
        ylim=c(0,up.lim), axes=FALSE, ...)
    }
  }

  ax.num <- ifelse (horiz, 1, 2)  # location of numerical axis
  y.coords <- axTicks(ax.num, axp=scale_y)
  gridT <- axTicks(ax.num, axp=scale_y)  # axis ticks, grid lines are identical
  y.name <- getOption("yname")


  ## ----
  ## PLOT
  ## does stacked bar charts automatically if x is a 2-D matrix

   usr <- par("usr")  # used elsewhere as well; just use 1 y.coords next
  .plt.bck(usr, y.coords, y.coords, do.v=horiz, do.h=!horiz)

  # the bars
  # here plot only the bars and the background; x is the y-numbers here


  if (new.scale == 0)
    x.coords <- barplot(x, add=TRUE, col=fill, border=color,
          beside=beside, horiz=horiz, axes=FALSE, ann=FALSE, las=las.value,
          space=gap, axisnames=FALSE, ...)
  else
    x.coords <- barplot(x, add=TRUE, col=fill, border=color, beside=beside,
          horiz=horiz, axes=FALSE, ann=FALSE, las=las.value,
          space=gap, width=width.bars, xlim=c(0,1), axisnames=FALSE, ...)


  # display text labels of y-values on or above the bars
  # ----------------------------------------------------

  if (labels != "off") {
    if (is.null(labels_decimals)) {  # set labels_decimals
      if (labels == "input") labels_decimals <- 0
      if (labels == "%") labels_decimals <- 0
      if (labels == "prop") labels_decimals <- 2
      if (.is.integer(y)) labels_decimals <- 0
    }
  }

  # need n.levels for this evaluation
  if (labels == "eval.later") {  # labels not user-specified
    is.int <- TRUE
    if (!is.null(y)) if (!.is.integer(y)) is.int <- FALSE
    if (n.levels > 14  || !is.int)
      labels <- "off"
    else {
      labels <- getOption("values")
      if (labels != "off") if (!is.null(y)) labels <- "input"
    }
  }

  if (beside) {
     labels_size <- 0.85 * labels_size
     labels_cut <- 0.01
  }

    if (labels != "off") {

      if (is.null(labels_cut)) {
        labels_cut <- 0.028
        if ((prop && is.matrix(x)) || multi) labels_cut <- 0.040
      }

      # set type of the labels to display, x.txt

      if (!prop) {
        if (!multi)
          x.prop <- x/sum(x)
        else
          x.prop <- x/colSums(x)
        if (labels == "input")
          x.txt <- .fmt(x, labels_decimals)   # as.char not accurate for dec dig
        else if (labels == "%")
          x.txt <- paste(.fmt(x.prop * 100, labels_decimals), "%", sep="")
        else if (labels == "prop")
          x.txt <- .fmt(x.prop, labels_decimals)

        if (is.matrix(x))
            x.txt <- matrix(x.txt, nrow=nrow(x))

        if (labels_pos != "out") {
          if (is.null(by)) {
            if (is.null(y)) {
              for (i in 1:length(x.prop))
                x.txt[i] <- ifelse (x.prop[i] >= labels_cut, x.txt[i], "")
            }
          }
          else {  # by variable
            for (i in 1:nrow(x.prop)) for (j in 1:ncol(x.prop))
              x.txt[i,j] <- ifelse (x.prop[i,j] >= labels_cut, x.txt[i,j], "")
          }
        }
      }

      else {  # prop
        if (labels == "input")
          x.txt <- as.character(x.count)
        else if (labels == "%")
          x.txt <- paste(.fmt(x * 100, labels_decimals), "%", sep="")
        else if (labels == "prop")
          x.txt <- .fmt(x, labels_decimals)

        if (is.matrix(x))
            x.txt <- matrix(x.txt, nrow=nrow(x))

        if (labels_pos != "out") {
          if (is.null(by)) {
            for (i in 1:length(x))
              x.txt[i] <- ifelse (x[i] >= labels_cut, x.txt[i], "")
          }
          else {  # by variable
            # as.numeric & as.character convert table to vector: re-convert
            for (i in 1:nrow(x)) for (j in 1:ncol(x))
              x.txt[i,j] <- ifelse (x[i,j] >= labels_cut, x.txt[i,j], "")
          }
        }
      }

      # R text function sets cex at 1 if input value is 0
      if (labels_size == 0) labels_size <- 0.01

      # vertical bars
      if (!horiz) {
        if (!is.matrix(x)) { # 1 variable
          usr.y.inch <- diff(grconvertY(0:1, 'inches', 'user'))
          if (labels_pos == "in")
            ycrd <- x/2
          else {
            slope <- 0.0 + (0.15*labels_size)
            ycrd <- ifelse(x > 0, x + slope*usr.y.inch, x - slope*usr.y.inch)
          }
          text(x.coords, ycrd, labels=x.txt, col=labels_color, cex=labels_size)
        }  # no by
        else {  # 2 variables
          if (!beside) {
            for (i in 1:ncol(x)) {
              ycrd <- cumsum(x[,i]) - (x[,i] / 2)
              text(x.coords[i], ycrd, labels=x.txt[,i],
                   col=labels_color, cex=labels_size)
            }
          }  # end !beside
          else {  # beside
            usr.y.inch <- diff(grconvertY(0:1, 'inches', 'user'))
            if (labels_pos == "in")
              ycrd <- x/2
            else  # value.pos == "out"
              ycrd <- x + 0.10*usr.y.inch
            for (i in 1:ncol(x)) {
              text(x.coords[,i], ycrd[,i], labels=x.txt[,i],
                   col=labels_color, cex=labels_size)
            }
          }  # end beside
        }  # end 2 variables
      }  # end vertical bars

      # horiz bars
      else {
        if (!is.matrix(x)) {  # 1 variable
          usr.x.inch <- diff(grconvertX(0:1, 'inches', 'user'))
          if (labels_pos == "in")
            ycrd <- x/2
          else { # out, adjust for label font size
            slope <- 0.024 + (0.192*labels_size)
            ycrd <- ifelse(x > 0, x + slope*usr.x.inch, x - slope*usr.x.inch)
          }
          text(ycrd, x.coords, labels=x.txt, col=labels_color, cex=labels_size)
        }  # end no by
        else {  # by variable
          if (!beside) {  # stacked chart
          for (i in 1:ncol(x)) {  # each level of by
            ycrd <- cumsum(x[,i]) - (x[,i] / 2)
            text(ycrd, x.coords[i], labels=x.txt[,i],
               col=labels_color, cex=labels_size)
          }
        }
        else {  # beside chart
          usr.x.inch <- diff(grconvertX(0:1, 'inches', 'user'))
          if (labels_pos == "in")
            ycrd <- x/2
          else  # value.pos == "out"
            ycrd <- x + 0.17*usr.x.inch
            for (i in 1:ncol(x)) {
              text(ycrd[,i], x.coords[,i], labels=x.txt[,i],
                   col=labels_color, cex=labels_size)
            }
          }  # end beside
        }  # end by
      }  # end horiz bars

    }  # end display labels


    # y-axis is the numerical axis
    if (!horiz) las.value <- 1
    axis_y_color <- ifelse(is.null(getOption("axis_y_color")),
      getOption("axis_color"), getOption("axis_y_color"))
    axis_y_text_color <- ifelse(is.null(getOption("axis_y_text_color")),
      getOption("axis_text_color"), getOption("axis_y_text_color"))
    adj1 <- ifelse (!horiz, 0.5, -1.0)
    if (is.null(scale_y)) {  # if scale_y defined, can evaluate earlier
      if (!prop)
        lblval.y <- as.character(y.coords)
      else
        lblval.y <- .fmt(y.coords,2)
    }

    # adjust axis label from tick with mgp[2]
    # mgp does not work with rotate_x, see .axes()
    my.mgp <- par("mgp")  # save to restore
    ax <- .axes_dim()  # get axis value parameters
    mgp2 <- -0.350 + (0.9 * ax$axis_x_cex)
    par(mgp = c(my.mgp[1], mgp2, my.mgp[3]))  # labels closer to axis
    adj <- .RSadj(axis_cex=ax$axis_x_cex); axis_x_cex <- adj$axis_cex

    par(tcl=-0.28)  # axis tick length

    # numerical axis
    if(!horiz)
        ax.info <- .axes(NULL, NULL, NULL, axT2=y.coords,
              rotate_x=rotate_x, offset=offset,
              axis_fmt=axis_fmt, axis_x_pre="no", axis_y_pre=axis_y_pre, ...)

    else
        ax.info <- .axes(NULL, NULL, axT1=y.coords, NULL,
              rotate_x=rotate_x, offset=offset,
              axis_fmt=axis_fmt, axis_x_pre=axis_x_pre, axis_y_pre="no", ...)

    # x-axis is the category value axis
    axis_x_color <- ifelse(is.null(getOption("axis_x_color")),
      getOption("axis_color"), getOption("axis_x_color"))
    axis_x_text_color <- ifelse(is.null(getOption("axis_x_text_color")),
      getOption("axis_text_color"), getOption("axis_x_text_color"))

    if (beside) x.coords <- apply(x.coords, 2, mean)  # one label per group
    if (!horiz) {
      usr.y.in <- diff(grconvertY(0:1, 'inches', 'user'))  # y user x.coords inch
      ax.value <- 1;  xx <- x.coords;  yy <- par("usr")[3] - (.15 * usr.y.in)
    }
    else {
      usr.x.in <- diff(grconvertX(0:1, 'inches', 'user'))  # x user x.coords inch
      ax.value <- 2;  xx <- par("usr")[1] - (.15 * usr.x.in);  yy <- x.coords
    }

    adj.x <- ifelse(!horiz, 0.5, 1.0)
    adj.y <- ifelse(!horiz, 1.0, 0.5)
    if (rotate_x == 0) {
      axis(ax.value, at=x.coords, labels=FALSE, col=axis_x_color, ...)
      text(x=xx, y=yy, labels=val.lab, adj=c(adj.x,adj.y),
           xpd=TRUE, cex=axis_x_cex, col=axis_x_text_color, ...)
    }
    else if (rotate_x > 0  && rotate_x < 90) {
      axis(ax.value, at=x.coords, labels=FALSE, col=axis_x_color, ...)
      text(x=xx, y=yy, labels=val.lab, pos=1,  # pos needed for offset
           xpd=TRUE, cex=axis_x_cex, col=axis_x_text_color,
           srt=rotate_x, offset=offset, ...)
    }
    else if (rotate_x == 90)  # 90 degrees rotate
      axis(ax.value, at=x.coords, labels=val.lab, col=axis_x_color,
           cex.axis=axis_x_cex, las=2, ...)

    # title
    title(main=main.lab, cex.main=getOption("main_cex"),
          col.main=getOption("main_color"))

    lab_x_color <- ifelse(is.null(getOption("lab_x_color")),
      getOption("lab_color"), getOption("lab_x_color"))

    # xlab positioning
    ln.ht.x <- par('cin')[2] * lab_x_cex * par('lheight')  # line ht inches
    xlab_adj <- xlab_adj / ln.ht.x
    lblx.lns <- par("mar")[1] - 1.3   # par("mar")[1] is bm in lines
    title(xlab=x.lab, line=lblx.lns-xlab_adj, cex.lab=lab_x_cex,
          col.lab=lab_x_color)

    # need sub.lab processing here

    # ylab positioning (based on .axlabs function)
    lab_y_color <- ifelse(is.null(getOption("lab_y_color")),
                          getOption("lab_color"), getOption("lab_y_color"))
    ln.ht.y <- par('cin')[2] * lab_y_cex * par('lheight')  # line ht inches
    ylab_adj <- ylab_adj / ln.ht.y
    lm <- par("mar")[2]  # get current left margin in lines
    lbly.lns <- lm - (0.3 + 0.9*n.lab_y.ln)
    if (!horiz) {  # y-axis labels
      lbl <- .axis.format(y.coords, axis_fmt, axis_x_pre, axis_y_pre="no")
      mx.ch <- max(nchar(lbl))  # move ylab closer
      if (mx.ch == 3) lbly.lns <- lbly.lns - 0.5  # would also prefer less lm
      if (mx.ch == 4) lbly.lns <- lbly.lns - 0.25
      if (mx.ch == 5) lbly.lns <- lbly.lns - 0.1
    }
    title(ylab=y.lab, line=lbly.lns-ylab_adj,
          cex.lab=lab_y_cex, col.lab=lab_y_color)


    # ------------------------------------------------------
    # legend for two variable plot including variable labels

    if ( (!is.null(by) || is.matrix(x)) && !is.null(legend_position)) {

      col.bg <- getOption("panel_fill")
      col.txt <- ifelse (sum(col2rgb(col.bg))/3 > 80, "black", rgb(.97,.97,.97))

      # evaluate in bc.main, under color, when n.levels is known
      if (is.null(legend_size)) {
        if (legend_position == "top")
          legend_size <- getOption("lab_cex")
        else
          legend_size <- axis_x_cex
      }

      # default right_margin option location
      if (legend_position == "right_margin") {

        options(byname = getOption("byname"))
        trans_pts <- .6  # dummy value
        point.size <- 2.5 * axis_x_cex
        .plt.by.legend(legend_labels, color, fill, shp=22, trans_pts,
                       col.bg, usr, pt.size=point.size, pt.lwd=0,
                       legend_size, legend_abbrev, legend_adj, legend_title)

      }  # end right margin

      # top option
      else if (legend_position == "top") {
        ll <- legend("top", legend=legend_labels, plot=FALSE,
               title=l.lab, xpd=NA, x.intersp=.15,
               fill=fill, border="transparent",
               horiz=legend_horiz, cex=legend_size, bty="n", text.col=col.txt)
        fct <- (-0.043 + (0.257 * lab_cex))  # more cushion for large cex
        legend(ll$rect$left, usr[4]+(fct*(usr[4])), legend=legend_labels,
               title=l.lab, xpd=NA, x.intersp=.15, pt.cex=10,
               fill=fill, border="transparent",
               horiz=legend_horiz, cex=legend_size, bty="n", text.col=col.txt)
      }

      # everything else, not so consistent
      else
        legend(legend_position, legend=legend_labels, title=l.lab,
               fill=fill, border="transparent", x.intersp=.15,
               horiz=legend_horiz, cex=legend_size, bty="n", text.col=col.txt)

    } # end legend

    if (!is.null(add)) {

      add_cex <- getOption("add_cex")
      add_lwd <- getOption("add_lwd")
      add_lty <- getOption("add_lty")
      add_color <- getOption("add_color")
      add_fill <- getOption("add_fill")
      add_trans <- getOption("add_trans")

      .plt.add (add, x1, x2, y1, y2,
                add_cex, add_lwd, add_lty, add_color, add_fill, add_trans)
    }

  }  # end do_plot


# text output -------------------------------------------------------------

  if (prop) {
    if (is.null(y)) {
      if (!is.null(by) || is.matrix(x))
        x  <- x.temp
      else
        x <- table(x.temp)
    }
  }

  dd <- ifelse (is.null(digits_d), 3, digits_d)
  n_dim <- length(dim(x))
  stats <- ""

  if (multi) {

    # display variable labels
    txlbl <- ""
    l.name <- "l"
    if (exists(l.name, where=.GlobalEnv)) {
      mylabs <- get(l.name, pos=.GlobalEnv)
      mylabs <- mylabs[colnames(x),]
      if (!is.null(mylabs)) {
        tx <- character(length = 0)
        for (i in 1:length(colnames(x))) {
          if (is.data.frame(mylabs))
            ml <- mylabs[i,]
          else  # if a different l label frame exists, ml is NA
            ml <- mylabs[i]
          if (!is.na(ml))
            tx[length(tx)+1] <- paste(colnames(x)[i], ": ", ml, sep="")
        }
        tx[length(tx)+1] <- " "
        tx[length(tx)+1] <- "Variable Labels"
        txlbl <- rev(tx)
        blnk <- " "
      }
    }

    # display frequencies and means of each variable
    txttl <- "Frequencies of Responses by Variable"
    tx <- character(length = 0)
    mx.chr <- max(nchar(rownames(x)))
    mx.len <- 8
    if (mx.chr > mx.len) {
      c.nm <- rownames(x)
      rownames(x) <- .abbrev(rownames(x), mx.len)
    }
    x <- t(x)

    txtbl <- .prntbl(x, 0, cc=NULL)
    mx <- max(nchar(round(wm,2)))
    txtbl[1] <- paste(txtbl[1], " ", .fmtc("Mean", w=mx+1))
    n.var <- nrow(x)
    for (i in 1:n.var)
      txtbl[i+1] <- paste(txtbl[i+1], " ", .fmt(wm[i],3,w=mx+1))
     txtbl[2:length(txtbl)] <- rev(txtbl[2:length(txtbl)])

    if (mx.chr > mx.len) {
      txtbl[n.var+2] <- ""
      txtbl[n.var+3] <- ""
      txtbl[n.var+4] <- "Unabbreviated labels"
      txtbl[n.var+5] <- "--------------------"
      txtbl[n.var+6] <- paste(c.nm, sep="", collapse="\n")
    }
    strt <- ifelse (mx.chr > mx.len, 7, 2)
    if (is.null(resp)) {
      txtbl[n.var+strt] <- ""
      txtbl[n.var+strt+1] <- paste("Computation of the mean based on coding",
                                   "response categories from 1 to", n.var)
    }

    class(txtbl) <- "out"
    class(txttl) <- "out"
    output <- list(out_text=txlbl,
                   out_title=txttl, out_text=txtbl)

    class(output) <- "out_all"
    if (!quiet) print(output)

  }  # end multi


  # x is a table, could be real values or integers <0 if y is specified
  # no by variable, dim == 0 if x<-x.temp
  else if (n_dim == 1) {
    if (.is.integer(x)  &&  all(x >= 0)) {  # x is table of count-like values

      stats <- .ss.factor(x, by=NULL, brief=TRUE, digits_d=dd,
                          x.name, by.name, x.lbl, y.lbl, label_max,
                          x.miss, by.miss, out_size)
      if (!is.null(stats)) {
        txttl <- stats$title
        counts <- stats$count
        miss <- stats$miss
        chi <- stats$chi
        lbl <- stats$lbl

        class(txttl) <- "out"
        class(counts) <- "out"
        class(miss) <- "out"
        class(chi) <- "out"
        class(lbl) <- "out"
        output <- list(out_title=txttl, out_miss=miss,
                       out_lbl=lbl, out_counts=counts, out_chi=chi)
        class(output) <- "out_all"
        if (!quiet) print(output)
      }

    # names and order of components per documentation in BarChart.Rd
      stats$n_miss <- x.miss
      stats$p_value <- .fmt(stats$p_value, 3)
      names(stats) <- c("n_dim", "out_title", "out_counts", "out_miss",
                        "out_chi", "out_lbl", "freq", "freq_df", "prop",
                        "p_value", "n_miss")
      stats <- c(stats[2], stats[6], stats[3], stats[5], stats[4],
                 stats[1], stats[10], stats[8], stats[7], stats[9], stats[11])
    }  # end counts or count-like

    else {  # x (table from y) not count-like: not integer or values < 0

      stats <- .ss.real(x, by, digits_d=dd,
                   x.name, getOption("yname"), by.name, x.lbl, y.lbl, label_max)
      txtbl <- stats$txtbl
      class(txtbl) <- "out"
      output <- list(out_txt=txtbl, values=stats$values)

      class(output) <- "out_all"
      if (!quiet) print(output)
      names(stats) <- c("n_dim", "out_y", "values")
      stats <- c(stats[2], stats[1], stats[3])
    }

  }  # end if (n_dim == 1)

  # a by variable
  else {

    if (is.null(y) && .is.integer(x)) {

      # need brief=FALSE for row proportions
      stats <- .ss.factor(x, by, brief=FALSE, digits_d=dd,
                          x.name, by.name, x.lbl, y.lbl, label_max)
      txttl <- stats$txttl
      txfrq <- stats$txfrq
      txXV <- stats$txXV
      txlbl <- stats$txlbl

      class(txttl) <- "out"
      class(txfrq) <- "out"
      class(txXV) <- "out"
      class(txlbl) <- "out"
#     if (!prop)  # NOT working, props come out 0 or 1 from .ss.factor()
        output <- list(out_title=txttl, out_lbl=txlbl,
                       out_text=txfrq, out_XV=txXV)
#     else {
#       txrow <- stats$txrow
#       class(txrow) <- "out"
#       output <- list(out_title=txttl, out_text=txfrq,
#                      out_XV=txXV, out_row=txrow)
#     }
      class(output) <- "out_all"
      if (!quiet) print(output)

      names(stats) <- c("n_dim", "out_title", "out_lbl", "out_counts",
                        "out_chi", "out_prop", "out_row",
                        "out_col", "freq", "p_value")
      stats <- c(stats[2], stats[3], stats[4], stats[5], stats[6],
                 stats[7], stats[8], stats[1], stats[9], stats[10])
    }  # end is.null(y)

    else {  # y is present
      stats <- .ss.real(x, y, by, digits_d=dd, x.name,
                        y.name, by.name, x.lbl, y.lbl, label_max)

      names(stats) <- c("n_dim", "out_y")
      stats <- c(stats[2], stats[1])
    }
  }  # end a by variable


# use_plotly --------------------------------------------------------------

  if (use_plotly && do_plot) {
    y.name <- getOption("yname")
    if (y.name == "NULL") y.name <- "Count"

    # --- normalize shape for plotly ------------------------------------
    # 1-D: leave as-is
    if (length(dim(x)) == 2L) {
      # we want: rows = by.levels, cols = x.levels
      rn <- rownames(x)
      cn <- colnames(x)

      # if row/col names are missing, rebuild from by.name/x.name
      if (is.null(rn)) rn <- paste0(by.name, "_", seq_len(nrow(x)))
      if (is.null(cn)) cn <- paste0(x.name,  "_", seq_len(ncol(x)))

      x <- as.table(x)
      dimnames(x) <- list(rn, cn)
      names(dimnames(x)) <- c(by.name, x.name)
    }

    plt <- .bc.plotly(
      x, x.name, y.name, by.name, x.lab, y.lab,
      fill, color, opacity = NULL,
      beside, horiz,
      ax.info, gridT,
      digits_d, main=main,
      labels = labels,
      labels_size = labels_size,
      labels_color = labels_color
    )

    if (.allow.interactive())
      .viewer_notice_once(plot_name = "bar chart", window_target = "Both")
    if (.allow.interactive())
      print(plt)
  }  #end use_plotly

  cat("\n")
  return(stats)

}

