add files

DESCRIPTION

@@ -0,0 +1,19 @@
+Package: palettes
+Title: Methods for Colours
+Version: 0.0.0.9000
+Authors@R: 
+    person(given = "Michael",
+           family = "McCarthy",
+           role = c("aut", "cre"),
+           email = "m.mccarthy1624@gmail.com")
+Description: What the package does (one paragraph).
+License: MIT + file LICENSE
+Encoding: UTF-8
+LazyData: true
+Roxygen: list(markdown = TRUE)
+RoxygenNote: 7.1.1
+Imports: 
+    vctrs,
+    crayon,
+    methods,
+    glue

LICENSE

@@ -0,0 +1,2 @@
+YEAR: 2021
+COPYRIGHT HOLDER: Michael McCarthy

LICENSE.md

@@ -0,0 +1,21 @@
+# MIT License
+
+Copyright (c) 2021 Michael McCarthy
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

NAMESPACE

@@ -0,0 +1,18 @@
+# Generated by roxygen2: do not edit by hand
+
+S3method(format,palettes_color)
+S3method(vec_cast,character.palettes_color)
+S3method(vec_cast,palettes_color.character)
+S3method(vec_cast,palettes_color.palettes_color)
+S3method(vec_ptype2,character.palettes_color)
+S3method(vec_ptype2,palettes_color.character)
+S3method(vec_ptype2,palettes_color.palettes_color)
+S3method(vec_ptype_abbr,palettes_color)
+S3method(vec_ptype_full,palettes_color)
+export(as_color)
+export(color)
+export(is_color)
+import(vctrs)
+importFrom(glue,glue)
+importFrom(grDevices,col2rgb)
+importFrom(grDevices,rgb)

NEWS.md

@@ -0,0 +1,3 @@
+# palettes 0.0.0.9000
+
+* Added a `NEWS.md` file to track changes to the package.

R/cast.R

@@ -0,0 +1,8 @@
+#' @export
+vec_cast.palettes_color.palettes_color <- function(x, to, ...) x
+
+#' @export
+vec_cast.palettes_color.character <- function(x, to, ...) color(x)
+
+#' @export
+vec_cast.character.palettes_color <- function(x, to, ...) vec_data(x)

R/coerce.R

@@ -0,0 +1,8 @@
+
+
+#' @export
+vec_ptype2.palettes_color.palettes_color <- function(x, y, ...) new_color()
+#' @export
+vec_ptype2.palettes_color.character <- function(x, y, ...) character()
+#' @export
+vec_ptype2.character.palettes_color <- function(x, y, ...) character()

R/color.R

@@ -0,0 +1,47 @@
+# for compatibility with the S4 system
+methods::setOldClass(c("palettes_color", "vctrs_vctr"))
+
+#' `color` vector
+#'
+#' This creates a character vector that represents colours so when it is
+#' printed, colours will be formatted as hexadecimal strings.
+#'
+#' @param x
+#'  * For `color()`: A character vector of any of the three kinds of R colour
+#'   specifications.
+#'  * For `as_color()`: An object to be coerced.
+#'  * For `is_color()`: An object to test.
+#' @details
+#'
+#' Colours can be specified using either:
+#' - A color name (as listed by colors())
+#' - a hexadecimal string of the form "#rrggbb" or "#rrggbbaa" (see rgb)
+#' - A positive integer i meaning palette()[i].
+#'
+#' @return An S3 vector of class `palettes_color`.
+#' @export
+#' @examples
+#' color(c("red", "#A2A0B8", "gray62"))
+#' is_color(c("#DA3A2C", "blue"))
+#' as_color("white")
+color <- function(x = character()) {
+  x <- vec_cast(x, character())
+  new_color(x)
+}
+
+new_color <- function(x = character()) {
+  vec_assert(x, character())
+  new_vctr(x, class = "palettes_color")
+}
+
+#' @export
+#' @rdname color
+is_color <- function(x) {
+  inherits(x, "palettes_color")
+}
+
+#' @export
+#' @rdname color
+as_color <- function(x) {
+  vec_cast(x, new_color())
+}

R/format.R

@@ -0,0 +1,31 @@
+#' @export
+format.palettes_color <- function(x, ...) {
+  out <- rgb2col(col2rgb(vec_data(x), alpha = TRUE), alpha = TRUE)
+  out[is.na(x)] <- NA
+  out
+}
+
+# TODO: Create print method whose output matches the output of format, except
+# with the pretty colours applied.
+#
+# <palettes_color[4]>
+# [1] #FF0000FF #A2A0B8FF <NA>      #9E9E9EFF
+#
+# #' @export
+# print.palettes_color <- function(x, ...) {
+#   cat(
+#     glue("<{vctrs::vec_ptype_full(x)}[{length(x)}]>"),
+#     "\n",
+#     pretty_color(format(x))
+#   )
+# }
+
+#' @export
+vec_ptype_abbr.palettes_color <- function(x, ...) {
+  "color"
+}
+
+#' @export
+vec_ptype_full.palettes_color <- function(x) {
+  "palettes_color"
+}

R/palettes-package.R

@@ -0,0 +1,16 @@
+#' @keywords internal
+"_PACKAGE"
+
+## usethis namespace: start
+#' @importFrom glue glue
+#' @importFrom grDevices col2rgb
+#' @importFrom grDevices rgb
+## usethis namespace: end
+NULL
+
+#' Internal vctrs methods
+#'
+#' @import vctrs
+#' @keywords internal
+#' @name palettes-vctrs
+NULL

R/pretty.R

@@ -0,0 +1,20 @@
+# FIXME: The string colour needs to be improved.
+color_style <- function(x) {
+  string <- crayon::make_style("white")
+  background <- crayon::make_style(x, bg = TRUE)
+  style_function <- crayon::combine_styles(string, background)
+
+  style_function(x)
+}
+
+pretty_color <- function(x) {
+  vapply(
+    x,
+    function(x) {
+      color_index <- !is.na(x)
+      if (color_index) color_style(x) else "<NA>     "
+    },
+    FUN.VALUE = character(1),
+    USE.NAMES = FALSE
+  )
+}

R/util.R

@@ -0,0 +1,7 @@
+rgb2col <- function(x, alpha = FALSE) {
+  if (alpha) {
+    rgb(x[1, ], x[2, ], x[3, ], alpha = x[4, ], maxColorValue = 255)
+  } else {
+    rgb(x[1, ], x[2, ], x[3, ], maxColorValue = 255)
+  }
+}

README.md

@@ -1 +1,8 @@
-# palettes
+
+# palettes
+
+<!-- badges: start -->
+<!-- badges: end -->
+
+The goal of palettes is to provide methods for working with colour palettes, particularly for developers who want to make their own colour palette package. It is in very early development.
+

inst/interactive.R

@@ -0,0 +1,48 @@
+x <- color(c("red", "#A2A0B8FF", NA, "gray62"))
+x
+
+str(x)
+data.frame(x)
+tibble::as_tibble(x)
+
+as_color("red")
+
+# Mock-up print method. The challenge is in adding a line number to the output;
+# it also does not handle wrapping well when there are lots of colours.
+x_format <- pretty_color(format(x))
+cat(
+  glue("<{vctrs::vec_ptype_full(x)}[{length(x)}]>"),
+  "\n", "[1] ",
+  paste(x_format, collapse = " "),
+  sep = ""
+)
+cat(
+  glue("<{vctrs::vec_ptype_full(x)}[{length(x)}]>"),
+  "\n", "[1] ",
+  paste(rep(x_format, 5), collapse = " "),
+  sep = ""
+)
+cat(
+  glue("<{vctrs::vec_ptype_full(x)}[{length(x)}]>"),
+  "\n", "[1] ",
+  stringr::str_wrap(paste(rep(x_format, 5), collapse = " ")),
+  sep = ""
+)
+
+cat(
+  glue("<{vctrs::vec_ptype_full(x)}[{length(x)}]>"),
+  strwrap(paste(rep(x_format, 5), collapse = " "), width = 250, prefix = c("[1] ")),
+  sep = ""
+)
+
+# This gives line numbers rather than the index of the item at the start of each line
+wrap_x <- stringr::str_wrap(paste(rep(x_format, 5), collapse = " "))
+split_x <- unlist(stringr::str_split(wrap_x, "\n"))
+glue_x <- glue("[{1:length(split_x)}] {split_x}")
+
+cat(
+  glue("<{vctrs::vec_ptype_full(x)}[{length(x)}]>"),
+  glue("[{1:length(split_x)}] {split_x}", .sep = "AHHHHHHH"),
+  sep = "\n"
+)
+

palettes.Rproj

@@ -0,0 +1,20 @@
+Version: 1.0
+
+RestoreWorkspace: Default
+SaveWorkspace: Default
+AlwaysSaveHistory: Default
+
+EnableCodeIndexing: Yes
+UseSpacesForTab: Yes
+NumSpacesForTab: 2
+Encoding: UTF-8
+
+RnwWeave: Sweave
+LaTeX: pdfLaTeX
+
+AutoAppendNewline: Yes
+StripTrailingWhitespace: Yes
+
+BuildType: Package
+PackageUseDevtools: Yes
+PackageInstallArgs: --no-multiarch --with-keep.source