gadget single color scale

dreamRs · Aug 28, 2018 · 3787b77 · 3787b77
1 parent 9ac5400
commit 3787b77
Show file tree

Hide file tree

Showing 9 changed files with 308 additions and 17 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -14,5 +14,8 @@ Imports:
     R6,
     V8,
     stringi,
-    htmltools
+    htmltools,
+    shiny,
+    miniUI,
+    shinyWidgets
 RoxygenNote: 6.1.0
diff --git a/NAMESPACE b/NAMESPACE
@@ -6,6 +6,7 @@ export(chroma_distance)
 export(chroma_get)
 export(chroma_mix)
 export(chroma_random)
+export(color_scale)
 export(colors_rect)
 export(get_dark_cols)
 export(get_light_cols)
@@ -15,6 +16,21 @@ importFrom(glue,glue)
 importFrom(glue,single_quote)
 importFrom(htmltools,tags)
 importFrom(htmltools,validateCssUnit)
+importFrom(miniUI,miniContentPanel)
+importFrom(miniUI,miniPage)
+importFrom(shiny,actionButton)
+importFrom(shiny,addResourcePath)
+importFrom(shiny,dialogViewer)
+importFrom(shiny,icon)
+importFrom(shiny,paneViewer)
+importFrom(shiny,renderUI)
+importFrom(shiny,runGadget)
+importFrom(shiny,sliderInput)
+importFrom(shiny,splitLayout)
+importFrom(shiny,stopApp)
+importFrom(shiny,uiOutput)
+importFrom(shinyWidgets,chooseSliderSkin)
+importFrom(shinyWidgets,spectrumInput)
 importFrom(stringi,stri_c)
 importFrom(stringi,stri_split_fixed)
 importFrom(utils,type.convert)
diff --git a/R/colorscale-addin.R b/R/colorscale-addin.R
@@ -0,0 +1,176 @@
+
+#' Color Scale Shiny Gadget
+#'
+#' Interactively create a color palette from a unique color
+#'
+#' @param color Hexadecimal string or a name for color.
+#'
+#' @export
+#'
+#' @importFrom miniUI miniPage miniContentPanel
+#' @importFrom htmltools tags
+#' @importFrom shiny uiOutput renderUI runGadget paneViewer actionButton
+#'  sliderInput splitLayout icon dialogViewer stopApp observeEvent
+#' @importFrom shinyWidgets spectrumInput chooseSliderSkin
+#'
+#' @examples
+#' \dontrun{
+#'
+#' if (interactive()) {
+#'
+#' # Launch the gadget with :
+#' color_scale()
+#'
+#' }
+#'
+#' }
+color_scale <- function(color = "#1D9A6C") {
+  stopifnot(length(color) == 1)
+
+  ui <- miniPage(
+    chooseSliderSkin("Modern", color = "#112446"),
+    # style sheet
+    tags$link(rel="stylesheet", type="text/css", href="colorscale/styles.css"),
+    # title
+    tags$div(
+      class="gadget-title dreamrs-title-box",
+      tags$h1(icon("paint-brush"), "Color Scale from one color", class = "dreamrs-title"),
+      actionButton(
+        inputId = "close", label = "Close",
+        class = "btn-sm pull-left"
+      )
+    ),
+    # body
+    miniContentPanel(
+      padding = 10,
+      spectrumInput(
+        inputId = "main_col",
+        label = "Choose a color:",
+        selected = color,
+        options = list(
+          "show-buttons" = FALSE,
+          "preferred-format" = "hex",
+          "show-input" = TRUE
+        )
+      ),
+      tags$br(),
+      tags$b("Output palette:"),
+      uiOutput(outputId = "rect_cols"),
+      tags$br(),
+      # tags$b("Parameters:"),
+      splitLayout(
+        tags$div(
+          # width = 6,
+          # tags$p("Dark colors"),
+          sliderInput(
+            inputId = "n_dark",
+            label = "Number of dark colors:",
+            min = 1,
+            max = 10,
+            value = 4,
+            width = "90%"
+          ),
+          sliderInput(
+            inputId = "p_dark",
+            label = "Percentage of darkness:",
+            min = 0,
+            max = 100,
+            value = 50,
+            post = "%",
+            width = "90%"
+          ),
+          sliderInput(
+            inputId = "a_dark",
+            label = "Dark hue angle:",
+            min = -360,
+            max = 360,
+            value = -51,
+            post = "\u00b0",
+            width = "90%"
+          ),
+          sliderInput(
+            inputId = "s_dark",
+            label = "Dark colors saturation:",
+            min = -100,
+            max = 100,
+            value = -14,
+            post = "%",
+            width = "90%"
+          )
+        ),
+        tags$div(
+          # width = 6,
+          # tags$p("Light colors"),
+          sliderInput(
+            inputId = "n_light",
+            label = "Number of light colors:",
+            min = 1,
+            max = 10,
+            value = 6,
+            width = "90%"
+          ),
+          sliderInput(
+            inputId = "p_light",
+            label = "Percentage of lightness:",
+            min = 0,
+            max = 100,
+            value = 80,
+            post = "%",
+            width = "90%"
+          ),
+          sliderInput(
+            inputId = "a_light",
+            label = "Light hue angle:",
+            min = -360,
+            max = 360,
+            value = 67,
+            post = "\u00b0",
+            width = "90%"
+          ),
+          sliderInput(
+            inputId = "s_light",
+            label = "Light colors saturation:",
+            min = -100,
+            max = 100,
+            value = 20,
+            post = "%",
+            width = "90%"
+          )
+        )
+      )
+    )
+  )
+
+  server <- function(input, output, session) {
+
+    output$rect_cols <- renderUI({
+      col <- input$main_col
+      colors_rect(colors = c(
+        get_dark_cols(
+          color = col,
+          n = input$n_dark,
+          darkness = input$p_dark / 100,
+          rotate = input$a_dark,
+          saturation = input$s_dark / 100
+        ),
+        col,
+        get_light_cols(
+          color = col,
+          n = input$n_light,
+          lightness = input$p_light / 100,
+          rotate = input$a_light,
+          saturation = input$s_light / 100
+        )
+      ))
+    })
+
+    observeEvent(input$close, stopApp())
+
+  }
+
+  runGadget(app = ui, server = server, viewer = paneViewer(minHeight = 600)) # minHeight = "maximize"
+}
+
+
+
+
diff --git a/R/onLoad.R b/R/onLoad.R
@@ -0,0 +1,8 @@
+#' Adds the content of www to colorscale/
+#'
+#' @importFrom shiny addResourcePath
+#'
+#' @noRd
+.onLoad <- function(...) {
+  shiny::addResourcePath("colorscale", system.file('www', package = "colorscale"))
+}
diff --git a/R/single-colorscale.R b/R/single-colorscale.R
@@ -3,28 +3,27 @@
 #'
 #' @param color Hexadecimal string or a name for color.
 #' @param n Number of desired colors.
+#' @param darkness Percentage of darkness.
 #' @param rotate Rotate coefficient in HSL space.
-#' @param saturation Saturation coefficient in HSL space
+#' @param saturation Saturation percentage in HSL space
 #'
 #' @return a vector of \code{n} colors
 #' @export
 #'
 #' @examples
 #' get_dark_cols("#1D9A6C")
-get_dark_cols <- function(color, n = 4, rotate = -51, saturation = 14) {
+get_dark_cols <- function(color, n = 4, darkness = 0.5, rotate = -51, saturation = 0.14) {
 
   stopifnot(length(color) == 1)
 
-  max_cols <- 50
-
   ch <- chroma$new(color)
 
   hsl.h <- chroma_get(color, "hsl.h")
   hsl.s <- chroma_get(color, "hsl.s")
 
   ch$set(channel = "hsl.h", value = rev(seq_len(n)) / n * -rotate + hsl.h)
-  ch$set(channel = "hsl.s", value = (rev(seq_len(n)) / n * (saturation / 100)) * hsl.s + hsl.s)
-  ch$mix(color2 = "black", ratio = (max_cols / 100) * rev(seq_len(n)) / n)
+  ch$set(channel = "hsl.s", value = (rev(seq_len(n)) / n * saturation) * hsl.s + hsl.s)
+  ch$mix(color2 = "black", ratio = darkness * rev(seq_len(n)) / n)
 
   ch$eval()
 }
@@ -34,28 +33,27 @@ get_dark_cols <- function(color, n = 4, rotate = -51, saturation = 14) {
 #'
 #' @param color Hexadecimal string or a name for color.
 #' @param n Number of desired colors.
+#' @param lightness Percentage of lightness.
 #' @param rotate Rotate coefficient in HSL space.
-#' @param saturation Saturation coefficient in HSL space
+#' @param saturation Saturation percentage in HSL space
 #'
 #' @return a vector of \code{n} colors
 #' @export
 #'
 #' @examples
 #' get_light_cols("#1D9A6C")
-get_light_cols <- function(color, n = 6, rotate = 67, saturation = 20) {
+get_light_cols <- function(color, n = 6, lightness = 0.8, rotate = 67, saturation = 0.20) {
 
   stopifnot(length(color) == 1)
 
-  max_cols <- 80
-
   ch <- chroma$new(color)
 
   hsl.h <- chroma_get(color, "hsl.h")
   hsl.s <- chroma_get(color, "hsl.s")
 
   ch$set(channel = "hsl.h", value = seq_len(n) / n * -rotate + hsl.h)
-  ch$set(channel = "hsl.s", value = (seq_len(n) / n * (saturation / 100)) * hsl.s + hsl.s)
-  ch$mix(color2 = "white", ratio = (max_cols / 100) * seq_len(n) / n)
+  ch$set(channel = "hsl.s", value = (seq_len(n) / n * saturation) * hsl.s + hsl.s)
+  ch$mix(color2 = "white", ratio = lightness * seq_len(n) / n)
 
   ch$eval()
 }

diff --git a/inst/www/styles.css b/inst/www/styles.css
@@ -0,0 +1,58 @@
+
+.dreamrs-title-box {
+  background-color: rgb(16, 34, 70);
+  height: 45px;
+}
+
+.dreamrs-title {
+  color: white;
+  text-align: center;
+  font-size: 30px;
+  font-weight: bold;
+}
+
+
+.form-group {
+  margin-bottom: 0 !important;
+}
+
+
+
+
+/* shiny alerts */
+
+.shiny-notification-error {
+  color: #fff !important;
+  background-color: #d9534f !important;
+  border: 1px solid #d9534f !important;
+}
+
+.shiny-notification-warning {
+  color: #fff !important;
+  background-color: #f39c12 !important;
+  border: 1px solid #f39c12 !important;
+}
+
+.shiny-notification-message {
+  color: #fff !important;
+  background-color: #5cb85c !important;
+  border: 1px solid #5cb85c !important;
+}
+
+.shiny-notification {
+  font-size: 120% !important;
+  font-weight: bold !important;
+}
+
+#shiny-notification-panel {
+  width: 100% !important;
+  text-align: center !important;
+}
+
+.shiny-notification-close {
+  font-size: 26px;
+  color: #fff;
+  cursor: pointer;
+}
+
+
diff --git a/man/color_scale.Rd b/man/color_scale.Rd