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

#' Data That Define Some Color Palettes
#'
#' The `ocecolors` dataset is a list containing color-schemes, used
#' by [oceColorsClosure()] to create functions such as
#' [oceColorsViridis()].
#'
#' @name ocecolors
#'
#' @docType data

#' @author Authored by matplotlib contributers, packaged (with license permission) in oce by Dan Kelley
#'
#' @source The data come from the matplotlib site
#' `https://github.com/matplotlib/matplotlib`.
#'
#' @template colourBlindnessTemplate
#'
#' @family datasets provided with oce
#' @family things related to colors
#'
#' @template colourBlindnessTemplate
NULL

colormapNames <- c("gmt_relief", "gmt_ocean", "gmt_globe", "gmt_gebco")

# keeping this (which was called 'colorize' until 2014-05-07) for a while, but not in NAMESPACE.
colormap_colorize <- function(
    z = NULL, zlim, zclip = FALSE, breaks,
    col = oceColorsViridis, colormap = NULL, segments = 1, missingColor = "gray",
    debug = getOption("oceDebug")) {
    oceDebug(debug, "colormap_colorize(z=",
        if (is.null(z)) "(missing)" else paste("c(", z[1], ",...)", sep = ""), ",",
        "zlim=", if (missing(zlim)) {
            "(missing)"
        } else {
            paste("c(", zlim[1], ",", zlim[2], "),", sep = "")
        },
        "zclip=", zclip, ",",
        "breaks=", if (missing(breaks)) {
            "(missing)"
        } else {
            paste("c(", breaks[1], ",...),", sep = "")
        },
        "col=", if (is.function(col)) "(function)" else paste("c(", col[1], ",...)", sep = ""), ",",
        "colormap=", if (is.null(colormap)) "(missing)" else colormap, ",",
        "segments=", segments, ",",
        "missingColor=", missingColor,
        ") START\n",
        sep = "", unindent = 1
    )
    if (is.null(colormap)) {
        if (is.function(col)) {
            oceDebug(debug, "col is a function\n")
            if (missing(breaks)) {
                if (!missing(zlim)) {
                    breaks <- seq(zlim[1], zlim[2], length.out = 200)
                } else if (!is.null(z)) {
                    breaks <- seq(min(z, na.rm = TRUE), max(z, na.rm = TRUE), length.out = 200)
                } else {
                    stop("must give z, zlim or breaks")
                }
            }
            if (length(breaks) == 1) {
                # special case: 'breaks' means *number* of breaks
                if (!missing(zlim) && !is.null(zlim)) {
                    breaks <- seq(zlim[1], zlim[2], length.out = breaks)
                    # message("pretty(zlim)")
                } else if (!is.null(z)) {
                    breaks <- pretty(z, n = breaks) # note use of pretty(), which extends from data
                    # message("pretty(z)")
                } else {
                    stop("must give z or zlim if length(breaks)=1")
                }
            }
            col <- col(length(breaks) - 1)
        } else {
            # FIXME: should check that it is indeed a color, but how?
            col <- col
        }
        if (is.null(z)) {
            oceDebug(debug, "z is NULL\n")
            if (missing(zlim) || is.null(zlim)) {
                zlim <- range(breaks)
            }
            zcol <- "black"
        } else {
            oceDebug(debug, "z is not NULL\n")
            if (missing(zlim) || is.null(zlim)) {
                zlim <- rangeExtended(z) # note the extended range
                oceDebug(debug, "zlim not given; calculated as:", paste(zlim, collapse = " "), "\n")
            }
            i <- findInterval(z, breaks)
            tooLow <- i == 0
            tooHigh <- i == length(breaks)
            i[tooLow] <- 1 # cannot index to 0; col is replaced later
            zcol <- col[i]
            if (zclip) {
                oceDebug(debug, "zclip TRUE: out-of-range get missingColor:", missingColor, "\n")
                zcol[tooLow] <- missingColor
                zcol[tooHigh] <- missingColor
            } else {
                oceDebug(debug, "zclip FALSE: out-of-range get end colors\n")
                zcol[tooLow] <- col[1]
                zcol[tooHigh] <- tail(col, 1)
            }
        }
    } else {
        # have a colormap
        if (!missing(col)) {
            stop("cannot supply 'col' and 'colormap' at the same time")
        }
        if (!missing(breaks)) {
            stop("cannot supply 'breaks' and 'colormap' at the same time")
        }
        if (is.character(colormap)) {
            colormap <- colormap_colormap(name = colormap, debug = debug - 1)
            if (missing(zlim)) {
                zlim <- colormap$zlim
            }
            missingColor <- colormap$missingColor
        }
        if (inherits(colormap, "colormap")) {
            missingColor <- colormap$missingColor
        }
        breaks <- NULL
        col <- NULL
        # Could preallocate but colormaps are small so do not bother
        n <- length(colormap$x0)
        for (i in seq.int(1, n - 1)) {
            # FIXME: should below be segments or 1+segments?
            delta <- (colormap$x0[i + 1] - colormap$x0[i]) / segments
            breaks <- c(breaks, seq(from = colormap$x0[i], by = delta, length.out = segments))
            col <- c(col, colorRampPalette(c(colormap$col0[i], colormap$col1[i]))(segments))
        }
        nbreaks <- length(breaks)
        # extend a bit to the right
        delta <- mean(diff(breaks[1:2])) / 1000
        breaks <- c(breaks, breaks[nbreaks] + delta)
        # FIXME: next might miss top color
        if (is.null(zlim)) {
            zlim <- if (is.null(z)) {
                range(breaks)
            } else {
                rangeExtended(z)
            } # note the extended range
        }
        if (is.null(z)) {
            zcol <- "black"
        } else {
            zlim <- rangeExtended(z)
            i <- findInterval(z, breaks)
            tooLow <- i == 0
            tooHigh <- i == length(breaks)
            i[tooLow] <- 1 # cannot index to 0; col is replaced later
            zcol <- col[i]
            if (zclip) {
                oceDebug(debug, "zclip TRUE: out-of-range get missingColor:", missingColor, "\n")
                zcol[tooLow] <- missingColor
                zcol[tooHigh] <- missingColor
            } else {
                oceDebug(debug, "zclip FALSE: out-of-range get end colors\n")
                zcol[tooLow] <- col[1]
                zcol[tooHigh] <- tail(col, 1)
            }
        }
    }
    res <- list(zlim = zlim, breaks = breaks, col = col, zcol = zcol, missingColor = missingColor)
    class(res) <- c("list", "colormap")
    oceDebug(debug, "END colormap_colorize()\n", sep = "", unindent = 1)
    res
}

# NB: I've not documented this, because it is not in the NAMESPACE.
colormapGmtNumeric <- function(x0, x1, col0, col1, bpl = 1) {
    n <- length(x0)
    if (length(x1) != n) {
        stop("mismatched lengths of x0 and x1 (", n, " and ", length(x1), ")")
    }
    if (length(col0) != n) {
        stop("mismatched lengths of x0 and col0 (", n, " and ", length(col0), ")")
    }
    if (length(col1) != n) {
        stop("mismatched lengths of x0 and col1 (", n, " and ", length(col1), ")")
    }
    breaks <- NULL
    col <- NULL
    # Could preallocate but colormaps are small so do not bother
    for (i in seq.int(1, n - 1)) {
        breaks <- c(breaks, seq(x0[i], x1[i], length.out = 1 + bpl))
        col <- c(col, colorRampPalette(c(col0[i], col1[i]))(1 + bpl))
    }
    nbreaks <- length(breaks)
    # extend a bit to the right
    delta <- mean(diff(breaks[1:2])) / 1000
    breaks <- c(breaks, breaks[nbreaks] + delta)
    res <- list(breaks = breaks, col = col)
    res
}

#' Create a GMT-type (CPT) Colormap
#'
#' `colormapGMT` creates colormaps in the Generic Mapping Tools (GMT)
#' scheme (see References 1 to 4).  A few such schemes are built-in, and may be referred to
#' by name (`"gmt_gebco"`, `"gmt_globe"`, `"gmt_ocean"`, or `"gmt_relief"`)
#' while others are handled by reading local files that are in GMT
#' format, or URLs providing such files (see Reference 3).
#'
#' The GMT files understood by [colormapGMT] are what GMT calls
#' "Regular CPT files" (see reference 4).  This is a text format that
#' can be read and (with care) edited in a text editor.  There
#' are three categories of lines within this file.  (1) Any
#' line starting with the `"#"` character is a comment, and is ignored
#' by [colormapGMT]. (2) Lines with 8 numbers specify colour bands.
#' The first number is a z value, and the three numbers after that
#' are red, green and blue values in the range from 0 to 255. This
#' set of 4 numbers is followed on the same line with similar values.
#' Think of this sequence as describing a band of colours between
#' two z values. (3) Lines starting with a character, followed
#' by three numbers, specify particular codings.  The character `"B"`
#' specifies background colour, while `"F"` specifies foreground
#' colour, and `"N"` specifies the colour to be used for missing
#' data (the letter stands for not-a-number).  Only `"N"` is used
#' by [colormapGMT], and it takes on the role that the `missingColor`
#' argument would otherwise have.  (This is why `missingColor` is not
#' permitted if `name` is given.)
#'
#' @param name character value specifying the GMT scheme, or a source for such
#' a scheme. Four pre-defined schemes are available, accessed by setting `name` to
#' `"gmt_gebco"`, `"gmt_globe"`, `"gmt_ocean"`, or `"gmt_relief"`. If `name` is
#' not one of these values, then it is taken to be the name of a local file
#' in GMT format or, if no such file is found, a URL holding such a file.
#'
#' @param debug integer that, if positive, indicates to print some debugging output
#'
#' @return `colormap` returns a list, in the same format as the return value for [colormap()].
#'
#' @author Dan Kelley
#'
#' @references
#' 1. General overview of GMT system
#' `https://www.generic-mapping-tools.org`.
#' 2. Information on GMT color schemes
#' `https://docs.generic-mapping-tools.org/dev/cookbook/cpts.html`
#' 3. Source of GMT specification files
#' `https://beamreach.org/maps/gmt/share/cpt/`
#' 4. CPT (color palette table) format
#' `https://www.soest.hawaii.edu/gmt/gmt/html/GMT_Docs.html#x1-820004.15`
#'
#' @family things related to colors
colormapGMT <- function(name, debug = getOption("oceDebug")) {
    oceDebug(debug, "colormapGMT(name=\"", name, "...) START\n", sep = "", unindent = 1)
    if (name %in% colormapNames) {
        oceDebug(debug, "case 1: built-in GMT name\n")
        if (name == "gmt_relief") {
            oceDebug(debug, "case 1.1: built-in gmt_relief\n")
            # $Id: GMT_relief.cpt,v 1.1 2001/09/23 23:11:20 pwessel Exp $
            #
            # Colortable for whole earth relief used in Wessel topomaps
            # Designed by P. Wessel and F. Martinez, SOEST
            # COLOR_MODEL = RGB
            text <- "-8000   0       0       0       -7000   0       5       25
            -7000   0       5       25      -6000   0       10      50
            -6000   0       10      50      -5000   0       80      125
            -5000   0       80      125     -4000   0       150     200
            -4000   0       150     200     -3000   86      197     184
            -3000   86      197     184     -2000   172     245     168
            -2000   172     245     168     -1000   211     250     211
            -1000   211     250     211     0       250     255     255
            0       70      120     50      500     120     100     50
            500     120     100     50      1000    146     126     60
            1000    146     126     60      2000    198     178     80
            2000    198     178     80      3000    250     230     100
            3000    250     230     100     4000    250     234     126
            4000    250     234     126     5000    252     238     152
            5000    252     238     152     6000    252     243     177
            6000    252     243     177     7000    253     249     216
            7000    253     249     216     8000    255     255     255
            F       255     255     255
            B       0       0       0
            N       255     255     255"
        } else if (name == "gmt_ocean") {
            oceDebug(debug, "case 1.2: built-in gmt_ocean\n")
            # $Id: GMT_ocean.cpt,v 1.1 2001/09/23 23:11:20 pwessel Exp $
            #
            # Colortable for oceanic areas as used in Wessel maps
            # Designed by P. Wessel and F. Martinez, SOEST.
            # COLOR_MODEL = RGB
            text <- "-8000   0       0       0       -7000   0       5       25
            -7000   0       5       25      -6000   0       10      50
            -6000   0       10      50      -5000   0       80      125
            -5000   0       80      125     -4000   0       150     200
            -4000   0       150     200     -3000   86      197     184
            -3000   86      197     184     -2000   172     245     168
            -2000   172     245     168     -1000   211     250     211
            -1000   211     250     211     0       250     255     255
            F       255     255     255
            B       0       0       0"
        } else if (name == "gmt_globe") {
            oceDebug(debug, "case 1.3: built-in gmt_globe\n")
            #       $Id: GMT_globe.cpt,v 1.1 2001/09/23 23:11:20 pwessel Exp $
            #
            # Colormap using in global relief maps
            # Bathymetry colors manually redefined for blue-shade effect and
            # new topography color scheme for use with Generic Mapping Tools.
            # Designed by Lester M. Anderson (CASP, UK) lester.anderson@casp.cam.ac.uk
            # COLOR_MODEL = RGB
            text <- "-10000  153     0       255     -9500   153     0       255
            -9500   153     0       255     -9000   153     0       255
            -9000   153     0       255     -8500   153     0       255
            -8500   136     17      255     -8000   136     17      255
            -8000   119     34      255     -7500   119     34      255
            -7500   102     51      255     -7000   102     51      255
            -7000   85      68      255     -6500   85      68      255
            -6500   68      85      255     -6000   68      85      255
            -6000   51      102     255     -5500   51      102     255
            -5500   34      119     255     -5000   34      119     255
            -5000   17      136     255     -4500   17      136     255
            -4500   0       153     255     -4000   0       153     255
            -4000   27      164     255     -3500   27      164     255
            -3500   54      175     255     -3000   54      175     255
            -3000   81      186     255     -2500   81      186     255
            -2500   108     197     255     -2000   108     197     255
            -2000   134     208     255     -1500   134     208     255
            -1500   161     219     255     -1000   161     219     255
            -1000   188     230     255     -500    188     230     255
            -500    215     241     255     -200    215     241     255
            -200    241     252     255     0       241     252     255
            0       51      102     0       100     51      204     102
            100     51      204     102     200     187     228     146
            200     187     228     146     500     255     220     185
            500     255     220     185     1000    243     202     137
            1000    243     202     137     1500    230     184     88
            1500    230     184     88      2000    217     166     39
            2000    217     166     39      2500    168     154     31
            2500    168     154     31      3000    164     144     25
            3000    164     144     25      3500    162     134     19
            3500    162     134     19      4000    159     123     13
            4000    159     123     13      4500    156     113     7
            4500    156     113     7       5000    153     102     0
            5000    153     102     0       5500    162     89      89
            5500    162     89      89      6000    178     118     118
            6000    178     118     118     6500    183     147     147
            6500    183     147     147     7000    194     176     176
            7000    194     176     176     7500    204     204     204
            7500    204     204     204     8000    229     229     229
            8000    229     229     229     8500    242     242     242
            8500    242     242     242     9000    255     255     255
            9000    255     255     255     9500    255     255     255
            9500    255     255     255     10000   255     255     255
            F       255     255     255
            B       0       0       0
            N       128     128     128"
        } else if (name == "gmt_gebco") {
            oceDebug(debug, "case 1.4: built-in gmt_gebco\n")
            # $Id: GMT_gebco.cpt,v 1.1.1.1 2000/12/28 01:23:45 gmt Exp $
            #
            # Bathymetry colors approximating the GEBCO charts
            # Designed by Andrew Goodwillie, Scripps
            # COLOR_MODEL = RGB
            text <- "-7000   0       240     255     -6000   0       240     255
            -6000   35      255     255     -5000   35      255     255
            -5000   90      255     255     -4000   90      255     255
            -4000   140     255     230     -3000   140     255     230
            -3000   165     255     215     -2000   165     255     215
            -2000   195     255     215     -1000   195     255     215
            -1000   210     255     215     -500    210     255     215
            -500    230     255     240     -200    230     255     240
            -200    235     255     255     -0      235     255     255
            F       255     255     255
            B       0       0       0
            N       128     128     128"
        }
        text <- gsub("^[ ]*", "", strsplit(text, "\\n")[[1]])
    } else {
        oceDebug(debug, "case 2: file or URL\n")
        # Look for local file or URL
        text <- try(readLines(name), silent = TRUE)
        if (inherits(text, "try-error")) {
            stop("unknown colormap name: \"", name, "\" (not built-in, not local file, not working URL)")
        }
    }
    text <- text[!grepl("^#", text)] # remove comments, if any exist (as in files read in)
    textData <- text[grep("^[ ]*[-0-9]", text)]
    textData <- gsub("/", " ", textData) # sometimes it is R/G/B
    d <- read.table(text = textData, col.names = c("x0", "r0", "g0", "b0", "x1", "r1", "g1", "b1"))
    col0 <- rgb(d$r0, d$g0, d$b0, maxColorValue = 255)
    col1 <- rgb(d$r1, d$g1, d$b1, maxColorValue = 255)
    # Decode (F, B) and N=missingColor.  Note step by step approach,
    # which may be useful in debugging different formats, e.g.
    # tabs and spaces etc.
    # "F" unused at present
    # nolint start T_and_F_symbol_linter
    F <- "#FFFFFF"
    if (length(grep("^\\sF", text))) {
        line <- text[grep("\\s*F", text)]
        line <- gsub("^\\sF", "", line)
        F <- scan(text = line, quiet = TRUE)
        Flen <- length(F)
        if (1 == Flen) {
            F <- if (length(grep("[a-zA-Z]", F))) F else gray(as.numeric(F) / 255)
        } else if (3 == Flen) {
            F <- rgb(F[1], F[2], F[3], maxColorValue = 255)
        } else {
            warning("cannot decode \"F\" from \"", line, "\"")
        }
    }
    # nolint end T_and_F_symbol_linter
    # "B" unused at present
    B <- "#000000"
    if (length(grep("^\\sB", text))) {
        line <- text[grep("\\s*B", text)]
        line <- gsub("^\\sB", "", line)
        B <- scan(text = line, quiet = TRUE)
        Blen <- length(B)
        if (1 == Blen) {
            B <- if (length(grep("[a-zA-Z]", B))) B else gray(as.numeric(B) / 255)
        } else if (3 == Blen) {
            B <- rgb(B[1], B[2], B[3], maxColorValue = 255)
        } else {
            warning("cannot decode \"B\" from \"", line, "\"")
        }
    }
    # "N" named here as missingColor to match e.g. imagep()
    N <- "gray"
    if (length(grep("^\\s*N", text))) {
        line <- text[grep("^\\s*N", text)]
        line <- gsub("\\s*N", "", line)
        N <- scan(text = line, what = character(), quiet = TRUE)
        Nlen <- length(N)
        if (1 == Nlen) {
            N <- if (length(grep("[a-zA-Z]", N))) N else gray(as.numeric(N) / 255)
        } else if (3 == Nlen) {
            N <- rgb(N[1], N[2], N[3], maxColorValue = 255)
        } else {
            warning("cannot decode missingColor from \"", line, "\"")
        }
    }
    col <- head(rgb(d$r0, d$g0, d$b0, maxColorValue = 255L), -1L)
    # colbreaks <- colormapGmtNumeric(d$x0, d$x1, d$col0, d$col1)
    res <- list(x0 = d$x0, x1 = d$x1, col0 = col0, col1 = col1, breaks = d$x0, col = col, missingColor = N)
    class(res) <- c("list", "colormap")
    oceDebug(debug, "END colormapGMT()\n", sep = "", unindent = 1)
    res
}

#' Calculate a Color Map
#'
#' Create a mapping between numeric values and colors, for use in palettes and plots.
#' The return value can be used in various ways, including colorizing points
#' on scattergraphs, controlling images created by [image()] or [imagep()],
#' drawing palettes with [drawPalette()], etc.
#'
#' `colormap` can be used in a variety of ways, including the following.
#'
#' * **Case A.** Supply some combination of arguments that
#' is sufficient to define a mapping of value to color, without
#' providing `x0`, `col0`, `x1` or `col1` (see case B for these),
#' or providing `name` (see Case C). There are several ways to
#' do this.  One approach is to supply `z` but no
#' other argument, in which case `zlim`, and `breaks` will be determined
#' from `z`, and the default `col` will be used.  Another approach is
#' to specify `breaks` and `col` together, in the same way as they
#' might be specified for the base R function [image()].  It is
#' also possible to supply only `zlim`, in which case `breaks` is
#' inferred from that value.
#' \if{html}{The figure below explains the
#' (`breaks`, `col`) method of specifying a color mapping.  Note
#' that there must be one more break than color.  This is the method used by
#' e.g. [image()].}
#' \if{html}{\figure{colormap_fig_1.png}}
#'
#' * **Case B.** Supply `x0`, `col0`, `x1`, and `col1`, but *not*
#' `zlim`, `breaks`, `col` or `name`.
#' The `x0`, `col0`, `x1` and `col1` values specify a
#' value-color mapping that is similar to that used
#' for GMT color maps.  The method works by using [seq()] to
#' interpolate between the elements of the `x0` vector.  The same is done
#' for `x1`.  Similarly, [colorRampPalette()] is used to
#' interpolate between the colors in the `col0` vector, and the same is
#' done for `col1`.  \if{html}{The figure above explains the (`x0`,
#' `x1`, `col0`, `col1`) method of specifying a color mapping.
#' Note that the each of the items has the same length. The case of
#' `blend=0`, which has color `col0[i]` between `x0[i]` and
#' `x1[i]`, is illustrated below.}
#' \if{html}{\figure{colormap_fig_2.png}}
#'
#' * **Case C.** Supply `name` and possibly also `z`, but *not*
#' `zlim`, `breaks`, `col`, `x0`, `col0`, `x1` or `col1`.
#' The `name` may be the name of a pre-defined color palette
#' (`"gmt_relief"`, `"gmt_ocean"`, `"gmt_globe"` or
#' `"gmt_gebco"`), or it may be the name of a file (or URL pointing to a file)
#' that contains a color map in the GMT format (see \dQuote{References}). If
#' `z` is supplied along with `name`, then `zcol` will be set up in the
#' return value, e.g. for use in colorizing points.  Another method
#' for finding colors for data points is to use the `colfunction()`
#' function in the return value.
#'
#' @param z an optional vector or other set of numerical values to be examined.
#' If `z` is given, the return value will contain an item named
#' `zcol` that will be a vector of the same length as `z`, containing
#' a color for each point.  If `z` is not given, `zcol` will contain
#' just one item, the color `"black"`.
#'
#' @param zlim optional vector containing two numbers that specify the `z`
#' limits for the color scale. This can only be provided in cases A
#' and B, as defined in \dQuote{Details}.  For case A, if `zlim` is not
#' provided, then it is inferred by using [rangeExtended()]
#' on `breaks`, if that is provided, or from `z` otherwise.  Also,
#' in case A, it is an error to provide both `zlim` and `breaks`,
#' unless the latter is of length 1, meaning the number of
#' subdivisions to use within the range set by `zlim`.
#' In case B, `zlim` is inferred from using [rangeExtended()] on `c(x0,x1)`.
#' In case C, providing `zlim` yields an error message, because it makes no
#' sense in the context of a named, predefined color scheme.
#'
#' @param zclip logical, with `TRUE` indicating that z values outside the
#' range of `zlim` or `breaks` should be painted with
#' `missingColor` and `FALSE` indicating that these values should be
#' painted with the nearest in-range color.
#'
#' @param breaks an optional indication of break points between color levels
#' (see [image()]).  If this is provided, the arguments `name`
#' through `blend` are all ignored (see \dQuote{Details}).  If it is
#' provided, then it may either be a vector of break points, or a single number
#' indicating the desired number of break points to be computed with
#' [`pretty`]`(z,breaks)`.  In either case of non-missing
#' `breaks`, the resultant break points must number 1 plus the number of
#' colors (see `col`).
#'
#' @param col either a vector of colors or a function taking a numerical value
#' as its single argument and returning a vector of colors.  Prior to 2021-02-08,
#' the default for `col` was `oceColorsJet`, but it was switched to
#' `oceColorsViridis` on that date.  The value of
#' `col` is ignored if `name` is provided, or if `x0` through
#' `col1` are provided.
#'
#' @param name an optional string naming a built-in colormap (one of
#' `"gmt_relief"`, `"gmt_ocean"`, `"gmt_globe"` or
#' `"gmt_gebco"`) or the name of a file or URL that contains a color map
#' specification in GMT format.  If `name` is given, then it is
#' passed to [colormapGMT()], which creates the colormap.
#' Note that the colormap thus created has a fixed
#' relationship between value and color, and `zlim`,
# ` `z0`, etc. are ignored when `name` is provided. Indeed, the
#' only other argument that is examined is `z` (which may be used
#' so that `zcol` will be defined in the return value), and warnings
#' are issued if some irrelevant arguments are provided.
#'
#' @param x0,x1,col0,col1 Vectors that specify a color map.  They must all be
#' the same length, with `x0` and `x1` being numerical values, and
#' `col0` and `col1` being colors.  The colors may be strings (e.g.
#' `"red"`) or colors as defined by [rgb()] or [hsv()].
#'
#' @param blend a number indicating how to blend colors within each band.
#' This is ignored except when `x0` through `col1` are supplied.  A
#' value of 0 means to use `col0[i]` through the interval `x0[i]` to
#' `x1[i]`.  A value of 1 means to use `col1[i]` in that interval.  A
#' value between 0 and 1 means to blend between the two colors according to
#' the stated fraction.  Values exceeding 1 are an error at present, but there
#' is a plan to use this to indicate sub-intervals, so a smooth palette can be
#' created from a few colors.
#'
#' @param missingColor color to use for missing values. This cannot be provided
#' if `name` is also provided (case C), because named schemes have pre-defined
#' colors.  For other cases, `missingColor` defaults to `"gray"`, if it
#' is not provided as an argument.
#'
#' @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.
#'
#' @return a list containing the following (not necessarily in this order)
#'
#' * `zcol`, a vector of colors for `z`, if `z` was
#' provided, otherwise `"black"`
#'
#' * `zlim`, a two-element vector suitable as the argument of the same
#' name supplied to [image()] or [imagep()]
#'
#' * `breaks` and `col`, vectors of breakpoints and colors,
#' suitable as the same-named arguments to [image()] or
#' [imagep()]
#'
#' * `zclip` the provided value of `zclip`.
#'
#' * `x0` and `x1`, numerical vectors of the sides of color
#' intervals, and `col0` and `col1`, vectors of corresponding
#' colors.  The meaning is the same as on input.  The purpose of returning
#' these four vectors is to permit users to alter color mapping, as in example
#' 3 in \dQuote{Examples}.
#'
#' * `missingColor`, a color that could be used to specify missing
#' values, e.g. as the same-named argument to [imagep()].
#'
#' * `colfunction`, a univariate function that returns a vector
#' of colors, given a vector of `z` values; see Example 6.
#'
#' @author Dan Kelley
#'
#' @examples
#' library(oce)
#' # Example 1. color scheme for points on xy plot
#' x <- seq(0, 1, length.out = 40)
#' y <- sin(2 * pi * x)
#' par(mar = c(3, 3, 1, 1))
#' mar <- par("mar") # prevent margin creep by drawPalette()
#' # First, default breaks
#' c <- colormap(y)
#' drawPalette(c$zlim, col = c$col, breaks = c$breaks)
#' plot(x, y, bg = c$zcol, pch = 21, cex = 1)
#' grid()
#' par(mar = mar)
#' # Second, 100 breaks, yielding a smoother palette
#' c <- colormap(y, breaks = 100)
#' drawPalette(c$zlim, col = c$col, breaks = c$breaks)
#' plot(x, y, bg = c$zcol, pch = 21, cex = 1)
#' grid()
#' par(mar = mar)
#'
#' @section Sample of Usage:
#' \preformatted{
#' # Example 2. topographic image with a standard color scheme
#' par(mfrow=c(1,1))
#' data(topoWorld)
#' cm <- colormap(name="gmt_globe")
#' imagep(topoWorld, breaks=cm$breaks, col=cm$col)
#'
#' # Example 3. topographic image with modified colors,
#' # black for depths below 4km.
#' cm <- colormap(name="gmt_globe")
#' deep <- cm$x0 < -4000
#' cm$col0[deep] <- "black"
#' cm$col1[deep] <- "black"
#' cm <- colormap(x0=cm$x0, x1=cm$x1, col0=cm$col0, col1=cm$col1)
#' imagep(topoWorld, breaks=cm$breaks, col=cm$col)
#'
#' # Example 4. image of world topography with water colorized
#' # smoothly from violet at 8km depth to blue
#' # at 4km depth, then blending in 0.5km increments
#' # to white at the coast, with tan for land.
#' cm <- colormap(x0=c(-8000, -4000,   0,  100),
#'      x1=c(-4000,     0, 100, 5000),
#'      col0=c("violet","blue","white","tan"),
#'      col1=c("blue","white","tan","yellow"))
#' lon <- topoWorld[["longitude"]]
#' lat <- topoWorld[["latitude"]]
#' z <- topoWorld[["z"]]
#' imagep(lon, lat, z, breaks=cm$breaks, col=cm$col)
#' contour(lon, lat, z, levels=0, add=TRUE)
#'
#' # Example 5. visualize GMT style color map
#' cm <- colormap(name="gmt_globe", debug=4)
#' plot(seq_along(cm$x0), cm$x0, pch=21, bg=cm$col0)
#' grid()
#' points(seq_along(cm$x1), cm$x1, pch=21, bg=cm$col1)
#'
#' # Example 6. colfunction
#' cm <- colormap(c(0, 1))
#' x <- 1:10
#' y <- (x - 5.5)^2
#' z <- seq(0, 1, length.out=length(x))
#' drawPalette(colormap=cm)
#' plot(x, y, pch=21, bg=cm$colfunction(z), cex=3)
#' }
#'
#' @family things related to colors
#'
#' @template colourBlindnessTemplate
colormap <- function(
    z = NULL, zlim, zclip = FALSE, breaks, col = oceColorsViridis,
    name, x0, x1, col0, col1, blend = 0, missingColor, debug = getOption("oceDebug")) {
    debug <- min(max(0, debug), 1)
    oceDebug(debug, "colormap(...) START\n", sep = "", unindent = 1)
    zKnown <- !is.null(z)
    zlimKnown <- !missing(zlim)
    breaksKnown <- !missing(breaks)
    # nolint start object_usage_linter
    colKnown <- !missing(col)
    # nolint end object_usage_linter
    nameKnown <- !missing(name)
    x0Known <- !missing(x0)
    x1Known <- !missing(x1)
    col0Known <- !missing(col0)
    col1Known <- !missing(col1)
    missingColorKnown <- !missing(missingColor)
    # Sanity checks on args
    if (blend < 0 || blend > 1) {
        stop("blend must be between 0 and 1")
    }
    if (zlimKnown) {
        if (length(zlim) != 2) {
            stop("'zlim' must be of length 2")
        }
        if (any(!is.finite(zlim))) {
            stop("'zlim' values must be finite")
        }
        if (zlim[2] <= zlim[1]) {
            stop("'zlim' values must be ordered and distinct")
        }
    }
    if (zlimKnown && breaksKnown && length(breaks) > 1) {
        stop("cannot specify both zlim and breaks, unless length(breaks)==1")
    }
    # Find cases (as a way to clarify code, and link it with the docs).
    if (nameKnown) {
        case <- "C"
    } else if (x0Known || col0Known || x1Known || col1Known) {
        case <- "B"
    } else if (zKnown || zlimKnown || breaksKnown) {
        case <- "A"
    } else {
        case <- "A"
        warning("defaulting to case A, which may be incorrect\n")
    }
    # Case C: 'name' was given: only 'name' and possibly 'z' are examined.
    if (case == "C") {
        oceDebug(debug, "Case C: name given\n")
        for (disallowed in c("zlim", "breaks", "col", "x0", "col0", "x1", "col1", "missingColor")) {
            if (get(paste0(disallowed, "Known"))) {
                stop("cannot supply '", disallowed, "' since 'name' was supplied (i.e. in Case C)\n")
            }
        }
        res <- colormap_colormap(name = name, debug = debug - 1)
        res$zclip <- zclip
        res$zlim <- range(c(res$x0, res$x1)) # ignore argument 'zlim'
        res$colfunction <- function(z) res$col0[findInterval(z, res$x0, all.inside = TRUE)]
        if (zKnown) {
            res$zcol <- res$colfunction(z)
        }
        oceDebug(debug, "END colormap() case C\n", sep = "", unindent = 1)
        return(res)
    } # end of case C
    if (case == "B") { # x0 col0 x1 col1
        oceDebug(debug, "Case B\n")
        if (!(x0Known && col0Known && x1Known && col1Known)) {
            stop("'x0', 'col0', 'x1', 'col1' must all be supplied, if any is supplied")
        }
        for (disallowed in c("name", "breaks", "col")) {
            if (get(paste0(disallowed, "Known"))) {
                stop("cannot supply '", disallowed, "' since `x0`, `col0`, `x1` and `col1` were supplied (i.e. in Case B)\n")
            }
        }
        if (length(x0) != length(x1)) {
            stop("lengths of x0 and x1 must agree")
        }
        if (length(col0) != length(col1)) {
            stop("lengths of col0 and col1 must agree")
        }
        if (length(x0) != length(col0)) {
            stop("lengths of x0 and col0 must agree")
        }
        if (!identical(x0, sort(x0))) {
            stop("'x0' must be ordered from small to large")
        }
        if (!identical(x1, sort(x1))) {
            stop("'x1' must be ordered from small to large")
        }
        breaks <- c(x0, tail(x1, 1))
        # blend colors
        col <- col2rgb(col0) # will overwrite
        oceDebug(debug, "blend=", blend, "\n", sep = "")
        for (i in seq_along(col0)) {
            col[, i] <- colorRamp(c(col0[i], col1[i]))(blend)[1, ]
        }
        col <- rgb(col[1, ], col[2, ], col[3, ], maxColorValue = 255)
        if (!missingColorKnown) {
            missingColor <- "gray"
        }
        if (zKnown) {
            # BOOKMARK1 -- this code needs to be in synch with BOOKMARK2
            i <- findInterval(z, breaks)
            missing <- i == 0
            i[missing] <- 1 # just pick something; replaced later
            zcol <- col[i]
            zcol[missing] <- missingColor
            if (zclip) {
                zcol[missing] <- missingColor
            } else {
                if (zKnown) {
                    zcol[is.na(z)] <- missingColor
                }
                zcol[z <= min(breaks)] <- col[1]
                zcol[z >= max(breaks)] <- tail(col, 1)
            }
        } else {
            zcol <- "black"
        }
        res <- list(
            x0 = x0, x1 = x1, col0 = col0, col1 = col1, missingColor = missingColor,
            zclip = zclip, zlim = if (zlimKnown) zlim else rangeExtended(c(x0, x1)),
            breaks = breaks, col = col, zcol = zcol
        )
        class(res) <- c("list", "colormap")
        oceDebug(debug, "END colormap() case B\n", sep = "", unindent = 1)
        return(res)
    } # end of case B
    oceDebug(debug, "case 3: name not given, x0 (and related) not given\n")
    if (!zlimKnown) {
        if (breaksKnown) {
            oceDebug(debug, "zlimKnown=", zlimKnown, ", so inferring zlim from breaks\n", sep = "")
            zlim <- if (length(breaks) > 1) range(breaks) else NULL
            zlimKnown <- TRUE
        } else if (zKnown) {
            oceDebug(debug, "zlimKnown=", zlimKnown, ", so inferring zlim from z\n", sep = "")
            if (!any(is.finite(z))) {
                stop("cannot infer zlim, since z has no finite values, and breaks was not given")
            }
            zlim <- rangeExtended(z[is.finite(z)])
            zlimKnown <- TRUE
        } else {
            stop("cannot infer zlim; please specify zlim, breaks, name, or z")
        }
    }
    oceDebug(debug, vectorShow(zlim))
    oceDebug(debug, vectorShow(zclip))
    blend <- max(blend, 0L)
    oceDebug(debug, vectorShow(blend))
    n <- if (blend > 1L) as.integer(round(blend)) else 1L
    oceDebug(debug, vectorShow(n))
    # Possibly determine breaks, if not given but if can be inferred from z or zlim
    if (!breaksKnown) {
        if (zlimKnown) {
            oceDebug(debug, "case 3.1 breaks not given, but inferred from zlim\n")
            breaks <- seq(min(zlim, na.rm = TRUE), max(zlim, na.rm = TRUE), length.out = 255)
            oceDebug(debug, "created", length(breaks), "breaks, ranging from", breaks[1], "to", tail(breaks, 1), "\n")
            breaksKnown <- TRUE # this makes next block execute also
        } else if (zKnown && any(is.finite(z))) {
            oceDebug(debug, "case 3.2 breaks not given, but inferred from z\n")
            breaks <- seq(min(z, na.rm = TRUE), max(z, na.rm = TRUE), length.out = 255)
            oceDebug(debug, "created", length(breaks), "breaks, ranging from", breaks[1], "to", tail(breaks, 1), "\n")
            breaksKnown <- TRUE
        }
    }
    if (breaksKnown) {
        oceDebug(debug, "case 4 breaks given, or inferred from either z or zlim\n")
        if (zKnown) {
            oceDebug(debug, "case 4.1 construct colormap using z\n")
            if (length(breaks) < 2) {
                breaks <- seq(min(z, na.rm = TRUE), max(z, na.rm = TRUE), length.out = breaks)
                oceDebug(debug, "constructing breaks from z as ", paste(breaks, collapse = " "), "\n")
            }
            if (missing(missingColor)) {
                res <- colormap_colorize(
                    zlim = zlim, zclip = zclip, z = z, breaks = breaks, col = col,
                    debug = debug - 1
                )
            } else {
                res <- colormap_colorize(
                    zlim = zlim, zclip = zclip, z = z, breaks = breaks, col = col,
                    missingColor = missingColor, debug = debug - 1
                )
            }
        } else {
            oceDebug(debug, "case 4.2 construct colormap using zlim\n")
            oceDebug(debug, "length(breaks)=", length(breaks), "\n", sep = "")
            if (length(breaks) < 2) {
                breaks <- seq(zlim[1], zlim[2], length.out = breaks)
                oceDebug(debug, "constructing breaks from zlim as ", paste(breaks, collapse = " "), "\n")
            }
            if (missing(missingColor)) {
                res <- colormap_colorize(zlim = zlim, zclip = zclip, breaks = breaks, col = col, debug = debug - 1)
            } else {
                res <- colormap_colorize(zlim = zlim, zclip = zclip, breaks = breaks, col = col, missingColor = missingColor, debug = debug - 1)
            }
            res$zcol <- "black"
        }
        res$x0 <- res$breaks[-1]
        res$x1 <- res$breaks[-1]
        res$col0 <- res$col
        res$col1 <- res$col
    }
    res$missingColor <- if (missingColorKnown) missingColor else "gray"
    res$zclip <- zclip
    res$colfunction <- function(z) res$col0[findInterval(z, res$x0)]
    class(res) <- c("list", "colormap")
    oceDebug(debug, "END colormap() case A\n", sep = "", unindent = 1)
    res
}

# keeping this (which was called 'colormap' until 2014-05-07), but not in NAMESPACE.
colormap_colormap <- function(name, x0, x1, col0, col1, n = 1, zclip = FALSE, debug = getOption("oceDebug")) {
    nameKnown <- !missing(name)
    oceDebug(debug, "colormap_colormap(name=", if (nameKnown) paste0("\"", name, "\"") else "(MISSING)", ", ...) START\n", sep = "", unindent = 1)
    if (nameKnown) {
        oceDebug(debug, "name was specified, so using colormapGMT() to compute colormap\n")
        res <- colormapGMT(name, debug = debug - 1)
    } else {
        oceDebug(debug, "name was not specified, so using x0, x1, etc., to compute colormap\n")
        if (missing(x0) || missing(x1) || missing(col0) || missing(col1)) {
            stop("give either \"name\" or all of: \"x0\", \"x1\", \"col0\" and \"col1\"")
        }
        xlen <- length(x0)
        if (length(x1) != xlen) {
            stop("lengths of \"x0\" and \"x1\" must agree")
        }
        if (length(col0) != xlen) {
            stop("lengths of \"x0\" and \"col0\" must agree")
        }
        if (length(col1) != xlen) {
            stop("lengths of \"x0\" and \"col1\" must agree")
        }
        x0r <- x1r <- col0r <- col1r <- NULL
        if (length(n) != xlen - 1) {
            n <- rep(n[1], length.out = xlen)
        }
        oceDebug(debug, "x0:", x0, "\n")
        oceDebug(debug, "x1:", x1, "\n")
        oceDebug(debug, "col0:", col0, "\n")
        oceDebug(debug, "col1:", col1, "\n")
        # x0A <- c(x0, tail(x1, 1))
        for (i in 2:xlen) {
            dx0 <- (x0[i] - x0[i - 1]) / n[i - 1]
            x0r <- c(x0r, seq(x0[i - 1], by = dx0, length.out = n[i - 1]))
            dx1 <- (x1[i] - x1[i - 1]) / n[i - 1]
            x1r <- c(x1r, seq(x1[i - 1], by = dx1, length.out = n[i - 1]))
            col0r <- c(col0r, colorRampPalette(col0[seq.int(i - 1, i)])(n[i - 1]))
            col1r <- c(col1r, colorRampPalette(col1[seq.int(i - 1, i)])(n[i - 1]))
            oceDebug(debug, "i=", i, "\n")
            oceDebug(debug, "  x0[i-1]", x0[i - 1], "x0[i]", x0[i], "\n")
            oceDebug(debug, "  concat x0:", seq(x0[i - 1], by = dx0, length.out = 1 + n[i - 1]), "\n")
            oceDebug(debug, "  col0[i-1]:", col0[i - 1], "col0[i]:", col0[i], "\n")
            oceDebug(debug, "  col1[i-1]:", col1[i - 1], "col1[i]:", col1[i], "\n")
        }
        # next is wrong -- should not just tack on one value unless n=1
        x0r <- c(x0r, tail(x0, 1))
        x1r <- c(x1r, tail(x1, 1))
        col0r <- c(col0r, tail(col0, 1))
        col1r <- c(col1r, tail(col1, 1))
        res <- list(x0 = x0r, x1 = x1r, col0 = col0r, col1 = col1r)
    }
    res$zclip <- zclip
    class(res) <- c("list", "colormap")
    oceDebug(debug, "END colormap_colormap()\n", sep = "", unindent = 1)
    res
}

# internal function for palettes
palette2breakscolor <- function(name, breaksPerLevel = 1, topoRegion = c("water", "land", "both")) {
    knownPalettes <- c("GMT_relief", "GMT_ocean", "globe")
    palette <- pmatch(name, knownPalettes)
    if (is.na(palette)) {
        stop("unknown palette name \"", name, "\"")
    }
    name <- knownPalettes[palette]
    if (name == "GMT_relief") {
        # GMT based on
        # GMT_relief.cpt,v 1.1 2001/09/23 23:11:20 pwessel Exp $
        d <- list(
            l = 1000 * c(-8, -7, -6, -5, -4, -3, -2, -1, 0, 0.5, 1, 2, 3, 4, 5, 6, 7),
            lr = c(0, 0, 0, 0, 0, 86, 172, 211, 70, 120, 146, 198, 250, 250, 252, 252, 253),
            lg = c(0, 5, 10, 80, 150, 197, 245, 250, 120, 100, 126, 178, 230, 234, 238, 243, 249),
            lb = c(0, 25, 50, 125, 200, 184, 168, 211, 50, 50, 60, 80, 100, 126, 152, 177, 216),
            u = 1000 * c(-7, -6, -5, -4, -3, -2, -1, 0, 0.5, 1, 2, 3, 4, 5, 6, 7, 8),
            ur = c(0, 0, 0, 0, 86, 172, 211, 250, 120, 146, 198, 250, 250, 252, 252, 253, 255),
            ug = c(5, 10, 80, 150, 197, 245, 250, 255, 100, 126, 178, 230, 234, 238, 243, 249, 255),
            ub = c(25, 50, 125, 200, 184, 168, 211, 255, 50, 60, 80, 100, 126, 152, 177, 216, 255),
            f = "#FFFFFF",
            b = "#000000",
            n = "#FFFFFF"
        )
    } else if (name == "GMT_ocean") {
        d <- list(
            l = 1000 * c(-8, -7, -6, -5, -4, -3, -2, -1),
            lr = c(0, 0, 0, 0, 0, 86, 172, 211),
            lg = c(0, 5, 10, 80, 150, 197, 245, 250),
            lb = c(0, 25, 50, 125, 200, 184, 168, 211),
            u = 1000 * c(-7, -6, -5, -4, -3, -2, -1, 0),
            ur = c(0, 0, 0, 0, 0, 86, 172, 211, 250),
            ug = c(5, 10, 80, 150, 197, 245, 250, 255),
            ub = c(25, 50, 125, 200, 184, 168, 211, 255),
            f = "#FFFFFF",
            b = "#000000",
            n = "#FFFFFF"
        )
    } else if (name == "globe") {
        # nolint start (long lines)
        d <- list(
            l = 1000 * c(-10, -9.5, -9, -8.5, -8, -7.5, -7, -6.5, -6, -5.5, -5, -4.5, -4, -3.5, -3, -2.5, -2, -1.5, -1, -0.5, -0.2, 0, 0.1, 0.2, 0.5, 1, 1.5, 2, 2.5, 3, 3.5, 4, 4.5, 5, 5.5, 6, 6.5, 7, 7.5, 8, 8.5, 9, 9.5),
            lr = c(153, 153, 153, 136, 119, 102, 85, 68, 51, 34, 17, 0, 27, 54, 81, 108, 134, 161, 188, 215, 241, 51, 51, 187, 255, 243, 230, 217, 168, 164, 162, 159, 156, 153, 162, 178, 183, 194, 204, 229, 242, 255, 255),
            lg = c(0, 0, 0, 17, 34, 51, 68, 85, 102, 119, 136, 153, 164, 175, 186, 197, 208, 219, 230, 241, 252, 102, 204, 228, 220, 202, 184, 166, 154, 144, 134, 123, 113, 102, 89, 118, 147, 176, 204, 229, 242, 255, 255),
            lb = c(255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 0, 102, 146, 185, 137, 88, 39, 31, 25, 19, 13, 7, 0, 89, 118, 147, 176, 204, 229, 242, 255, 255),
            u = 1000 * c(-9.5, -9, -8.5, -8, -7.5, -7, -6.5, -6, -5.5, -5, -4.5, -4, -3.5, -3, -2.5, -2, -1.5, -1, -0.5, -0.2, 0, 0.1, 0.2, 0.5, 1, 1.5, 2, 2.5, 3, 3.5, 4, 4.5, 5, 5.5, 6, 6.5, 7, 7.5, 8, 8.5, 9, 9.5, 10),
            ur = c(153, 153, 153, 136, 119, 102, 85, 68, 51, 34, 17, 0, 27, 54, 81, 108, 134, 161, 188, 215, 241, 51, 187, 255, 243, 230, 217, 168, 164, 162, 159, 156, 153, 162, 178, 183, 194, 204, 229, 242, 255, 255, 255),
            ug = c(0, 0, 0, 17, 34, 51, 68, 85, 102, 119, 136, 153, 164, 175, 186, 197, 208, 219, 230, 241, 252, 204, 228, 220, 202, 184, 166, 154, 144, 134, 123, 113, 102, 89, 118, 147, 176, 204, 229, 242, 255, 255, 255),
            ub = c(255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 102, 146, 185, 137, 88, 39, 31, 25, 19, 13, 7, 0, 89, 118, 147, 176, 204, 229, 242, 255, 255, 255),
            f = "#FFFFFF",
            b = "#000000",
            n = "#808080"
        )
        # nolint end (long lines)
    } else {
        stop("'", palette, "' is not a recognized value for 'palette'")
    }
    nlevel <- length(d$l)
    breaks <- NULL
    col <- NULL
    for (l in 1:nlevel) {
        lowerColor <- rgb(d$lr[l] / 255, d$lg[l] / 255, d$lb[l] / 255)
        upperColor <- rgb(d$ur[l] / 255, d$ug[l] / 255, d$ub[l] / 255)
        breaks <- c(breaks, seq(d$l[l], d$u[l], length.out = 1 + breaksPerLevel))
        col <- c(col, colorRampPalette(c(lowerColor, upperColor))(1 + breaksPerLevel))
    }
    if (palette %in% c("GMT_relief")) {
        if (topoRegion == "water") {
            wet <- breaks <= 0
            breaks <- breaks[wet]
            col <- col[wet]
        } else if (topoRegion == "land") {
            dry <- breaks >= 0
            breaks <- breaks[dry]
            col <- col[dry]
        }
    }
    # remove last color since must have 1 more break than color
    col <- head(col, -1)
    list(breaks = breaks, col = col, f = d$f, b = d$b, n = d$n)
}

#' Create Two-Color Palette
#'
#' Create colors ranging between two specified limits, with white
#' in the middle.
#'
#' @aliases oceColorsTwo oce.colorsTwo
#'
#' @param n number of colors to generate.
#'
#' @param low,high numerical values (in range 0 to 1) specifying the hue
#' for the low and high ends of the color scale.
#'
#' @param smax numerical value (in range 0 to 1) for the color saturation.
#'
#' @param alpha numerical value (in ragne 0 to 1) for the alpha (transparency)
#' of the colors.
#'
#' @examples
#' library(oce)
#' imagep(volcano - mean(range(volcano)),
#'     col = oceColorsTwo(128),
#'     zlim = "symmetric", zlab = "oceColorsTwo"
#' )
#' @family things related to colors
oceColorsTwo <- function(n, low = 2 / 3, high = 0, smax = 1, alpha = 1) {
    # code borrows heavily from cm.color()
    if ((n <- as.integer(n[1])) > 0) {
        even.n <- n %% 2 == 0
        k <- n %/% 2
        l1 <- k + 1 - even.n
        l2 <- n - k + even.n
        c(
            if (l1 > 0) {
                hsv(
                    h = low,
                    s = seq.int(smax, ifelse(even.n, 0.5 / k, 0), length.out = l1),
                    v = 1,
                    alpha = alpha
                )
            },
            if (l2 > 1) {
                hsv(
                    h = high,
                    s = seq.int(0, smax, length.out = l2)[-1],
                    v = 1,
                    alpha = alpha
                )
            }
        )
    } else {
        character(0)
    }
}
oce.colorsTwo <- oceColorsTwo

#' Create Colors in a GEBCO-like Scheme
#'
#' The colours were determined by examination of paper
#' charts printed during the GEBCO Fifth Edition era.
#' The hues range from dark blue to light blue, then
#' from light brown to dark brown.  If used to show
#' topography in scheme centred on z=0, this means that
#' near-coastal regions are light in tone, with darker
#' colours representing both mountains and the deep sea.
#'
#' @aliases oceColorsGebco oce.colorsGebco
#'
#' @param n Number of colors to return
#'
#' @param region String indicating application region,
#' one of `"water"`, `"land"`, or `"both"`.
#'
#' @param type String indicating the purpose, one of `"fill"` or `"line"`.
#'
#' @param debug a flag that turns on debugging.
#'
#' @examples
#' library(oce)
#' imagep(volcano, col = oceColorsGebco(128, region = "both"))
#'
#' @family things related to colors
oceColorsGebco <- function(n = 9, region = c("water", "land", "both"), type = c("fill", "line"), debug = getOption("oceDebug")) {
    oceDebug(debug, "oceColorsGebco(n=", n, ", region=\"", region, "\", type=\"", type, "\", debug=", debug, ") START\n", sep = "", unindent = 1)
    region <- match.arg(region)
    type <- match.arg(type)
    land <- c(
        "#FEF1E0", "#FDE3C1", "#FBC784", "#F1C37A", "#E6B670", "#DCA865",
        "#D19A5C", "#C79652", "#BD9248", "#B38E3E"
    )
    water <- c(
        "#0F7CAB", "#2292B5", "#38A7BF", "#4FBBC9", "#68CDD4", "#83DEDE",
        "#A0E8E4", "#BFF2EC", "#E1FCF7", "#F0FDFB"
    )
    if (type == "fill") {
        # generate land colors by e.g. rgb(t(col2rgb(land[5])-1*c(10, 4, 10))/255)
        # until 2020-12-14 land <- c("#FBC784", "#F1C37A", "#E6B670", "#DCA865", "#D19A5C",
        # until 2020-12-14           "#C79652", "#BD9248", "#B38E3E", "#A98A34")
        # until 2020-12-14 water <- rev(c("#E1FCF7", "#BFF2EC", "#A0E8E4", "#83DEDE", "#68CDD4",
        # until 2020-12-14                "#4FBBC9", "#38A7BF", "#2292B5", "#0F7CAB"))
        # land <- c("#FEF1E0", "#FDE3C1", "#FBC784", "#F1C37A", "#E6B670", "#DCA865",
        #          "#D19A5C", "#C79652", "#BD9248", "#B38E3E")
        # water <- c("#0F7CAB", "#2292B5", "#38A7BF", "#4FBBC9", "#68CDD4", "#83DEDE",
        #           "#A0E8E4", "#BFF2EC", "#E1FCF7", "#F0FDFB")
        land <- c(
            "#FFF0DF", "#FFE9D0", "#FFE2C1", "#FDD6A6", "#FBC98A", "#F7C580", "#F2C37B", "#EDBE76", "#E8B872", "#E3B26D",
            "#DEAB67", "#D9A563", "#D49E5E", "#CF995A", "#CA9755", "#C59550", "#C1934C", "#BC9147", "#B78F42", "#B38E3E"
        )
        water <- c(
            "#0F7CAB", "#1886AF", "#2090B4", "#2B9AB9", "#35A4BD", "#40AEC2", "#4BB7C7", "#56C0CC", "#62C9D1", "#6FD1D6",
            "#7BD9DB", "#89E0DF", "#96E4E2", "#A4E9E5", "#B3EEE9", "#C2F3ED", "#D2F7F2", "#E2FCF7", "#EBFDF9", "#F5FEFC"
        )
    } else {
        oceDebug(debug, "type=\"line\"\n")
        land <- c(
            "#FBC784", "#F1C37A", "#E6B670", "#DCA865", "#D19A5C",
            "#C79652", "#BD9248", "#B38E3E", "#A98A34"
        )
        water <- rev(c(
            "#A4FCE3", "#72EFE9", "#4FE3ED", "#47DCF2", "#46D7F6",
            "#3FC0DF", "#3FC0DF", "#3BB7D3", "#36A5C3"
        ))
    }
    if (region == "water") {
        rgb.list <- col2rgb(water) / 255
        l <- length(water)
        r <- approx(1:l, rgb.list[1, 1:l], xout = seq(1, l, length.out = n))$y
        g <- approx(1:l, rgb.list[2, 1:l], xout = seq(1, l, length.out = n))$y
        b <- approx(1:l, rgb.list[3, 1:l], xout = seq(1, l, length.out = n))$y
        res <- rgb(r, g, b)
    } else if (region == "land") {
        rgb.list <- col2rgb(land) / 255
        l <- length(land)
        r <- approx(1:l, rgb.list[1, 1:l], xout = seq(1, l, length.out = n))$y
        g <- approx(1:l, rgb.list[2, 1:l], xout = seq(1, l, length.out = n))$y
        b <- approx(1:l, rgb.list[3, 1:l], xout = seq(1, l, length.out = n))$y
        res <- rgb(r, g, b)
    } else {
        # both
        # See https://github.com/dankelley/oce/discussions/1756#discussioncomment-204754 for
        # a discussion of adding some white 'ink' between the water and the land.
        # ? rgb.list <- col2rgb(c(water, "#FFFFFF", "#FFFFFF", land)) / 255
        # ? rgb.list <- col2rgb(c(water, "#FFFFFF", land)) / 255
        # 20201214> rgb.list <- col2rgb(c(water, "#FFFFFF", land)) / 255
        # 20201214> l <- ncol(rgb.list)
        # 20201214> r <- approx(1:l, rgb.list[1, 1:l], xout=seq(1, l, length.out=n))$y
        # 20201214> g <- approx(1:l, rgb.list[2, 1:l], xout=seq(1, l, length.out=n))$y
        # 20201214> b <- approx(1:l, rgb.list[3, 1:l], xout=seq(1, l, length.out=n))$y
        # I find it very difficult to see a difference between 'rgb' and 'Lab' spaces, and between
        # 'linear' and 'spline' interpolations.
        cr <- colorRamp(c(water, "#FFFFFF", land), bias = 1, space = "rgb", interpolate = "spline")(seq(0, 1, length.out = n))
        res <- rgb(cr, maxColorValue = 255)
    }
    oceDebug(debug, "END oceColorsGebco()", sep = "", unindent = 1)
    res
}
oce.colorsGebco <- oceColorsGebco

#' Create Color Functions
#'
#' This function generates other functions that are used to specify colors.
#' It is used within oce to create [oceColorsTemperature()]
#' and its many cousins. Users may also find it helpful, for creating
#' custom color schemes (see \dQuote{Examples}).
#'
#' @param spec Specification of the color scheme. This may be a
#' character string, in which case it must be the name of an item stored
#' in `data(ocecolors)`, or either a 3-column data frame or
#' matrix, in which case the columns specify red, green and blue values
#' (in range from 0 to 1).
#'
#' @section Sample of Usage:
#' \preformatted{
#' # Update oxygen color scheme to latest matplotlib value.
#' library(oce)
#' oxy <- "https://raw.githubusercontent.com/matplotlib/cmocean/master/cmocean/rgb/oxy-rgb.txt"
#' oxyrgb <- read.table(oxy, header=FALSE)
#' oceColorsOxygenUpdated <- oceColorsClosure(oxyrgb)
#' par(mfrow=c(1, 2))
#' m <- matrix(1:256)
#' imagep(m, col=oceColorsOxygen, zlab="oxygen")
#' imagep(m, col=oceColorsOxygenUpdated, zlab="oxygenUpdated")
#' }
#' @family things related to colors
oceColorsClosure <- function(spec) {
    function(n) {
        if (is.character(spec)) {
            data("ocecolors", package = "oce", envir = environment())
            col <- get("ocecolors")[[spec]]
        } else if (is.data.frame(spec) || is.matrix(spec)) {
            col <- rgb(spec[, 1], spec[, 2], spec[, 3])
        } else {
            stop("oceColorsClosure(): first arg must be character, data frame, or 3-column matrix", call. = FALSE)
        }
        if (missing(n) || n <= 0) colorRampPalette(col) else colorRampPalette(col)(n)
    }
}

#' Create Colors Similar to the Google Turbo Scheme
#'
#' This uses the coefficients published (with Apache license) by google,
#' as described by Mikhailo (2019).
#'
#' @aliases oce.colorsTurbo oceColorsTurbo
#'
#' @param n number of colors to create.
#'
#' @references
#' Mikhailo, Anton.
#' \dQuote{Turbo, An Improved Rainbow Colormap for Visualization.}
#' Google AI (blog), August 20, 2019.
#' `https://ai.googleblog.com/2019/08/turbo-improved-rainbow-colormap-for.html`
#'
#' @author Dan Kelley
#'
#' @examples
#' library(oce)
#' imagep(volcano,
#'     col = oceColorsTurbo(128),
#'     zlab = "oceColorsTurbo"
#' )
#'
#' @template colourBlindnessTemplate
#' @family things related to colors
oceColorsTurbo <- oce.colorsTurbo <- oceColorsClosure("turbo")


#' Create Colors Similar to the Matlab Viridis Scheme
#'
#' This is patterned on a \proglang{matlab}/\proglang{python} scheme that blends
#' from yellow to blue in a way that is designed to reproduce well
#' in black-and-white, and to be interpretable by those with
#' certain forms of color blindness.  See the references for
#' notes about issues of colour blindness in computer graphics.
#' An alternative
#' to [oceColorsViridis] is provided in the \CRANpkg{viridis} package, as illustrated
#' in Example 2.
#'
#' @aliases oce.colorsViridis oceColorsViridis
#'
#' @param n number of colors to create.
#'
#' @template colourBlindnessTemplate
#'
#' @author Dan Kelley
#'
#' @examples
#' library(oce)
#' # Example 1: oceColorsViridis
#' imagep(volcano,
#'     col = oceColorsViridis(128),
#'     zlab = "oceColorsViridis"
#' )
#'
#' @family things related to colors
#'
#' @template colourBlindnessTemplate
oceColorsViridis <- oce.colorsViridis <- oceColorsClosure("viridis")

#' @templateVar colorItem CDOM
#' @templateVar colorItemUC CDOM
#' @template cmcolorTemplate
#'
#' @template colourBlindnessTemplate
oceColorsCDOM <- oce.colorsCDOM <- oceColorsClosure("cdom")

#' @templateVar colorItem chlorophyll
#' @templateVar colorItemUC Chlorophyll
#' @template cmcolorTemplate
#'
#' @template colourBlindnessTemplate
oceColorsChlorophyll <- oce.colorsChlorophyll <- oceColorsClosure("chlorophyll")

#' @templateVar colorItem density
#' @templateVar colorItemUC Density
#' @template cmcolorTemplate
#'
#' @template colourBlindnessTemplate
oceColorsDensity <- oce.colorsDensity <- oceColorsClosure("density")

#' @templateVar colorItem freesurface
#' @templateVar colorItemUC Freesurface
#' @template cmcolorTemplate
#'
#' @template colourBlindnessTemplate
oceColorsFreesurface <- oce.colorsFreesurface <- oceColorsClosure("freesurface")

#' @templateVar colorItem oxygen
#' @templateVar colorItemUC Oxygen
#' @template cmcolorTemplate
#'
#' @template colourBlindnessTemplate
oceColorsOxygen <- oce.colorsOxygen <- oceColorsClosure("oxygen")

#' @templateVar colorItem PAR
#' @templateVar colorItemUC PAR
#' @template cmcolorTemplate
#'
#' @template colourBlindnessTemplate
oceColorsPAR <- oce.colorsPAR <- oceColorsClosure("par")

#' @templateVar colorItem phase
#' @templateVar colorItemUC Phase
#' @template cmcolorTemplate
#'
#' @template colourBlindnessTemplate
oceColorsPhase <- oce.colorsPhase <- oceColorsClosure("phase")

#' @templateVar colorItem salinity
#' @templateVar colorItemUC Salinity
#' @template cmcolorTemplate
#'
#' @template colourBlindnessTemplate
oceColorsSalinity <- oce.colorsSalinity <- oceColorsClosure("salinity")

#' @templateVar colorItem temperature
#' @templateVar colorItemUC Temperature
#' @template cmcolorTemplate
#'
#' @template colourBlindnessTemplate
oceColorsTemperature <- oce.colorsTemperature <- oceColorsClosure("temperature")

#' @templateVar colorItem turbidity
#' @templateVar colorItemUC Turbidity
#' @template cmcolorTemplate
#'
#' @template colourBlindnessTemplate
oceColorsTurbidity <- oce.colorsTurbidity <- oceColorsClosure("turbidity")

#' @templateVar colorItem velocity
#' @templateVar colorItemUC Velocity
#' @template cmcolorTemplate
#'
#' @template colourBlindnessTemplate
oceColorsVelocity <- oce.colorsVelocity <- oceColorsClosure("velocity")

#' @templateVar colorItem vorticity
#' @templateVar colorItemUC Vorticity
#' @template cmcolorTemplate
#'
#' @template colourBlindnessTemplate
oceColorsVorticity <- oce.colorsVorticity <- oceColorsClosure("vorticity")


#' Create Colors Similar to the Matlab Jet Scheme
#' @aliases oceColorsJet oce.colorsJet oceColors9A oce.colors9A
#' @param n number of colors
#' @examples
#' library(oce)
#' imagep(volcano, col = oceColorsJet, zlab = "oceColorsJet")
#'
#' @template colourBlindnessTemplate
#' @family things related to colors
oceColorsJet <- function(n) {
    if (missing(n) || n <= 0) {
        colorRampPalette(c(
            "#00007F", "blue", "#007FFF", "cyan",
            "#7FFF7F", "yellow", "#FF7F00", "red", "#7F0000"
        ))
    } else {
        colorRampPalette(c(
            "#00007F", "blue", "#007FFF", "cyan",
            "#7FFF7F", "yellow", "#FF7F00", "red", "#7F0000"
        ))(n)
    }
}
oce.colors9A <- oceColors9A <- oce.colorsJet <- oceColorsJet

#' Create Colors in a Red-Yellow-Blue Color Scheme
#'
#' The results are similar to those of [oceColorsJet()], but
#' with white hues in the centre, rather than green ones. The scheme
#' may be useful in displaying signed quantities, and thus is somewhat
#' analogous to [oceColorsTwo()], except that some viewers
#' may be able to distinguish more colors with `oceColors9B`.
#'
#' @aliases oceColors9B oce.colors9B
#'
#' @param n number of colors
#'
#' @examples
#' library(oce)
#' imagep(volcano,
#'     col = oceColors9B(128),
#'     zlab = "oceColors9B"
#' )
#'
#' @template colourBlindnessTemplate
#' @family things related to colors
oceColors9B <- function(n) {
    if (missing(n) || n <= 0) {
        colorRampPalette(c(
            "#00007F", "blue", "#007FFF", "#22e4e7",
            "white", "#ffe45e", "#FF7F00", "red", "#7F0000"
        ))
    } else {
        colorRampPalette(c(
            "#00007F", "blue", "#007FFF", "#22e4e7",
            "white", "#ffe45e", "#FF7F00", "red", "#7F0000"
        ))(n)
    }
}
oce.colors9B <- oceColors9B

#' Create a Vector of Colors
#'
#' The available schemes are:
#' * `which=1` for a red-white-blue scheme.
#' * `which=2` for a red-yellow-blue scheme.
#' * `which=9.01`, `which="9A"` or `which="jet"` for [`oceColorsJet`]`(n)`.
#' * `which=9.02` or `which="9B"` for [`oceColors9B`]`(n)`.
#'
#' @param n number of colors to create
#'
#' @param which integer or character string indicating the palette
#' to use; see \dQuote{Details}.
#'
#' @aliases oce.colorsPalette oceColorsPalette
#'
#' @template colourBlindnessTemplate
#'
#' @family things related to colors
oceColorsPalette <- function(n, which = 1) {
    if ((n <- as.integer(n[1])) > 0) {
        if (which == 1) {
            # Started with http://www.personal.psu.edu/cab38/ColorBrewer/ColorBrewer.html
            # RdBu 11 divisions
            # and then smoothed the components with smooth.spline(...,df=6)
            rgb <- matrix(c(
                103, 000, 026,
                178, 024, 046,
                214, 096, 072,
                244, 165, 136,
                253, 219, 195,
                247, 247, 247,
                209, 229, 238,
                146, 197, 226,
                067, 147, 184,
                033, 102, 179,
                005, 048,  97
            ), ncol = 3, byrow = TRUE) / 255
            m <- dim(rgb)[1]
            i <- 1:m
            xout <- seq(1, m, length.out = n)
            rev(rgb(
                red = approx(i, rgb[, 1], xout, rule = 1)$y,
                green = approx(i, rgb[, 2], xout, rule = 1)$y,
                blue = approx(i, rgb[, 3], xout, rule = 1)$y,
                alpha = 1
            ))
        } else if (which == 2) {
            # http://www.personal.psu.edu/cab38/ColorBrewer/ColorBrewer.html
            m <- 11 # number of classes
            r <- c(165, 215, 244, 253, 254, 255, 224, 171, 116, 69, 49) / 255
            g <- c(0, 48, 109, 174, 224, 255, 243, 217, 173, 117, 54) / 255
            b <- c(38, 39, 67, 97, 144, 191, 248, 233, 209, 180, 149) / 255
            i <- 1:m
            xout <- seq(1, m, length.out = n)
            rev(rgb(
                approx(i, r, xout, rule = 1)$y,
                approx(i, g, xout, rule = 1)$y,
                approx(i, b, xout, rule = 1)$y
            ))
        } else if (which == 9.01 || which == "9A" || which == "jet") {
            # jet, also known as 9A or 9.01
            oceColorsJet(n)
        } else if (which == 9.02 || which == "9B") {
            oceColors9B(n)
        } else {
            stop("unknown which")
        }
    } else {
        character(0)
    }
}
oce.colorsPalette <- oceColorsPalette

#' Create Colors in the Cube Helix Style
#'
#' This is a colour scheme that renders well in black and white,
#' that has colours that are reasonably distinct for many
#' viewers, and that may be good for persons with colour
#' deficiencies.  For more on such matters, the underlying
#' theory, and the meanings of the parameter values, please
#' see Green (2011). That R code for the present function
#' is a rewriting of Fortran code provided in an appendix
#' of that paper.
#'
#' @param n number of colors to create, with default 256.
#'
#' @param start numeric value indicating the starting colour.
#' The default, 0.5, corresponds to purpose, as in Green (2011).
#'
#' @param rotations numeric value for number of rotations of the
#' helix, with default -1.5 as in Green (2011).
#'
#' @param hue numeric value with default 1.2, as in Green (2011).
#'
#' @param gamma numeric value, with default 1.
#'
#' @aliases oce.colorsCubeHelix oceColorsCubeHelix
#'
#' @examples
#' library(oce)
#' # Example 1: normal (dark for low values)
#' imagep(volcano, col = oceColorsCubeHelix)
#' # Example 2: reversed (dark for high values)
#' imagep(volcano, col = \(n) rev(oceColorsCubeHelix(n)))
#'
#' @references
#'
#' 1. Green, D.A. “A Colour Scheme for the Display of Astronomical
#' Intensity Images.” Bulletin of the Astronomical Society of India,
#' 39 (2011): 289–95.
#'
#' @family things related to colors
#'
#' @author Dan Kelley based on Fortran code by D.A. Green (2011).
oceColorsCubeHelix <- function(n = 256, start = 0.5, rotations = -1.5, hue = 1.2, gamma = 1) {
    if (n < 1) {
        stop("n must be >1, but it is ", n)
    }
    pin <- function(x) {
        ifelse(x < 0, 0, ifelse(x > 1, 1, x))
    }
    red <- rep(0.0, n)
    green <- rep(0.0, n)
    blue <- rep(0.0, n)
    for (i in seq_len(n)) {
        fract <- (i - 1.0) / (n - 1.0)
        angle <- 2. * pi * (start / 3 + 1 + rotations * fract)
        C <- cos(angle)
        S <- sin(angle)
        fract <- fract^gamma
        amp <- hue * fract * (1.0 - fract) / 2.0
        red[i] <- fract + amp * (-0.14861 * C + 1.78277 * S)
        green[i] <- fract + amp * (-0.29227 * C - 0.90649 * S)
        blue[i] <- fract + amp * (+1.97294 * C)
    }
    rgb(pin(red), pin(green), pin(blue))
}
oce.colorsCubeHelix <- oceColorsCubeHelix
