update README

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: oxfordtheme
 Type: Package
-Title: Oxford Theme and Theme Components
+Title: Oxford Palette, Theme, and Theme Components
 Version: 0.0.0.9000
 Authors@R: person(
       given = "Ernest", 
@@ -9,8 +9,8 @@ Authors@R: person(
       email = "[email protected]", 
       role = c("aut", "cre")
     )
-Description: Theme and theme components based on University of Oxford's visual 
-    identity guidelines
+Description: Palette, theme, and theme components based on University of 
+    Oxford's visual identity guidelines
     <https://communications.web.ox.ac.uk/communications-resources/visual-identity/identity-guidelines>. 
 License: GPL (>= 3)
 Depends: 

NAMESPACE

@@ -1,8 +1,20 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(print,palette)
 export(cmyk2rgb)
+export(create_brewer_palette)
+export(create_palette_divergent)
+export(create_palette_qualitative)
+export(create_palette_sequential)
 export(get_oxford_colour)
 export(get_oxford_colours)
-export(oxford_palettes)
+export(oxford_brewer_palettes)
+export(oxford_theme_palettes)
 importFrom(grDevices,col2rgb)
+importFrom(grDevices,colorRampPalette)
+importFrom(grDevices,rgb)
+importFrom(graphics,image)
+importFrom(graphics,par)
+importFrom(graphics,rect)
+importFrom(graphics,text)
 importFrom(stringr,str_pad)

R/create_palette.R

@@ -0,0 +1,161 @@
+#'
+#' Create new palettes based on Oxford palettes
+#'
+#' These functions apply a similar approach used and demonstrated by
+#' [ColorBrewer](https://colorbrewer2.org) and has been patterned after the
+#' syntax of the [RColorBrewer](https://cran.r-project.org/web/packages/RColorBrewer/index.html)
+#' package
+#'
+#' @param name Name of Oxford palette to use
+#' @param n Number of colours desired/required. Oxford palettes have at least
+#'   5 colours. All colour schemes are derived from the University of Oxford
+#'   [visual identity guidelines](https://communications.web.ox.ac.uk/communications-resources/visual-identity/identity-guidelines).
+#'   #If NULL (default), use all colours.
+#' @param type A character value for type of palette to use. Can be either
+#'   sequential, divergent, or qualitative.
+#'
+#' @return A character vector of desired/required colours with length equivalent
+#'   to `n`
+#'
+#' @examples
+#' create_palette_sequential("blues", 5)
+#' create_palette_divergent("brbg", 10)
+#' create_palette_qualitative("dark", 5)
+#' create_brewer_palette("blues", 5)
+#'
+#' @rdname create_palette
+#' @export
+#'
+
+create_palette_sequential <- function(name, n) {
+  ## Check if specified palette is sequential ----
+  if (
+    !name %in% c(
+      "blues", "bugn", "bupu", "gnbu", "greens", "greys",
+      "pubu", "pubugn", "purd", "rdpu", "reds", "ylgn",
+      "ylgnbu", "ylorbr", "ylorrd"
+    )
+  ) stop (
+    "Selected palette is not a sequential palette. Please verify and try again."
+  )
+
+  ## Check if number of colours is compatible with sequential ----
+  if (n < 3) {
+    warning ("Sequential palettes have minimum 3 colours. Returning 3 colours.")
+    n <- 3
+  }
+
+  if (n > 9) {
+    warning ("Sequential palettes have maximum 9 colours. Returning 9 colours.")
+    n <- 9
+  }
+
+  ## Get base palette ----
+  pal <- oxford_brewer_palettes()[[name]]
+
+  ## Update palette to n ----
+  pal <- grDevices::colorRampPalette(pal)(n)
+
+  ## Return palette ----
+  structure(pal, class = "palette", name = name)
+}
+
+
+#'
+#' @rdname create_palette
+#' @export
+#'
+create_palette_divergent <- function(name, n) {
+  ## Check if specified palette is divergent ----
+  if (
+    !name %in%
+      c("brbg", "piylgn", "prgn", "puor", "rdbu", "rdgy","rdylbu", "rdylgn")
+  ) stop (
+    "Selected palette is not a divergent palette. Please verify and try again."
+  )
+
+  ## Check if number of colours is compatible with divergent ----
+  if (n < 3) {
+    warning ("Divergent palettes have minimum 3 colours. Returning 3 colours.")
+    n <- 3
+  }
+
+  if (n > 9) {
+    warning ("Divergent palettes have maximum 11 colours. Returning 11 colours.")
+    n <- 9
+  }
+
+  ## Get base palette ----
+  pal <- oxford_brewer_palettes()[[name]]
+
+  ## Update palette to n ----
+  pal <- grDevices::colorRampPalette(pal)(n)
+
+  ## Return palette ----
+  structure(pal, class = "palette", name = name)
+}
+
+#'
+#' @rdname create_palette
+#' @export
+#'
+create_palette_qualitative <- function(name, n) {
+  ## Check if specified palette is qualitative ----
+  if (
+    !name %in%
+    c("pastel", "dark", "heritage", "contemporary", "celebratory", "corporate")
+  ) stop (
+    "Selected palette is not a qualitative palette. Please verify and try again."
+  )
+
+  ## Check if number of colours is compatible with pastel ----
+  if (n > 8 & name == "pastel") {
+    warning (
+      paste(
+        "The pastel qualitative palette has maximum 8 colours. Returning 8 colours."
+      )
+    )
+    n <- 8
+  }
+
+  ## Check if number of colours is compatible with dark ----
+  if (n > 7 & name == "dark") {
+    warning (
+      paste(
+        "The dark qualitative palette has maximum 7 colours. Returning 7 colours."
+      )
+    )
+    n <- 7
+  }
+
+  ## Get base palette ----
+  pal <- oxford_brewer_palettes()[[name]]
+
+  ## Update palette to n ----
+  pal <- grDevices::colorRampPalette(pal)(n)
+
+  ## Return palette ----
+  structure(pal, class = "palette", name = name)
+}
+
+
+#'
+#' @rdname create_palette
+#' @export
+#'
+create_brewer_palette <- function(name, n,
+                                  type = c("sequential", "divergent", "qualitative")) {
+  ## Determine type of palette ----
+  type <- match.arg(type)
+
+  ## Determine which palette to create ----
+  if (type == "sequential") pal <- create_palette_sequential(name = name, n = n)
+
+  if (type == "divergent") pal <- create_palette_divergent(name = name, n = n)
+
+  if (type == "qualitative") pal <- create_palette_qualitative(name = name, n = n)
+
+  ## Return palette ----
+  pal
+}
+

R/get_colours.R

@@ -0,0 +1,75 @@
+#'
+#' Get named Oxford colours vector
+#'
+#' @param pattern Optional. A character value or vector to use as a search term.
+#'   Default is NULL in which case all the Oxford colours are returned.
+#' @param model A character vector of colour model. Can be "rgb", "cmyk", "hex",
+#'   or "pantone". Default is "hex".
+#' @param named Logical. Should the output be a named character value or
+#'   vector? Default is FALSE.
+#'
+#' @return A character value or vector of Oxford colour/s as per `model`
+#'   specification. If `named` is TRUE, returns a named character value or
+#'   vector.
+#'
+#' @examples
+#' get_oxford_colours()
+#' get_oxford_colours(model = "rgb")
+#' get_oxford_colours(pattern = "lilac")
+#' get_oxford_colours(pattern = c("lilac", "sage green"))
+#'
+#' @rdname get_oxford_colour
+#' @export
+#'
+get_oxford_colour <- function(pattern = NULL,
+                              model = c("hex", "rgb", "cmyk", "pantone"),
+                              named = FALSE) {
+  ## Get type ----
+  model <- match.arg(model)
+
+  ## Get df ----
+  df <- oxfordtheme::oxford_colours
+
+  ## Determine if there is something specific to search for ----
+  if (!is.null(pattern)) {
+    ## Get colours vector ----
+    ox_cols <- df[c("name", model)][stringr::str_detect(df$name, pattern = pattern), ]
+
+    if (named) {
+      ox_cols <- structure(ox_cols[[model]], names = ox_cols[["name"]])
+    } else {
+      ox_cols <- ox_cols[[model]]
+    }
+  } else {
+    ## Get colours vector ----
+    ox_cols <- df[[model]]
+
+    if (named) {
+      names(ox_cols) <- df[["name"]]
+    }
+  }
+
+  ox_cols
+}
+
+#'
+#' @rdname get_oxford_colour
+#' @export
+#'
+
+get_oxford_colours <- function(pattern = NULL,
+                               model = c("hex", "rgb", "cmyk", "pantone"),
+                               named = FALSE) {
+  ## Return all or just specific colours ----
+  if (is.null(pattern)) {
+    ox_cols <- get_oxford_colour(pattern = pattern, model = model, named = named)
+  } else {
+    ox_cols <- lapply(
+      X = pattern, FUN = get_oxford_colour, model = model, named = named
+    ) |>
+      unlist()
+  }
+
+  ## Return ox_cols ----
+  ox_cols
+}