custom geoms in multiple geom mode

dreamRs · Apr 5, 2024 · 1b2a04a · 1b2a04a
1 parent 99a2014
commit 1b2a04a
Show file tree

Hide file tree

Showing 3 changed files with 29 additions and 8 deletions.
diff --git a/R/geometries.R b/R/geometries.R
@@ -257,6 +257,7 @@ geomIcons <- function(geoms = NULL) {
   if (is.null(geoms))
     geoms <- defaults
   geoms <- match.arg(geoms, defaults, several.ok = TRUE)
+  geoms <- unique(c("auto", geoms))
   href <- "esquisse/geomIcon/gg-%s.png"
   geomsChoices <- lapply(
     X = geoms,

diff --git a/R/module-select-geom-aes.R b/R/module-select-geom-aes.R
@@ -2,7 +2,16 @@
 #' @importFrom shiny NS
 #' @importFrom bslib nav_panel navset_pill
 #' @importFrom htmltools tags tagList
-select_geom_aes_ui <- function(id, n_geoms = 1) {
+select_geom_aes_ui <- function(id, n_geoms = 1, list_geoms = NULL) {
+
+  if (is.null(list_geoms)) {
+    list_geoms <- rep_len(list(geomIcons()), n_geoms)
+  }
+
+  if (!is_list(list_geoms)) {
+    list_geoms <- rep_len(list(list_geoms), n_geoms)
+  }
+
   ns <- NS(id)
   if (n_geoms == 1) {
     tags$div(
@@ -11,8 +20,8 @@ select_geom_aes_ui <- function(id, n_geoms = 1) {
         style = "padding: 3px 3px 0 3px; height: 122px;",
         dropInput(
           inputId = ns("geom_1"),
-          choicesNames = geomIcons()$names,
-          choicesValues = geomIcons()$values,
+          choicesNames = list_geoms[[1]]$names,
+          choicesValues = list_geoms[[1]]$values,
           dropWidth = "292px",
           width = "100%"
         )
@@ -31,8 +40,8 @@ select_geom_aes_ui <- function(id, n_geoms = 1) {
               style = "padding: 3px 3px 0 3px; height: 122px;",
               dropInput(
                 inputId = ns(paste0("geom_", i)),
-                choicesNames = geomIcons()$names,
-                choicesValues = geomIcons()$values,
+                choicesNames = list_geoms[[i]]$names,
+                choicesValues = list_geoms[[i]]$values,
                 dropWidth = "292px",
                 width = "100%"
               )

diff --git a/examples/select-geom-aes.R b/examples/select-geom-aes.R
@@ -8,16 +8,27 @@ ui <- fluidPage(
   theme = bs_theme_esquisse(),
   html_dependency_esquisse(),
   tags$h2("Select geom & aes"),
-  select_geom_aes_ui("myid"),
+  # select_geom_aes_ui("myid", n_geoms = 1),
+  select_geom_aes_ui(
+    "myid",
+    n_geoms = 4,
+    list_geoms = list(
+      geomIcons(),
+      geomIcons(c("line", "step", "jitter", "smooth")),
+      geomIcons(c("line", "step", "jitter", "smooth")),
+      geomIcons(c("line", "step", "jitter", "smooth"))
+    )
+  ),
   verbatimTextOutput("result")
 )
 
 server <- function(input, output, session) {
 
   res_r <- select_geom_aes_server(
     id = "myid",
-    # data_r = reactive(palmerpenguins::penguins)
-    data_r = reactive(apexcharter::temperatures)
+    n_geoms = 4,
+    data_r = reactive(palmerpenguins::penguins)
+    # data_r = reactive(apexcharter::temperatures)
   )
   output$result <- renderPrint(str(res_r()))