# vim: tw=80 shiftwidth=4 softtabstop=4 expandtab:

PLEN <- 300 # palette has this many default levels

prettyLocal <- function(x, n, digits = 10) {
    if (is.numeric(x)) round(pretty(x, n), digits) else pretty(x, n)
}

clipmin <- function(x, min = 0) {
    ifelse(x < min, min, x)
}


#' Abbreviate a Vector of Times by Removing Commonalities
#'
#' Abbreviate a vector of times by removing commonalities (e.g. year)
#'
#' @param t vector of times.
#'
#' @param \dots optional arguments passed to the [format()], e.g.
#' `format`.
#'
#' @return None.
#'
#' @author Dan Kelley, with help from Clark Richards
#'
#' @seealso This is used by various functions that draw time labels on axes,
#' e.g.  [plot,adp-method()].
abbreviateTimeLabels <- function(t, ...) {
    if (!inherits(t, "POSIXt")) {
        return(t)
    } # not a time, so just return the argument
    dots <- list(...)
    if ("format" %in% names(dots$format)) {
        return(format(t, dots$format))
    } # a format was specified, so just return the argument
    t <- format(t, "%Y-%m-%d %H:%M:%S")
    n <- length(t)
    if (n < 2) {
        return(t)
    }
    year <- substr(t, 1, 4)
    # strip years, if all the same
    for (i in 2:n) if (year[i] != year[1]) {
        return(t)
    }
    t <- substr(t, 6, nchar(t))
    # strip months, if all the same
    month <- substr(t, 1, 2)
    for (i in 2:n) if (month[i] != month[1]) {
        return(t)
    }
    t <- substr(t, 4, nchar(t))
    # strip seconds, if all the same
    seconds <- substr(t, nchar(t) - 2, nchar(t))
    for (i in 2:n) if (seconds[i] != seconds[1]) {
        return(t)
    }
    t <- substr(t, 1, nchar(t) - 3)
    # strip minutes, if all the same (this may be confusing)
    minutes <- substr(t, nchar(t) - 2, nchar(t))
    for (i in 2:n) if (minutes[i] != minutes[1]) {
        return(t)
    }
    substr(t, 1, nchar(t) - 3)
}


paletteCalculations <- function(
    separation = par("cin")[2] / 2, width = par("cin")[2], pos = 4,
    zlab, maidiff = c(0, 0, 0, 0), debug = getOption("oceDebug")) {
    # This returns a list with the following entries:
    #   mai0  = before this call
    #   mai1  = just before plotting palette (i.e. lots of white space on one side)
    #   mai1f = set before plotting fullpage palette
    #   mai2  = ready for post-palette drawing (i.e. good for a diagram beside palette)
    if (!(pos %in% 1:4)) {
        stop("pos must be 1, 2, 3 or 4")
    }
    oceDebug(debug, "paletteCalculations(separation=", separation,
        ", width=", width, ", pos=", pos,
        ", zlab=", if (missing(zlab)) "(missing)" else zlab,
        ", maidiff=c(", paste(maidiff, collapse = ","), ")",
        ", debug=", debug, ") START\n",
        sep = "", unindent = 1
    )
    haveZlab <- !missing(zlab) && !is.null(zlab) && sum(nchar(zlab)) > 0
    # 2014-04-02 {
    # Below, we will be using e.g. par("mai") to find margins.  If the user
    # is employing layout(), the call will not give the right answer until the plot
    # has been established or initialized (not sure on right term).  So, we use
    # a trick: call frame() to establish/initialize the plot, then call
    # plot(new=TRUE) to prevent advancing to the next panel of the layout.
    # A secondary trick is also required: we set to zero margins before
    # calling frame(), because otherwise there can be a "figure margins
    # too large" error from frame(), if the layout is tight.
    omar <- par("mar")
    par(mar = rep(0, 4))
    frame()
    par(mar = omar)
    par(new = TRUE)
    # OK, done with the trick now.  PS: the long comments given here
    # are a result of persistent problems with large-margin errors,
    # and I don't want this new approach to get lost in code.
    # } 2014-04-02
    lineHeight <- par("cin")[2] # character height in inches
    oceDebug(debug, "lineHeight: ", lineHeight, " from cin\n")
    oceDebug(debug, "par(\"csi\"): ", par("csi"), "\n")
    tickSpace <- abs(par("tcl")) * lineHeight # inches (not sure on this)
    textSpace <- 1.25 * (lineHeight + if (haveZlab) lineHeight else 0)
    figureWidth <- par("fin")[1]
    figureHeight <- par("fin")[2]
    oceDebug(debug, "figureWidth:", format(figureWidth, digits = 2), "in\n")
    oceDebug(debug, "figureHeight:", format(figureHeight, digits = 2), "in\n")
    oceDebug(debug, "tickSpace:", tickSpace, "in\n")
    oceDebug(debug, "textSpace:", textSpace, "in\n")
    pc <- list(mai0 = par("mai"))
    pc$mai1 <- pc$mai0
    pc$mai1f <- pc$mai0
    pc$mai2 <- pc$mai0
    # P <- separation + width
    P <- width
    A <- tickSpace + textSpace
    if (pos == 1) {
        # alter top and bottom margins
        pc$mai1[1] <- A
        pc$mai1[3] <- figureHeight - P - A
        pc$mai1f[2] <- 0
        pc$mai1f[4] <- A
        pc$mai2[1] <- P + A + pc$mai0[1]
        pc$mai2[3] <- pc$mai0[3]
    } else if (pos == 2) {
        # alter left and right margins
        pc$mai1[2] <- A
        pc$mai1[4] <- figureWidth - P - A
        pc$mai1f[4] <- 0
        pc$mai1f[2] <- A
        pc$mai2[2] <- P + A + pc$mai0[2]
        pc$mai2[4] <- pc$mai0[4]
    } else if (pos == 3) {
        # alter top and bottom margins
        pc$mai1[1] <- figureHeight - P - A
        pc$mai1[3] <- A
        pc$mai1f[1] <- 0
        pc$mai1f[3] <- A
        pc$mai2[1] <- pc$mai0[1]
        pc$mai2[3] <- P + A + pc$mai0[3]
    } else if (pos == 4) {
        # DEVELOPER: work here first since it's the common case
        # alter left and right margins
        pc$mai1[2] <- figureWidth - P - A
        pc$mai1[4] <- A
        pc$mai1f[2] <- 0
        pc$mai1f[4] <- A
        pc$mai2[2] <- pc$mai0[2]
        pc$mai2[4] <- P + A + pc$mai0[4]
    } else {
        stop("pos must be in 1:4") # never reached
    }
    # Adjust palette margins (mai1); FIXME: should this also alter mai2?
    pc$mai1 <- pc$mai1 + maidiff
    pc$mai1f <- pc$mai1f + maidiff
    oceDebug(debug, "pc$mail1: ", paste(round(pc$mai1, 2), sep = " "), "\n")
    oceDebug(debug, "pc$mailf: ", paste(round(pc$mai1f, 2), sep = " "), "\n")
    oceDebug(debug, "END paletteCalculations\n", sep = "", unindent = 1)
    pc
}


#' Draw a Palette, Leaving Margins Suitable for an Accompanying Plot
#'
#' In the normal use, [drawPalette()] draws an image palette near the
#' right-hand side of the plotting device, and then adjusts the global margin
#' settings in such a way as to cause the next plot to appear (with much larger
#' width) to the left of the palette. The function can also be used, if
#' `zlim` is not provided, to adjust the margin without drawing anything;
#' this is useful in lining up the x axes of a stack of plots, some some of
#' which will have palettes and others not.
#'
#' The plot positioning is done entirely with margins, not with
#' `par(mfrow)` or other R schemes for multi-panel plots.  This means that
#' the user is free to use those schemes without worrying about nesting or
#' conflicts.
#'
#' @param zlim two-element vector containing the lower and upper limits of z.
#' This may also be a vector of any length exceeding 1, in which case its range
#' is used.
#'
#' @param zlab label for the palette scale.
#'
#' @param breaks optional numeric vector of the z values for breaks in the color scheme.
#' If `colormap` is provided, it takes precedence over `breaks` and `col`.
#'
#' @param col optional argument, either a vector of colors corresponding to the breaks, of length
#' 1 less than the number of breaks, or a function specifying colors.
#' If `col` is not provided, and if `colormap` is also not provided, then `col`
#' defaults to [oceColorsViridis()].
#' If `colormap` is provided, it takes precedence over `breaks` and `col`.
#'
#' @param colormap an optional color map as created by [colormap()].
#' If `colormap` is provided, it takes precedence over `breaks` and `col`.
#'
#' @param mai margins for palette, as defined in the usual way; see
#' [par()].  If not given, reasonable values are inferred from the
#' existence of a non-blank `zlab`.
#'
#' @param cex numeric character expansion value for text labels
#'
#' @param pos an integer indicating the location of the palette within the
#' plotting area, 1 for near the bottom, 2 for near the left-hand side, 3 for
#' near the top side, and 4 (the default) for near the right-hand side.
#'
#' @param las optional argument, passed to [axis()], to control the orientation
#' of numbers along the axis. As explained in the help for [par()], the
#' meaning of `las` is as follows: `las=0` (the default) means to put labels
#' parallel to the axis, `las=1` means horizontal (regardless of
#' axis orientation), `las=2` means perpendicular to the axis,
#' and `las=3` means to vertical (regardless of axis orientation).  Note that
#' the automatic computation of margin spacing parameter `mai`
#' assumes that `las=0`, and so for other cases, the user may need to
#' specify the `mai` argument directly.
#'
#' @param labels optional vector of labels for ticks on palette axis (must
#' correspond with `at`)
#'
#' @param at optional vector of positions for the `label`s
#'
#' @param levels optional contour levels, in preference to `breaks`
#' values, to be added to the image if `drawContours` is `TRUE`.
#'
#' @param drawContours logical value indicating whether to draw contours on the
#' palette, at the color breaks.
#'
#' @param plot logical value indicating whether to plot the palette, the
#' default, or whether to just alter the margins to make space for where the
#' palette would have gone.  The latter case may be useful in lining up plots,
#' as in example 1 of \dQuote{Examples}.
#'
#' @param fullpage logical value indicating whether to draw the palette filling
#' the whole plot width (apart from `mai`, of course).  This can be
#' helpful if the palette panel is to be created with [layout()], as
#' illustrated in the \dQuote{Examples}.
#'
#' @param drawTriangles logical value indicating whether to draw triangles on
#' the top and bottom of the palette.  If a single value is provided, it applies
#' to both ends of the palette.  If a pair is provided, the first refers to the
#' lower range of the palette, and the second to the upper range.
#'
#' @param axisPalette optional replacement function for `axis()`, e.g.
#' for exponential notation on large or small values.
#'
#' @param tformat optional format for axis labels, if the variable is a time
#' type (ignored otherwise).
#'
# @param cex.zlab character expansion factor for z label
#'
#' @param debug a flag that turns on debugging.  Set to 1 to get a moderate
#' amount of debugging information, or to 2 to get more.
#'
#' @param \dots optional arguments passed to plotting functions.
#'
#' @return None.
#'
#' @section Use with multi-panel plots: An important consequence of the margin
#' adjustment is that multi-panel plots require that the initial margin be
#' stored prior to the first call to [drawPalette()], and reset after each
#' palette-plot pair.  This method is illustrated in \dQuote{Examples}.
#'
#' @author Dan Kelley, with help from Clark Richards
#'
#' @seealso This is used by [imagep()].
#'
#' @examples
#'
#' library(oce)
#' par(mgp = getOption("oceMgp"))
#'
#' # 1. A three-panel plot
#' par(mfrow = c(3, 1), mar = c(3, 3, 1, 1))
#' omar <- par("mar") # save initial margin
#'
#' # 1a. top panel: simple case with Viridis scheme
#' drawPalette(zlim = c(0, 1), col = oce.colorsViridis(10))
#' plot(1:10, 1:10, col = oce.colorsViridis(10)[1:10], pch = 20, cex = 3, xlab = "x", ylab = "y")
#' par(mar = omar) # reset margin
#'
#' # 1b. middle panel: colormap
#' cm <- colormap(name = "gmt_globe")
#' drawPalette(colormap = cm)
#' icol <- seq_along(cm$col)
#' plot(icol, cm$breaks[icol],
#'     pch = 20, cex = 2, col = cm$col,
#'     xlab = "Palette index", ylab = "Palette breaks"
#' )
#' par(mar = omar) # reset margin
#'
#' # 1c. bottom panel: space for palette (to line up graphs)
#' drawPalette(plot = FALSE)
#' plot(1:10, 1:10, col = oce.colorsViridis(10)[1:10], pch = 20, cex = 3, xlab = "x", ylab = "y")
#' par(mar = omar) # reset margin
#'
#' # 2. Use layout to mimic the action of imagep(), with the width
#' # of the palette region being 14 percent of figure width.
#' d <- 0.14
#' layout(matrix(1:2, nrow = 1), widths = c(1 - d, d))
#' image(volcano, col = oce.colorsViridis(100), zlim = c(90, 200))
#' contour(volcano, add = TRUE)
#' drawPalette(c(90, 200), fullpage = TRUE, col = oce.colorsViridis)
drawPalette <- function(
    zlim, zlab = "", breaks, col, colormap, mai, cex = par("cex"), pos = 4, las = 0,
    labels = NULL, at = NULL, levels, drawContours = FALSE, plot = TRUE, fullpage = FALSE,
    drawTriangles = FALSE, axisPalette, tformat, debug = getOption("oceDebug"), ...) {
    debug <- max(0, min(debug, 2))
    oceDebug(debug, "drawPalette(",
        argShow(zlab),
        argShow(zlim),
        argShow(cex),
        argShow(mai),
        argShow(breaks),
        argShow(at),
        argShow(labels),
        argShow(fullpage),
        "...) START\n",
        sep = "", unindent = 1
    )
    atGiven <- !is.null(at)
    breaksGiven <- !missing(breaks)
    zlimGiven <- !missing(zlim)
    if (zlimGiven) {
        if (!is.numeric(zlim)) {
            stop("zlim must be 'numeric', not '", class(zlim), "'")
        }
        if (sum(is.finite(zlim)) < 2L) {
            stop("zlim must hold 2 or more non-NA values")
        }
        if (length(zlim) > 2L) {
            zlim <- range(is.finite(zlim), na.rm = TRUE)
        }
        if (zlim[2] < zlim[1]) {
            stop("zlim must be ordered")
        }
    }
    # If 'zlim' was not given, try to infer it from 'breaks' or from 'at' if
    # 'breaks' was not given.  If none of the three is given, we cannot draw the
    # palette.
    if (!zlimGiven) {
        if (breaksGiven) {
            zlim <- range(breaks, na.rm = TRUE)
            oceDebug(debug, "setting 'zlim' to c(", paste(zlim, collapse = ", "), ") based on 'breaks'\n")
            zlimGiven <- TRUE # fake it
        } else if (atGiven) {
            zlim <- range(at, na.rm = TRUE)
            oceDebug(debug, "setting 'zlim' to c(", paste(zlim, collapse = ", "), ") based on 'at'\n")
            zlimGiven <- TRUE # fake it
        }
    }
    colGiven <- !missing(col)
    oceDebug(debug, "colGiven=", colGiven, "\n", sep = "")
    colormapGiven <- !missing(colormap)
    oceDebug(debug, "colormapGiven=", colormapGiven, "\n", sep = "")
    # Cannot plot if none of (zlim,breaks,at) was given.  But other computations
    # are still undertaken, for other purposes.
    if (!zlimGiven && !colormapGiven && !breaksGiven && !atGiven) {
        plot <- FALSE
    }
    levelsGiven <- !missing(levels)
    if (zlimGiven) {
        zlim <- range(zlim, na.rm = TRUE)
    }
    pos <- as.integer(pos)
    if (!(pos %in% 1:4)) {
        stop("'pos' must be 1, 2, 3 or 4")
    }
    maiGiven <- !missing(mai)
    haveZlab <- !is.null(zlab) && sum(nchar(zlab)) > 0
    if (colormapGiven && !zlimGiven) {
        oceDebug(debug, "inferring zlim from colormap\n")
        zlim <- colormap$zlim
        zlimGiven <- TRUE
        if (zlim[2] <= zlim[1]) {
            stop("colormap zlim values must be ordered and distinct")
        }
    }
    zIsTime <- zlimGiven && inherits(zlim[1], "POSIXt")
    zlimTZ <- if (zlimGiven) attr(zlim[1], "tzone") else NA
    oceDebug(debug, "zIsTime=", zIsTime, "\n")
    if (zIsTime) {
        zlim <- as.numeric(zlim)
    }
    omai <- par("mai")
    oceDebug(debug, "original mai: omai=c(", paste(format(omai, digits = 3), collapse = ","), ")\n")
    if (!maiGiven) {
        mai <- rep(0, 4)
    }
    pc <- paletteCalculations(maidiff = mai, pos = pos, zlab = zlab, debug = debug - 1)
    contours <- if (breaksGiven) breaks else NULL
    if (colormapGiven) {
        oceDebug(debug, "colormap was given, so getting breaks and col from it\n")
        breaks <- colormap$breaks
        col <- colormap$col
        # Trick the code below, to avoid auto-creating breaks
        breaksGiven <- TRUE
        # colGiven <- TRUE
        if (!zlimGiven) {
            zlim <- range(breaks, na.rm = TRUE)
        }
        zlimGiven <- TRUE
        breaksOrig <- breaks
        contours <- breaks
    } else {
        oceDebug(debug, "colormap was not given\n")
        if (zlimGiven && !is.null(zlim)) {
            if (breaksGiven) {
                breaksOrig <- breaks
                contours <- breaks
                oceDebug(debug, "user gave ", length(breaks), "breaks\n")
            } else {
                zrange <- zlim
                if (missing(col)) {
                    # Change: this used to be pretty(zlim) but when would a person
                    # ever want an image with just a few colours?
                    breaks <- seq(zlim[1], zlim[2], length.out = PLEN) # smooth image color scale
                    contours <- breaks
                    oceDebug(debug, "breaks not given, col not given: set", length(breaks), "breaks\n")
                } else {
                    if (is.function(col)) {
                        breaks <- seq(zlim[1], zlim[2], length.out = PLEN) # smooth image color scale
                        contours <- pretty(zlim)
                        oceDebug(debug, "breaks not given; col is a function; set", length(breaks), "breaks\n")
                    } else {
                        breaks <- seq(zlim[1], zlim[2], length.out = 1 + length(col))
                        contours <- seq(zlim[1], zlim[2], length.out = 1 + length(col))
                        oceDebug(debug, "breaks not given; col is a vector; set", length(breaks), "breaks\n")
                    }
                }
                breaksOrig <- breaks
                breaks[1] <- zrange[1]
                breaks[length(breaks)] <- zrange[2]
            }
            if (missing(col)) {
                oceDebug(debug, "setting default 'col' to oce.colorsViridis(near line 394)\n")
                # col <- oce.colorsPalette(n=length(breaks)-1)
                col <- oce.colorsViridis(n = length(breaks) - 1)
            }
            if (is.function(col)) {
                oceDebug(debug, "col is a function, so calling it and making it a vector\n")
                col <- col(n = length(breaks) - 1)
            }
        }
    }
    oceDebug(debug, "plot:", plot, "; fullpage:", fullpage, "\n")
    if (plot) {
        if (fullpage) {
            par(mai = ifelse(pc$mai1f > 0, pc$mai1f, 0))
        } else {
            par(mai = ifelse(pc$mai1 > 0, pc$mai1, 0))
        }
        oceDebug(debug, "A. par(mai=c(", paste(round(par("mai"), 1), collapse = ","), "))\n")
        oceDebug(debug, "A. par(mar=c(", paste(round(par("mar"), 1), collapse = ","), "))\n")
        if (!breaksGiven) {
            oceDebug(debug, "'breaks' was not given\n")
            palette <- seq(zlim[1], zlim[2], length.out = PLEN)
            if (pos == 1 || pos == 3) {
                image(
                    x = palette, y = 1, z = matrix(palette, ncol = 1), axes = FALSE, xlab = "", ylab = "",
                    col = col, zlim = zlim
                )
            } else if (pos == 2 || pos == 4) {
                FIN <- par("fin")
                PIN <- par("pin")
                MAI <- par("mai")
                oceDebug(
                    debug, "mai[2] and mail[4] add to", MAI[2] + MAI[4], "fin[1]=", FIN[1],
                    "so image will occupy ", FIN[1] - MAI[2] - MAI[4], "inches\n"
                )
                oceDebug(
                    debug, "mai[2] and mail[4] add to", MAI[2] + MAI[4], "pin[1]=", PIN[1],
                    "so image will occupy ", FIN[1] - MAI[2] - MAI[4], "inches\n"
                )
                image(
                    x = 1, y = palette, z = matrix(palette, nrow = 1), axes = FALSE, xlab = "", ylab = "",
                    col = col, zlim = zlim
                )
            } else {
                stop("pos must be 1, 2, 3 or 4") # cannot be reached
            }
        } else {
            oceDebug(debug, "'breaks' was given, starting with ", vectorShow(breaks))
            palette <- seq(zlim[1], zlim[2], length.out = PLEN)
            oceDebug(debug, "drawing palette image, with ", vectorShow(par("mai")))
            oceDebug(
                debug, "palette image width: ",
                par("fin")[1] - par("mai")[2] - par("mai")[4], "in\n"
            )
            oceDebug(
                debug, "palette image height: ",
                par("fin")[2] - par("mai")[1] - par("mai")[3], "in\n"
            )
            oceDebug(debug, vectorShow(par("pin")))
            oceDebug(debug, vectorShow(par("fin")))
            if (pos == 1 || pos == 3) {
                oceDebug(debug, "pos=", pos, " (for bottom or top side)\n")
                image(
                    x = palette, y = 1, z = matrix(palette, ncol = 1), axes = FALSE, xlab = "", ylab = "",
                    breaks = breaksOrig, col = col, zlim = zlim
                )
            } else if (pos == 2 || pos == 4) {
                oceDebug(debug, "pos=", pos, " (for left or right side)\n")
                oceDebug(debug, vectorShow(par("mai")))
                oceDebug(debug, "B. x non-margin width: ", par("fin")[1] - par("mai")[2] - par("mai")[4], "\n")
                oceDebug(debug, "B. y non-margin height: ", par("fin")[2] - par("mai")[1] - par("mai")[3], "\n")
                oceDebug(debug, vectorShow(par("mar")))
                image(
                    x = 1, y = palette, z = matrix(palette, nrow = 1), axes = FALSE, xlab = "", ylab = "",
                    breaks = breaksOrig, col = col, zlim = zlim
                )
            } else {
                stop("pos must be 1, 2, 3 or 4") # cannot be reached
            }
        }
        if (drawContours) {
            if (pos == 1 || pos == 3) {
                if (levelsGiven) abline(v = levels) else abline(v = contours)
            } else if (pos == 2 || pos == 4) {
                if (levelsGiven) abline(h = levels) else abline(h = contours)
            } else {
                stop("pos must be 1, 2, 3 or 4") # cannot be reached
            }
        }
        box()
        drawTriangles <- rep(drawTriangles, length.out = 2)
        if (any(drawTriangles, na.rm = TRUE)) {
            mai <- par("mai")
            fin <- par("fin")
            width <- fin[1] - mai[2] - mai[4] # inch
            paletteHeight <- fin[2] - mai[1] - mai[3] # inch
            usr <- par("usr")
            dx <- usr[2] - usr[1] # user unit
            dy <- usr[4] - usr[3] # user unit
            triangleHeight <- 1 / 3 * width * dy / dx / paletteHeight
            oceDebug(debug, "triangleHeight=", triangleHeight, "(user units)\n")
            if (drawTriangles[2]) {
                if (pos == 1 || pos == 3) {
                    warning("horizontal triangles not working yet")
                } else if (pos == 2 || pos == 4) {
                    polygon(c(usr[1], 0.5 * (usr[1] + usr[2]), usr[2]),
                        usr[4] + c(0, triangleHeight, 0),
                        col = col[length(col)],
                        border = col[length(col)], xpd = TRUE
                    )
                    lines(c(usr[1], 0.5 * (usr[1] + usr[2]), usr[2]),
                        usr[4] + c(0, triangleHeight, 0),
                        xpd = TRUE
                    )
                }
            }
            if (drawTriangles[1]) {
                if (pos == 1 || pos == 3) {
                    warning("horizontal triangles not working yet")
                } else if (pos == 2 || pos == 4) {
                    polygon(c(usr[1], 0.5 * (usr[1] + usr[2]), usr[2]),
                        usr[3] + c(0, -triangleHeight, 0),
                        col = col[1],
                        border = col[1], xpd = TRUE
                    )
                    lines(c(usr[1], 0.5 * (usr[1] + usr[2]), usr[2]),
                        usr[3] + c(0, -triangleHeight, 0),
                        xpd = TRUE
                    )
                }
            }
        }
        if (zIsTime && is.null(at)) {
            at <- as.numeric(pretty(zlim))
        } else if (is.null(at)) {
            if (missing(axisPalette)) {
                # NB. in next line, the '10' matches a call to pretty() in imagep().
                at <- if (!is.null(contours) && is.null(at)) prettyLocal(contours, 10) else prettyLocal(palette, 10)
                oceDebug(debug, "with no axisPalette, created 'at' as c(", paste(at, collapse = ", "), ")\n")
            } else {
                # Guess that the axis labels may need more space
                at <- if (!is.null(contours) && is.null(at)) {
                    prettyLocal(contours, 6)
                } else {
                    prettyLocal(palette, 6)
                }
                oceDebug(debug, "with axisPalette given, created 'at' as c(", paste(at, collapse = ", "), ")\n")
            }
        }
        oceDebug(debug, "at=c(", paste(at, collapse = ", "), ")\n")
        if (is.null(labels)) {
            if (zIsTime) {
                if (!missing(tformat)) {
                    labels <- format(numberAsPOSIXct(at), format = tformat)
                } else {
                    labels <- abbreviateTimeLabels(numberAsPOSIXct(at), ...)
                }
            } else {
                labels <- format(at)
            }
        }
        oceDebug(debug, "'labels' c(", paste(at, collapse = ", "), ") originally\n")
        labels <- sub("^[ ]*", "", labels)
        oceDebug(debug, "'labels' c(", paste(at, collapse = ", "), ") after trim whitespace at left\n")
        labels <- sub("[ ]*$", "", labels)
        oceDebug(debug, "'labels' c(", paste(at, collapse = ", "), ") after trim whitespace at right\n")
        # FIXME: just guessing on best 'line', used below
        if (!missing(axisPalette)) {
            axis <- axisPalette
        }
        oceDebug(debug, "about to draw palette axis at pos=", pos, " with zlab=\"", zlab, "\" with cex=", cex, "\n", sep = "")
        # Use 'zlim' to infer axis labels, unless 'at' was given
        if (zlimGiven && is.null(at)) {
            if (zIsTime) {
                oceDebug(debug, "palette axis labels inferred from temporal zlim=c(",
                    paste(numberAsPOSIXct(zlim), collapse = ","), ")\n",
                    sep = ""
                )
                labels <- pretty(numberAsPOSIXct(zlim, tz = if (is.null(zlimTZ)) "UTC" else zlimTZ))
                at <- labels
                if (!missing(tformat)) {
                    labels <- format(labels, format = tformat)
                }
            } else {
                oceDebug(debug, "palette axis labels inferred from numeric zlim=c(",
                    paste(zlim, collapse = ","), ")\n",
                    sep = ""
                )
                labels <- pretty(zlim)
                at <- labels
            }
        }
        oceDebug(debug, "finally, palette axis labels:", vectorShow(labels))
        oceDebug(debug, "finally, palette axis labels positions:", vectorShow(at))
        if (pos == 1) {
            axis(side = 1, at = at, labels = labels, mgp = c(2.5, 0.7, 0), cex.axis = cex, las = las)
            if (haveZlab) mtext(zlab, side = 1, line = getOption("oceMgp")[1], cex = cex)
        } else if (pos == 2) {
            axis(side = 2, at = at, labels = labels, mgp = c(2.5, 0.7, 0), cex.axis = cex, las = las)
            if (haveZlab) mtext(zlab, side = 2, line = getOption("oceMgp")[1], cex = cex)
        } else if (pos == 3) {
            axis(side = 3, at = at, labels = labels, mgp = c(2.5, 0.7, 0), cex.axis = cex, las = las)
            if (haveZlab) mtext(zlab, side = 3, line = getOption("oceMgp")[1], cex = cex)
        } else if (pos == 4) {
            axis(side = 4, at = at, labels = labels, mgp = c(2.5, 0.7, 0), cex.axis = cex, las = las)
            if (haveZlab) mtext(zlab, side = 4, line = getOption("oceMgp")[1], cex = cex)
        } else {
            stop("pos must be 1, 2, 3 or 4") # cannot be reached
        }
    }
    # FIXME why the "new" in only one case? Generally, the graphic state is confusing!
    if (fullpage) {
        par(mai = pc$mai0) # reset to original
    } else {
        if (zlimGiven) {
            par(new = TRUE, mai = pc$mai2)
        } else {
            par(mai = pc$mai2)
        }
    }
    oceDebug(debug, vectorShow(par("mar")))
    oceDebug(debug, vectorShow(par("mai")))
    oceDebug(debug, "END drawPalette()\n", unindent = 1)
    invisible(NULL)
}


#' Plot an Image with a Color Palette
#'
#' Plot an image with a color palette, in a way that does not conflict with the
#' `mfrow` or `mfcol` arguments of [par()], or with [layout()].  To plot just a
#' palette, e.g. to get an x-y plot with points colored according to a palette,
#' use [drawPalette()] and then draw the main diagram.
#'
#' @details
#' By default, creates an image with a color palette to the right.  The effect is similar to
#' [filled.contour()] except that with `imagep` it is possible to
#' set the [layout()] outside the function, which enables the creation
#' of plots with many image-palette panels.  Note that the contour lines may not
#' coincide with the color transitions, in the case of coarse images.
#'
#' Note that this does not use [layout()] or any of the other screen
#' splitting methods.  It simply manipulates margins, and draws two plots
#' together.  This lets users employ their favourite layout schemes.
#'
#' NOTE: `imagep` is an analogue of [image()], and from that
#' it borrows a the convention that the number of rows in the matrix corresponds to
#' to `x` axis, not the `y` axis.  (Actually, [image()] permits
#' the length of `x` to match either `nrow(z)` or `1+nrow(z)`, but
#' here only the first is permitted.)
#'
#' @param x,y These have different meanings in different modes of operation.
#'
#' *Mode 1.* One
#' mode has them meaning the locations of coordinates along which values
#' matrix `z` are defined. In this case, both `x` and `y`
#' must be supplied and, within each, the values must be finite and
#' distinct; if values are out of order, they (and `z`) will be
#' transformed to put them in order.
#' ordered in a matching way).
#'
#' *Mode 2.*
#' If `z` is provided but not `x` and `y`, then the latter
#' are constructed to
#' indicate the indices of the matrix, in contrast
#' to the range of 0 to 1, as is the case for [image()].
#'
#' *Mode 3.* If
#' `x` is a list, its components `x$x` and `x$y` are used
#' for `x` and `y`, respectively. If the list has component
#' `z` this is used for `z`. (NOTE: these arguments are meant to
#' mimic those of [image()], which explains the same description
#' here.)  *Mode 4.* There are also some special cases, e.g. if `x` is a
#' topographic object such as can be created with [read.topo()]
#' or [as.topo()], then longitude and latitude are used for
#' axes, and topographic height is drawn.
#'
#' @param z A matrix containing the values to be plotted (NAs are allowed). Note
#' that x can be used instead of z for convenience. (NOTE: these arguments
#' are meant to mimic those of [image()], which explains the same
#' description here.)
#'
#' @param xlim,ylim Limits on x and y axes.
#'
#' @param zlim If missing, the z scale is determined by the range of the data.
#' If provided, `zlim` may take several forms. First, it may be a pair
#' of numbers that specify the limits for the color scale.  Second,
#' it could be the string `"histogram"`, to yield a flattened
#' histogram (i.e. to increase contrast). Third, it could be the
#' string `"symmetric"`, to yield limits that are symmetric
#' about zero, which can be helpful in drawing velocity fields,
#' for which a zero value has a particular meaning (in which case,
#' a good color scheme might be `col=oceColorsTwo`).
#'
#' @param zclip Logical, indicating whether to clip the colors to those
#' corresponding to `zlim`. This only works if `zlim` is
#' provided. Clipped regions will be colored with `missingColor`.
#' Thus, clipping an image is somewhat analogous to clipping in an xy
#' plot, with clipped data being ignored, which in an image means to be be
#' colored with `missingColor`.
#'
#' @param flipy Logical, with `TRUE` indicating that the graph
#' should have the y axis reversed, i.e. with smaller values at
#' the bottom of the page. (*Historical note:* until 2019 March 26,
#' the meaning of `flipy` was different; it meant to reverse the
#' range of the y axis, so that if `ylim` were given as a reversed
#' range, then setting `flipy=TRUE` would reverse the flip, yielding
#' a conventional axis with smaller values at the bottom.)
#'
#' @param xlab,ylab,zlab Names for x axis, y axis, and the image values.
#'
#' @param zlabPosition String indicating where to put the label for the z axis,
#' either at the top-right of the main image, or on the side, in the axis
#' for the palette.
#'
#' @param las.palette Parameter controlling the orientation of labels on the
#' image palette, passed as the `las` argument to [drawPalette()].  See the
#' documentation for [drawPalette()] for details.

#' @param decimate an item that controls whether the image will be decimated
#' before plotting, in four possible cases. Note that the default value of
#' TRUE can be overridden by using [options()] as e.g.
#' `options(oceImageDecimate = FALSE)` in a `~/.Rprofile` startup file
#' or locally within a script or session.
#'
#' 1. If `decimate=FALSE` then every grid cell in the matrix will
#'    be represented by a pixel in the image.
#'
#' 2. If `decimate=TRUE` (the default, unless `"oceImagepDecimate"` is
#'    set to another value in the startup file), then decimation will be done
#'    in the horizontal or vertical direction (or both) if the length of the
#'    corresponding edge of the `z` matrix exceeds 800. (This also creates
#'    a warning message.) The decimation
#'    factor is computed as the integer just below the ratio of `z` dimension
#'    to 400. Thus, no decimation is done if the dimension is less than 800,
#'    but if the dimension s between 800 and 1199, only every second grid
#'    point is mapped to a pixel in the image.
#'
#' 3. If `decimate` is an integer, then that `z` is subsampled
#'    at `seq.int(1L, dim(z)[1], by=decimate)` (as is `x`), and
#'    the same is done for the `y` direction.
#'
#' 4. If `decimate` is a vector of two integers, the first is used for
#'    the first index of `z`, and the second is used for the second
#'    index.
#'
#' @param quiet logical value indicating whether to silence warnings that
#' might occur if the image is being decimated.
#'
#' @param breaks The z values for breaks in the color scheme.  If this is of
#' length 1, the value indicates the desired number of breaks, which is
#' supplied to [pretty()], in determining clean break points.
#' If `colormap` is provided, it takes precedence over `breaks` and `col`.
#'
#' @param col Either a vector of colors corresponding to the breaks, of length
#' 1 plus the number of breaks, or a function specifying colors.
#' If `col` is not provided, and if `colormap` is also not provided, then `col`
#' defaults to [oceColorsViridis()].
#' If `colormap` is provided, it takes precedence over `breaks` and `col`.
#'
#' @param colormap A color map as created by [colormap()].  If
#' provided, then `colormap$breaks` and `colormap$col` take
#' precedence over the present arguments `breaks` and `col`.
#' (All of the other contents of `colormap` are ignored, though.)
#' If `colormap` is provided, it takes precedence over `breaks` and `col`.
#'
#' @param labels Optional vector of labels for ticks on palette axis (must
#' correspond with `at`).
#'
#' @param at Optional vector of positions for the `label`s.
#'
#' @param drawContours Logical value indicating whether to draw contours on the
#' image, and palette, at the color breaks.  Images with a great deal of
#' high-wavenumber variation look poor with contours.
#'
#' @param tformat Optional argument passed to [oce.plot.ts()], for
#' plot types that call that function.  (See [strptime()] for the
#' format used.)
#'
#' @param drawTimeRange Logical, only used if the `x` axis is a
#' time.  If `TRUE`, then an indication of the time range of the
#' data (not the axis) is indicated at the top-left margin of the
#' graph.  This is useful because the labels on time axes only indicate
#' hours if the range is less than a day, etc.
#'
#' @param drawPalette Indication of the type of palette to draw, if any.  If
#' `drawPalette=TRUE`, a palette is drawn at the right-hand side of the
#' main image.  If `drawPalette=FALSE`, no palette is drawn, and the
#' right-hand side of the plot has a thin margin.  If
#' `drawPalette="space"`, then no palette is drawn, but space is put in
#' the right-hand margin to occupy the region in which the palette would
#' have been drawn.  This last form is useful for producing stacked plots
#' with uniform left and right margins, but with palettes on only some of
#' the images.
#'
#' @param drawTriangles Logical value indicating whether to draw
#' triangles on the top and bottom of the palette.  This is passed to
#' [drawPalette()].
#'
#' @param filledContour Boolean value indicating whether to use filled
#' contours to plot the image.
#'
#' @param missingColor A color to be used to indicate missing data, or
#' `NULL` for transparent (to see this, try setting
#' `par("bg")<-"red"`).
#'
#' @param useRaster A logical value passed to [image()], in cases
#' where `filledContour` is `FALSE`. Setting `useRaster=TRUE`
#' can alleviate some anti-aliasing effects on some plot devices;
#' see the documentation for [image()].
#'
#' @param mgp A 3-element numerical vector to use for `par(mgp)`, and
#' also for `par(mar)`, computed from this.  The default is
#' tighter than the R default, in order to use more space for the
#' data and less for the axes.
#'
#' @param mar A 4-element Value to be used with [`par`]`("mar")`.  If not
#' given, a reasonable value is calculated based on whether `xlab` and
#' `ylab` are empty strings.
#'
#' @param mai.palette Palette margin corrections (in inches), added to the
#' `mai` value used for the palette.  Use with care.
#'
#' @param xaxs Character indicating whether image should extend to edge
#' of x axis (with value `"i"`) or not; see
#' [`par`]`("xaxs")`.
#'
#' @param yaxs As `xaxs` but for y axis.
#'
#' @param asp Aspect ratio of the plot, as for [plot.default()]. If
#' `x` inherits from [topo-class] and `asp=NA` (the
#' default) then `asp` is redefined to be the reciprocal of the
#' mean latitude in `x`, as a way to reduce geographical distortion.
#' Otherwise, if `asp` is not `NA`, then it is used directly.
#'
#' @param cex numeric character expansion factor, used for `cex.axis`, `cex.lab` and `cex.main`,
#' if those values are not supplied.
#'
#' @param cex.axis,cex.lab,cex.main numeric character expansion factors for axis numbers,
#' axis names and plot titles; see [par()].
#'
#' @param  axes Logical, set `TRUE` to get axes on the main image.
#'
#' @param  main Title for plot.
#'
#' @param  axisPalette Optional replacement function for [axis()], passed to
#'         [drawPalette()].
#'
#' @param add Logical value indicating whether to add to an existing plot.
#' The default value, `FALSE` indicates that a new plot is to be created.
#' However, if `add` is `TRUE`, the idea is to add an image (but not
#' its palette or its axes) to an existing plot. Clearly, then, arguments
#' such `xlim` are to be ignored. Indeed, if `add=TRUE`, the only
#' arguments examined are `x` (which must be a vector; the mode of providing
#' a matrix or `oce` object does not work), `y`, `z`,
#' `decimate`, plus either `colormap` or
#' both `breaks` and `col`.
#'
#' @param debug A flag that turns on debugging.  Set to 1 to get a
#' moderate amount of debugging information, or to 2 to get more.
#'
#' @param \dots Optional arguments passed to plotting functions.
#'
#' @return A list is silently returned, containing `xat` and `yat`,
#' values that can be used by [oce.grid()] to add a grid to the
#' plot.
#'
#' @seealso This uses [drawPalette()], and is used by [plot,adp-method()],
#' [plot,landsat-method()], and other image-generating functions.
#'
# @section Note for RStudio/OSX users:
# On OSX computers, some versions of RStudio produce a margin-size error when
# `imagep` is called. The problem is not isolated to `imagep`;
# it occurs with other packages, and a web
# search reveals repeated bug reports submitted to RStudio.
# The problem seems to come and go, as RStudio evolves. In the
# `imagep` case, things worked properly for
# RStudio version 0.99.451 (released late in 2015), but not
# for version 0.99.878 (released early
# in 2016). A bug report was sent to RStudio in
# January 2016, with a minimal example that boiled the issue
# down to a few lines of basic R code (not using `imagep`
# or even `oce`).
# Although communications with RStudio gave
# reason for optimism, the problem persisted in version 0.99.892,
# released March 4. New versions of RStudio will be checked as they
# come out, with status updates here.
# Pending an RStudio solution, users can avoid the error
# simply by opening
# a new (and separate) plotting window with [dev.new()].
# In doing so, they may find that this is preferable generally,
# given the limitations of one-window interfaces.
#'
#' @examples
#' library(oce)
#'
#' # 1. simplest use
#' imagep(volcano)
#'
#' # 2. something oceanographic (internal-wave speed)
#' h <- seq(0, 50, length.out = 100)
#' drho <- seq(1, 3, length.out = 200)
#' speed <- outer(h, drho, function(drho, h) sqrt(9.8 * drho * h / 1024))
#' imagep(h, drho, speed,
#'     xlab = "Equivalent depth [m]",
#'     ylab = expression(paste(Delta * rho, " [ kg/m^3 ]")),
#'     zlab = "Internal-wave speed [m/s]"
#' )
#'
#' # 3. fancy labelling on atan() function
#' x <- seq(0, 1, 0.01)
#' y <- seq(0, 1, 0.01)
#' angle <- outer(x, y, function(x, y) atan2(y, x))
#' imagep(x, y, angle,
#'     filledContour = TRUE, breaks = c(0, pi / 4, pi / 2),
#'     col = c("lightgray", "darkgray"),
#'     at = c(0, pi / 4, pi / 2),
#'     labels = c(0, expression(pi / 4), expression(pi / 2))
#' )
#'
#' # 5. y-axis flipping
#' par(mfrow = c(2, 2))
#' data(adp)
#' d <- adp[["distance"]]
#' t <- adp[["time"]]
#' u <- adp[["v"]][, , 1]
#' imagep(t, d, u, drawTimeRange = FALSE)
#' mtext("normal")
#' imagep(t, d, u, flipy = TRUE, drawTimeRange = FALSE)
#' mtext("flipy")
#' imagep(t, d, u, ylim = rev(range(d)), drawTimeRange = FALSE)
#' mtext("ylim")
#' imagep(t, d, u, ylim = rev(range(d)), flipy = TRUE, drawTimeRange = FALSE)
#' mtext("flipy and ylim")
#' par(mfrow = c(1, 1))
#'
#' # 6. a colormap case
#' data(topoWorld)
#' cm <- colormap(name = "gmt_globe")
#' imagep(topoWorld, colormap = cm)
#'
#' @author Dan Kelley and Clark Richards
imagep <- function(
    x, y, z,
    xlim, ylim, zlim,
    zclip = FALSE, flipy = FALSE,
    xlab = "", ylab = "", zlab = "", zlabPosition = c("top", "side"),
    las.palette = 0,
    decimate = getOption("oceImagepDecimate", TRUE),
    quiet = FALSE,
    breaks, col, colormap, labels = NULL, at = NULL,
    drawContours = FALSE,
    drawPalette = TRUE,
    drawTriangles = FALSE,
    tformat,
    drawTimeRange = getOption("oceDrawTimeRange"),
    filledContour = FALSE,
    missingColor = NULL,
    useRaster,
    mgp = getOption("oceMgp"),
    mar, mai.palette,
    xaxs = "i", yaxs = "i",
    asp = NA,
    cex = par("cex"),
    cex.axis = cex, cex.lab = cex, cex.main = cex,
    axes = TRUE,
    main = "",
    axisPalette,
    add = FALSE,
    debug = getOption("oceDebug"),
    ...) {
    debug <- max(0, min(debug, 3))
    oceDebug(debug, "imagep(x,y,z,xlab,ylab,",
        argShow(zlim),
        argShow(flipy),
        argShow(cex),
        argShow(cex.axis),
        argShow(cex.lab),
        argShow(cex.main),
        argShow(mgp),
        argShow(mar),
        argShow(mai.palette),
        argShow(breaks),
        argShow(add, last = TRUE),
        ", ...) START\n",
        sep = "", unindent = 1
    )
    zlabPosition <- match.arg(zlabPosition)
    if (!is.logical(flipy)) {
        stop("flipy must be TRUE or FALSE")
    }
    if (is.logical(add)) {
        if (add) {
            if (missing(x)) {
                stop("must give 'x'")
            }
            if (missing(y)) {
                stop("must give 'y'")
            }
            if (missing(z)) {
                stop("must give 'z'")
            }
            if (missing(colormap)) {
                if (missing(breaks)) {
                    stop("must give 'breaks'")
                }
                if (missing(col)) {
                    stop("must give 'col'")
                }
            } else {
                breaks <- colormap$breaks
                col <- colormap$col
                zlim <- colormap$zlim
                # FIXME: need to check zclip here too
                zclip <- colormap$zclip
            }
            if (!zclip) {
                oceDebug(debug, "using zlim=c(", zlim[1], ",", zlim[2], ") for out-of-range values.\n", sep = "")
                z[z < zlim[1]] <- zlim[1]
                z[z > zlim[2]] <- zlim[2]
            } else {
                oceDebug(debug, "using missingColor for out-of-range values")
                z[z < zlim[1]] <- NA
                z[z > zlim[2]] <- NA
            }
            oceDebug(debug, "decimate: ", paste(decimate, collapse = " "), " (before calculation)\n")
            if (is.logical(decimate)) {
                if (decimate) {
                    decimate <- as.integer(dim(z) / 400)
                    decimate <- ifelse(decimate < 1, 1, decimate)
                } else {
                    decimate <- c(1, 1)
                }
            } else {
                decimate <- rep(as.numeric(decimate), length.out = 2)
            }
            oceDebug(debug, "decimate: ", paste(decimate, collapse = " "), " (after calculation)\n")
            ix <- seq(1L, length(x), by = decimate[1])
            iy <- seq(1L, length(y), by = decimate[2])
            if (is.function(col)) {
                col <- col(n = length(breaks) - 1)
            }
            oceDebug(debug, "about to draw image on top of existing plot\n")
            image(x[ix], y[iy], z[ix, iy],
                breaks = breaks, col = col, useRaster = useRaster, # why useRaster?
                add = TRUE
            )
            oceDebug(debug, "END imagep()\n", unindent = 1, sep = "")
            return(invisible(list(xat = NULL, yat = NULL, decimate = decimate)))
        }
    } else {
        stop("'add' must be a logical value")
    }
    xlimGiven <- !missing(xlim)
    ylimGiven <- !missing(ylim)
    zlimGiven <- !missing(zlim) && !is.null(zlim) # latter is used by plot,adp-method
    # Guard against poor setup
    if (xlimGiven && length(xlim) != 2) {
        stop("length of xlim must be 2")
    }
    if (ylimGiven && length(ylim) != 2) {
        stop("length of ylim must be 2")
    }
    if (zlimGiven && !(length(zlim) %in% 1:2)) {
        stop("length of zlim must be 1 or 2")
    }
    breaksGiven <- !missing(breaks)
    if (zlimGiven && breaksGiven && length(breaks) > 1) {
        stop("cannot specify both zlim and breaks, unless length(breaks)==1")
    }
    xat <- NULL
    yat <- NULL
    # issue 674: permit POSIXlt in addition to POSIXct
    if (inherits(x, "POSIXt")) {
        x <- as.POSIXct(x)
    }
    # haveZlab <- !is.null(zlab) && sum(nchar(zlab)) > 0
    if (!missing(x) && is.list(x)) {
        names <- names(x)
        if (!missing(y)) {
            stop("may not give y, since x is a list")
        }
        if (!missing(z)) {
            stop("may not give z, since x is a list")
        }
        if (!("x" %in% names)) {
            stop("since x is a list, it must have an item named 'x'")
        }
        if (!("y" %in% names)) {
            stop("since x is a list, it must have an item named 'y'")
        }
        if (!("z" %in% names)) {
            stop("since x is a list, it must have an item named 'z'")
        }
        y <- x$y
        z <- x$z
        x <- x$x
    } else if (!missing(x) && is.array(x) && missing(z)) {
        if (length(dim(x)) > 2) {
            stop("x must be a matrix, not an array with dim(x) = c(", paste(dim(x), collapse = ","), ")\n")
        }
        z <- x
        z <- if (length(dim(x)) > 2) z <- x[, , 1] else x
        # y <- seq(0, 1, length.out=ncol(x))
        # x <- seq(0, 1, length.out=nrow(x))
        y <- seq.int(1L, ncol(x))
        x <- seq.int(1L, nrow(x))
    } else if (!missing(x) && inherits(x, "topo")) {
        # NB. rewrites x, so put that last
        y <- x[["latitude"]]
        z <- x[["z"]]
        x <- x[["longitude"]]
        if (missing(xlab)) xlab <- "Longitude"
        if (missing(ylab)) ylab <- "Latitude"
        if (is.na(asp)) {
            asp <- 1 / cos(mean(y * pi / 180))
        }
    } else if (!missing(z) && is.matrix(z) && missing(x) && missing(y)) {
        x <- seq.int(1L, nrow(z))
        y <- seq.int(1L, ncol(z))
        z <- z
    } else {
        if (missing(y)) {
            stop("must supply y")
        }
        if (missing(z)) {
            stop("must supply z")
        }
    }
    z[!is.finite(z)] <- NA # so range(z, na.rm=TRUE) will not be thwarted Inf
    if (!any(is.finite(z))) {
        stop("need some finite 'z' values")
    }
    oceDebug(debug, "range(z):", paste(range(z, na.rm = TRUE), collapse = " to "), "\n")
    xIsTime <- inherits(x, "POSIXt") || inherits(x, "POSIXct") || inherits(x, "POSIXlt")
    # Handle TRUE/FALSE decimation
    dim <- dim(z)
    oceDebug(debug, "dim(z): ", paste(dim(z), paste = " "), "\n")
    decimateLogical <- is.logical(decimate)
    if (decimateLogical) {
        # this block makes decimate be a vector of length 2
        # message("decimate is logical; decimate:", decimate)
        if (decimate) {
            cdim <- dim # (possibly) clipped dim
            # issue 827: decide whether to decimate based on just the data
            # within the plot window.
            if (xlimGiven) {
                nx <- cdim[1]
                if (length(x) > 1) {
                    nx <- if (x[2] > x[1]) {
                        sum(xlim[1] <= x & x <= xlim[2])
                    } else {
                        sum(xlim[2] <= x & x <= xlim[1])
                    }
                }
                if (nx < cdim[1]) {
                    cdim[1] <- nx
                }
            }
            if (ylimGiven) {
                ny <- cdim[2]
                if (length(y) > 1) {
                    ny <- if (y[2] > y[1]) {
                        sum(ylim[1] <= y & y <= ylim[2])
                    } else {
                        sum(ylim[2] <= y & y <= ylim[1])
                    }
                }
                if (ny < cdim[2]) {
                    cdim[2] <- ny
                }
            }
            # message("nx: ", nx, ", ny: ", ny)
            # message("cdim: ", cdim[1], " ", cdim[2])
            decimate <- as.integer(cdim / 400)
            decimate <- ifelse(decimate < 1, 1, decimate)
            # message("decimate: ", decimate[1], " ", decimate[2])
            oceDebug(debug, "set auto decimation=", paste(decimate, collapse = " "), "\n")
        } else {
            decimate <- c(1L, 1L)
        }
    }
    if (1 == length(decimate)) {
        decimate <- rep(decimate, 2)
    }
    if (0 == length(decimate)) {
        decimate <- rep(FALSE, 2)
    }
    #> message("dim(z): ", paste(dim(z), collapse=" "))
    oceDebug(debug, "decimation: ", paste(decimate, collapse = " "), "\n")
    if (decimate[1] > 1) {
        ilook <- seq.int(1, dim[1], by = decimate[1])
        x <- x[ilook]
        z <- z[ilook, , drop = FALSE]
        oceDebug(debug, "ilook:", paste(ilook[1:4], collapse = " "), "...\n")
        if (decimateLogical && !quiet) {
            warning("auto-decimating first index of large image by ", decimate[1], "; use decimate=FALSE to prevent this")
        }
    }
    if (decimate[2] > 1) {
        jlook <- seq.int(1, dim[2], by = decimate[2])
        y <- y[jlook]
        z <- z[, jlook, drop = FALSE]
        oceDebug(debug, "jlook:", paste(jlook[1:4], collapse = " "), "...\n")
        if (decimateLogical && !quiet) {
            warning("auto-decimating second index of large image by ", decimate[2], "; use decimate=FALSE to prevent this")
        }
    }
    if (!inherits(x, "POSIXct") && !inherits(x, "POSIXct")) {
        x <- as.vector(x)
    }
    if (!inherits(y, "POSIXct") && !inherits(y, "POSIXct")) {
        y <- as.vector(y)
    }
    if (!is.matrix(z)) {
        stop("z must be a matrix")
    }
    dim <- dim(z)
    if (2 != length(dim)) {
        stop("z must be a two-dimensional matrix")
    }
    if (nrow(z) != length(x) && (1 + nrow(z)) != length(x)) {
        stop("nrow(image)=", nrow(z), " does not match length(x)=", length(x), sep = "")
    }
    if (ncol(z) != length(y) && (1 + ncol(z)) != length(y)) {
        stop("ncol(image)=", ncol(z), " does not match length(y)=", length(y), sep = "")
    }
    # Ensure that x and y increase
    # FIXME: should check on equal values
    ox <- order(x)
    if (any(diff(ox) < 0)) {
        # warning("reordered some x values")
        x <- x[ox]
        z <- z[ox, ]
    }
    oy <- order(y)
    if (any(diff(oy) < 0)) {
        # warning("reordered some y values")
        y <- y[oy]
        z <- z[, oy]
    }
    # Adjust x and y, to match what image() does; save orig for filled contours
    xorig <- x
    yorig <- y
    if (length(x) > 1 && length(x) == nrow(z)) {
        # Time is handled separately, because as of 2020-08-09, lubridate (version 1.7.9) gave
        # a warning on missing timezones, for the diff that is used below.
        if (inherits(x, "POSIXt")) {
            tz <- attr(x[1], "tzone")
            X <- as.numeric(x)
            dX <- 0.5 * diff(X)
            X <- c(X[1L] - dX[1L], X[-length(X)] + dX, X[length(X)] + dX[length(X) - 1])
            x <- numberAsPOSIXct(X, tz = tz)
        } else {
            dx <- 0.5 * diff(x)
            x <- c(x[1L] - dx[1L], x[-length(x)] + dx, x[length(x)] + dx[length(x) - 1])
        }
    }
    if (length(y) > 1 && length(y) == ncol(z)) {
        dy <- 0.5 * diff(y)
        y <- c(y[1L] - dy[1L], y[-length(y)] + dy, y[length(y)] + dy[length(y) - 1])
    }
    ocex <- par("cex")
    if (missing(mar)) {
        mar <- c(mgp[1] + if (nchar(xlab[1]) > 0) 1.5 else 1, mgp[1] + if (nchar(ylab[1]) > 0) 1.5 else 1, mgp[2] + 1 / 2, 1 / 2)
    }
    oceDebug(debug, "after possibly recalculating, mar=c(", paste(mar, collapse = ", "), ")\n", sep = "")
    if (missing(mai.palette)) {
        mai.palette <- rep(0, 4)
        oceDebug(debug, "set mai.palette=", mai.palette, "\n")
    }
    par(mgp = mgp, mar = mar) # , cex=cex)
    if (zlimGiven && is.character(zlim)) {
        if ("symmetric" == zlim) {
            zlim <- c(-1, 1) * max(abs(z), na.rm = TRUE)
        }
    }

    zlimHistogram <- zlimGiven && length(zlim) == 1 && zlim == "histogram"
    breaksGiven <- !missing(breaks)
    colormapGiven <- !missing(colormap)
    if (colormapGiven && missing(missingColor)) {
        missingColor <- colormap$missingColor
    }
    zrange <- range(z, na.rm = TRUE)
    # 2023-06-26 issue 2120 permit constant-value matrix
    if (diff(zrange) == 0.0) {
        zrange <- zrange + c(-1, 1) * sqrt(.Machine$double.eps)
    }
    # message("DAN L1241 ", vectorShow(zrange))
    if (colormapGiven) {
        oceDebug(debug, "colormap provided\n", sep = "")
        breaks <- colormap$breaks
        breaks2 <- breaks
        col <- colormap$col
        col2 <- col
    } else {
        # Determine breaks unless zlim=="histogram".
        if (zlimHistogram) {
            if (missing(col)) {
                col <- oce.colorsPalette(200) # FIXME: how many colors to use?
            }
        } else {
            if (!breaksGiven) {
                nbreaks <- 128 # smooth image color scale
                if (missing(zlim)) {
                    if (missing(col)) {
                        breaks <- pretty(zrange, n = nbreaks)
                        if (breaks[1] < zrange[1]) {
                            breaks[1] <- zrange[1]
                        }
                        if (breaks[length(breaks)] > zrange[2]) {
                            breaks[length(breaks)] <- zrange[2]
                        }
                    } else {
                        breaks <- seq(zrange[1], zrange[2], length.out = if (is.function(col)) PLEN else 1 + length(col))
                    }
                    # nolint start object_usage_linter
                    breaksOrig <- breaks
                    # nolint end object_usage_linter
                } else {
                    # zlim given, but breaks not given
                    if (missing(col)) {
                        breaks <- pretty(zlim, n = nbreaks)
                        oceDebug(debug, "zlim given but not breaks or col\n")
                        oceDebug(debug, "inferred breaks:", paste(head(breaks), collapse = " "), "...\n")
                    } else {
                        breaks <- seq(zlim[1], zlim[2],
                            length.out = if (is.function(col)) PLEN else 1 + length(col)
                        )
                        oceDebug(debug, "zlim and col given but not breaks; inferred head(breaks)=", head(breaks), "\n")
                    }
                    breaksOrig <- breaks
                    oceDebug(debug, "range(z):", paste(zrange, collapse = " to "), "\n")
                    oceDebug(debug, "ORIG  range(breaks):", paste(range(breaks), collapse = " to "), "\n")
                    breaks[1] <- min(max(zlim[1], zrange[1]), breaks[1])
                    breaks[length(breaks)] <- max(breaks[length(breaks)], min(zlim[2], zrange[2]))
                    oceDebug(debug, "later range(breaks):", paste(range(breaks), collapse = " to "), "\n")
                }
            } else {
                breaksOrig <- breaks
                if (1 == length(breaks)) {
                    breaks <- if (missing(zlim)) pretty(z, n = breaks) else pretty(zlim, n = breaks)
                }
            }
            if (missing(col)) {
                oceDebug(debug, "setting default 'col' to oce.colorsViridis (near line 1199)\n")
                col <- oce.colorsViridis(n = length(breaks) - 1)
            }
        }
        breaks2 <- if (missing(breaks)) NULL else breaks
        col2 <- if (missing(col)) NULL else col
        # If not z clipping, enlarge breaks/cols to avoid missing-color regions
        oceDebug(debug, "zrange=c(", zrange[1], ",", zrange[2], ")\n", sep = "")
        oceDebug(debug, "zclip:", zclip, "\n")
        oceDebug(debug, "zlimHistogram:", zlimHistogram, "\n")
        # 2014-08-02: add zclip to test [issue 516]
        if (!zclip && !zlimHistogram) {
            db <- median(diff(breaks), na.rm = TRUE)
            breaks2 <- c(
                min(c(zrange[1], breaks, na.rm = TRUE)) - db / 100,
                breaks,
                max(c(zrange[2], breaks, na.rm = TRUE)) + db / 100
            )
            if (!is.function(col)) {
                col2 <- c(col[1], col, col[length(col)])
            }
            oceDebug(debug, "USE breaks2 and col2 as calculated\n")
        } else {
            oceDebug(debug, "IGNORE breaks2 and col2 as calculated\n")
            # 20140801 warning("2014-07-17/#489 trial code: ignore breaks2 and col2")
            if (!missing(breaks)) {
                breaks2 <- breaks
            }
            if (!missing(col)) {
                col2 <- col
            }
        }
        if (is.function(col)) {
            if (zlimHistogram) {
                col <- col(n = 200) # FIXME: decide on length
            } else {
                col <- col(n = length(breaks) - 1)
            }
        }
    }
    if (!missing(breaks)) {
        oceDebug(debug, "head(breaks): ", paste(head(breaks), collapse = " "), "\n")
    }
    oceDebug(debug, "head(col): ", paste(head(col), collapse = " "), "\n")
    # issue 542: move this out from the drawPalette part of the next block
    if (missing(zlim) || is.null(zlim)) {
        oceDebug(debug, "zlim is missing or NULL\n")
        # use range of breaks preferably; otherwise use range z
        if (missing(breaks)) {
            zlim <- range(z, na.rm = TRUE)
            oceDebug(debug, "infer zlim=c(", zlim[1], ",", zlim[2], ") from range(z)\n", sep = "")
        } else {
            zlim <- range(breaks, na.rm = TRUE)
            oceDebug(debug, "infer zlim=c(", zlim[1], ",", zlim[2], ") from range(breaks)\n", sep = "")
        }
    }
    xlim <- if (!xlimGiven) range(x, na.rm = TRUE) else xlim
    ylim <- if (!ylimGiven) range(y, na.rm = TRUE) else ylim
    if (drawPalette == "space") {
        drawPalette(zlab = if (zlabPosition == "side") zlab else "", axisPalette = axisPalette, debug = debug - 1, las = las.palette)
    } else if (drawPalette) {
        drawTriangles <- rep(drawTriangles, length.out = 2)
        drawTriangles[1] <- drawTriangles[1] && any(z < zlim[1], na.rm = TRUE)
        drawTriangles[2] <- drawTriangles[2] && any(z > zlim[2], na.rm = TRUE)
        oceDebug(debug, "mai.palette=c(", paste(mai.palette, collapse = ", "), ")\n")
        if (zlimHistogram) {
            oceDebug(debug, "palette with zlim=\"histogram\"\n")
            # CAUTION: change data in 'z'
            dim <- dim(z)
            z <- as.vector(z)
            n <- length(z)
            h <- hist(z, breaks = 100, plot = FALSE) # the 100 could be altered...
            mids <- h$mids
            density <- cumsum(h$counts) / n
            z <- approx(mids, density, z, rule = 2)$y
            dim(z) <- dim
            labels <- round(approx(density, mids, seq(0, 1, 0.1), rule = 2)$y, 3)
            drawPalette(
                zlim = c(0, 1), zlab = if (zlabPosition == "side") zlab else "",
                col = col,
                labels = labels, at = seq(0, 1, 0.1),
                drawContours = drawContours,
                drawTriangles = drawTriangles,
                mai = mai.palette, las = las.palette,
                cex = 1,
                debug = debug - 1
            )
        } else {
            oceDebug(debug, "palette with zlim not \"histogram\"\n")
            drawPalette(
                zlim = zlim, zlab = if (zlabPosition == "side") zlab else "",
                breaks = breaks, col = col,
                labels = labels, at = at,
                drawContours = drawContours,
                drawTriangles = drawTriangles,
                mai = mai.palette,
                las = las.palette,
                axisPalette = axisPalette,
                cex = cex,
                debug = debug - 1
            )
        }
    }
    # trim image to limits, so endpoint colors will indicate outliers
    if (!zclip && !zlimHistogram) {
        oceDebug(debug, "using zlim[1:2]=c(", zlim[1], ",", zlim[2], ")\n")
        z[z < zlim[1]] <- zlim[1]
        z[z > zlim[2]] <- zlim[2]
    }
    if (flipy) {
        ylim <- rev(sort(ylim))
    }
    if (zclip && !zlimHistogram) {
        oceDebug(debug, "using missingColor for out-of-range values")
        z[z < zlim[1]] <- NA
        z[z > zlim[2]] <- NA
    }
    if (is.function(col2) && !is.null(breaks2)) {
        col2 <- col2(n = length(breaks2) - 1)
    }
    if (xIsTime) {
        oceDebug(debug, "the x axis represents time\n")
        if (filledContour) {
            oceDebug(debug, "doing filled contours [1]\n")
            if (!is.double(z)) {
                storage.mode(z) <- "double"
            }
            plot.new()
            plot.window(xlim = xlim, ylim = ylim, xaxs = xaxs, yaxs = yaxs, asp = asp, ...)
            # Filled contours became official in version 2.15.0 of R.
            # issue 489: use breaks/col instead of breaks2/col2
            .filled.contour(as.double(xorig), as.double(yorig), z, as.double(breaks), col = col)
            mtext(ylab, side = 2, line = par("mgp")[1], cex = cex.lab * par("cex"))
            if (!is.null(xlab)) {
                mtext(xlab, side = 1, line = par("mgp")[1], cex = cex.lab * par("cex"))
            }
        } else {
            oceDebug(debug, "not doing filled contours [2]\n")
            if (zlimHistogram) {
                image(
                    x = x, y = y, z = z, axes = FALSE, xlab = "", ylab = "", col = col2,
                    xlim = xlim, ylim = ylim, zlim = c(0, 1), asp = asp, add = add, useRaster = useRaster, ...
                )
            } else {
                # issue 489: use breaks/col instead of breaks2/col2
                image(
                    x = x, y = y, z = z, axes = FALSE, xlab = "", ylab = "", breaks = breaks, col = col,
                    xlim = xlim, ylim = ylim, zlim = zlim, asp = asp, add = add, useRaster = useRaster, cex = cex, ...
                )
            }
        }
        if (axes) {
            box()
            oceDebug(debug, "about to call oce.axis.POSIXct()\n")
            xat <- oce.axis.POSIXct(
                side = 1, x = x, cex.axis = cex, cex.lab = cex, cex.main = cex,
                drawTimeRange = drawTimeRange,
                mar = mar, mgp = mgp, tformat = tformat, debug = debug - 1
            )
            oceDebug(debug, "doing y axis with cex.axis\n")
            yat <- axis(2, cex.axis = cex.axis)
            mtext(side = 2, ylab, line = mgp[1], cex = cex.lab * par("cex"))
            if (!is.null(xlab)) {
                mtext(xlab, side = 1, line = par("mgp")[1], cex = cex.lab * par("cex"))
            }
        }
    } else {
        # x is not a POSIXt
        oceDebug(debug, "the x axis does not represent time\n")
        if (filledContour) {
            oceDebug(debug, "doing filled contours [3]\n")
            storage.mode(z) <- "double"
            plot.new()
            plot.window(xlim = xlim, ylim = ylim, xaxs = xaxs, yaxs = yaxs, asp = asp, ...)
            # Filled contours became official in version 2.15.0 of R.
            # issue 489: use breaks/col instead of breaks2/col2
            .filled.contour(as.double(xorig), as.double(yorig), z, as.double(breaks), col = col)
            mtext(xlab, side = 1, cex = cex.lab * par("cex"), line = mgp[1])
            mtext(ylab, side = 2, cex = cex.lab * par("cex"), line = mgp[1])
        } else {
            oceDebug(debug, "not doing filled contours\n")
            if (zlimHistogram) {
                if (is.function(col2)) {
                    col2 <- col2(200)
                }
                breaks2 <- seq(0, 1, length.out = length(col2) + 1)
            }
            oceDebug(debug, "length(x) = ", length(x), "\n")
            oceDebug(debug, "length(y) = ", length(y), "\n")
            # issue 489: use breaks/col instead of breaks2/col2
            image(
                x = x, y = y, z = z, axes = FALSE, xlab = xlab, ylab = ylab, breaks = breaks, col = col,
                xlim = xlim, ylim = ylim, asp = asp, useRaster = useRaster, ...
            )
        }
        if (axes) {
            box()
            xat <- axis(1, cex.axis = cex)
            yat <- axis(2, cex.axis = cex)
        }
    }
    if (!is.null(missingColor)) {
        # FIXME: the negation on is.na is confusing, but it comes from col and breaks together
        image(x, y, !is.na(z), col = c(missingColor, "transparent"), breaks = c(0, 1 / 2, 1), useRaster = useRaster, add = TRUE)
        if (axes) {
            box()
        }
    }
    if (is.na(main)) {
        mtext("", at = mean(range(x), na.rm = TRUE), side = 3, line = 1 / 8, cex = cex.main * par("cex"))
    } else if (!(is.character(main) && main == "")) {
        mtext(main, at = mean(range(x), na.rm = TRUE), side = 3, line = 1 / 8, cex = cex.main * par("cex"))
    }
    if (drawContours) {
        oceDebug(debug, "adding contours\n")
        contour(x = xorig, y = yorig, z = z, levels = breaks, drawlabels = FALSE, add = TRUE, col = "black")
    }
    if (zlabPosition == "top") {
        mtext(zlab, side = 3, adj = 1, line = 1 / 8, cex = cex.main * par("cex"))
    }
    par(cex = ocex)
    oceDebug(debug, "at return, par(\"mai\")=c(", paste(format(par("mai"), digits = 2), collapse = ","), ")\n", sep = "")
    oceDebug(debug, "at return, par(\"mar\")=c(", paste(format(par("mar"), digits = 2), collapse = ","), ")\n", sep = "")
    oceDebug(debug, "END imagep()\n", sep = "", unindent = 1)
    invisible(list(xat = xat, yat = yat, decimate = decimate))
} # imagep()
