New layout accordion + plot dims

DESCRIPTION

@@ -21,6 +21,7 @@ Roxygen: list(markdown = TRUE)
 Imports: 
     bslib,
     datamods (>= 1.4.0),
+    downlit,
     ggplot2 (>= 3.0.0),
     grDevices,
     htmltools (>= 0.5.0),

NAMESPACE

@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+export(bs_theme_esquisse)
 export(build_aes)
 export(chooseDataServer)
 export(chooseDataUI)
@@ -38,8 +39,14 @@ export(updateDropInput)
 export(updatePalettePicker)
 export(which_pal_scale)
 import(ggplot2)
+importFrom(bslib,accordion)
+importFrom(bslib,accordion_panel)
 importFrom(bslib,bs_add_rules)
 importFrom(bslib,bs_theme)
+importFrom(bslib,layout_sidebar)
+importFrom(bslib,nav_panel)
+importFrom(bslib,navset_pill)
+importFrom(bslib,sidebar)
 importFrom(datamods,filter_data_server)
 importFrom(datamods,filter_data_ui)
 importFrom(datamods,i18n)
@@ -111,6 +118,7 @@ importFrom(rlang,call2)
 importFrom(rlang,eval_tidy)
 importFrom(rlang,expr)
 importFrom(rlang,has_length)
+importFrom(rlang,have_name)
 importFrom(rlang,is_call)
 importFrom(rlang,is_list)
 importFrom(rlang,is_named)

R/default-options.R

@@ -113,7 +113,7 @@ default_themes <- function() {
 
   if (requireNamespace("hrbrthemes", quietly = TRUE)) {
     hrbrthemes <- c(
-      "ft_rc", "ipsum", "ipsum_ps", "ipsum_rc", "ipsum_tw", "modern_rc"
+      "ft_rc", "ipsum", "ipsum_ps", "ipsum_rc", "modern_rc"
     )
     hrbrthemes <- setNames(as.list(paste0("hrbrthemes::theme_", hrbrthemes)), hrbrthemes)
     themes$hrbrthemes <- hrbrthemes

R/esquisse-server.R

@@ -47,7 +47,6 @@ esquisse_server <- function(id,
         showModal(modal_settings(aesthetics = input$aesthetics))
       })
 
-
       if (is.reactivevalues(data_rv)) {
         observeEvent(data_rv$data, {
           data_chart$data <- data_rv$data
@@ -104,52 +103,19 @@ esquisse_server <- function(id,
       # show data if button clicked
       show_data_server("show_data", reactive(controls_rv$data))
 
-      # special case: geom_sf
-      observeEvent(data_chart$data, {
-        if (inherits(data_chart$data, what = "sf")) {
-          geom_rv$possible <- c("sf", geom_rv$possible)
-        }
-      })
+
 
-      # Aesthetic selector
-      aes_r <- select_aes_server(
-        id = "aes",
-        data_r = reactive(data_chart$data),
-        default_aes = default_aes,
-        input_aes = reactive(input$aesthetics)
+
+      res_geom_aes_r <- select_geom_aes_server(
+        id = "geomaes", 
+        data_r = reactive(data_chart$data)
       )
-
-
-      observeEvent(list(aes_r(), input$geom), {
-        geoms <- potential_geoms(
-          data = data_chart$data,
-          mapping = build_aes(
-            data = data_chart$data,
-            x = aes_r()$xvar,
-            y = aes_r()$yvar
-          )
-        )
-        geom_rv$possible <- c("auto", geoms)
-
-        geom_rv$controls <- select_geom_controls(input$geom, geoms)
-
-        if (!is.null(aes_r()$fill) | !is.null(aes_r()$color)) {
-          geom_rv$palette <- TRUE
-        } else {
-          geom_rv$palette <- FALSE
-        }
-      }, ignoreInit = TRUE)
-
-      observeEvent(geom_rv$possible, {
-        geoms <- geomIcons()$values
-        updateDropInput(
-          session = session,
-          inputId = "geom",
-          selected = setdiff(geom_rv$possible, "auto")[1],
-          disabled = setdiff(geoms, geom_rv$possible)
-        )
+      aes_r <- reactive(res_geom_aes_r()$aes_1)
+      observeEvent(res_geom_aes_r()$geom_1, {
+        geom_rv$controls <- res_geom_aes_r()$geom_1
       })
 
+
       # Module chart controls : title, xlabs, colors, export...
       # paramsChart <- reactiveValues(inputs = NULL)
       controls_rv <- controls_server(
@@ -186,16 +152,18 @@ esquisse_server <- function(id,
             y = "continuous"
           )
         }),
+        width = reactive(rv_render_ggplot$plot_width),
+        height = reactive(rv_render_ggplot$plot_height),
         drop_ids = drop_ids
       )
 
 
-      render_ggplot("plooooooot", {
+      rv_render_ggplot <- render_ggplot("plooooooot", {
         req(input$play_plot, cancelOutput = TRUE)
         req(data_chart$data)
         req(controls_rv$data)
         req(controls_rv$inputs)
-        req(input$geom)
+        geom_ <- req(res_geom_aes_r()$geom_1)
 
         aes_input <- make_aes(aes_r())
 
@@ -204,14 +172,14 @@ esquisse_server <- function(id,
         mapping <- build_aes(
           data = data_chart$data,
           .list = aes_input,
-          geom = input$geom
+          geom = geom_
         )
 
         geoms <- potential_geoms(
           data = data_chart$data,
           mapping = mapping
         )
-        req(input$geom %in% geoms)
+        req(geom_ %in% geoms)
 
         data <- controls_rv$data
 
@@ -222,38 +190,42 @@ esquisse_server <- function(id,
           reverse = controls_rv$colors$reverse
         )
 
-        if (identical(input$geom, "auto")) {
+        if (identical(geom_, "auto")) {
           geom <- "blank"
         } else {
-          geom <- input$geom
+          geom <- geom_
         }
 
-        geom_args <- match_geom_args(input$geom, controls_rv$inputs, mapping = mapping)
+        geom_args <- match_geom_args(
+          geom_, 
+          controls_rv$inputs,
+          mapping = mapping,
+          add_mapping = FALSE
+        )
 
-        if (isTRUE(controls_rv$smooth$add) & input$geom %in% c("point", "line")) {
+        if (isTRUE(controls_rv$smooth$add) & geom_ %in% c("point", "line")) {
           geom <- c(geom, "smooth")
           geom_args <- c(
-            setNames(list(geom_args), input$geom),
+            setNames(list(geom_args), geom_),
             list(smooth = controls_rv$smooth$args)
           )
         }
-        if (isTRUE(controls_rv$jitter$add) & input$geom %in% c("boxplot", "violin")) {
+        if (isTRUE(controls_rv$jitter$add) & geom_ %in% c("boxplot", "violin")) {
           geom <- c(geom, "jitter")
           geom_args <- c(
-            setNames(list(geom_args), input$geom),
+            setNames(list(geom_args), geom_),
             list(jitter = controls_rv$jitter$args)
           )
-
         }
-        if (!is.null(aes_input$ymin) & !is.null(aes_input$ymax) & input$geom %in% c("line")) {
+        if (!is.null(aes_input$ymin) & !is.null(aes_input$ymax) & geom_ %in% c("line")) {
           geom <- c("ribbon", geom)
           mapping_ribbon <- aes_input[c("ymin", "ymax")]
           geom_args <- c(
             list(ribbon = list(
               mapping = expr(aes(!!!syms2(mapping_ribbon))),
               fill = controls_rv$inputs$color_ribbon
             )),
-            setNames(list(geom_args), input$geom)
+            setNames(list(geom_args), geom_)
           )
           mapping$ymin <- NULL
           mapping$ymax <- NULL
@@ -272,15 +244,11 @@ esquisse_server <- function(id,
           scales_args <- c(scales_args, list(y_continuous = controls_rv$transY$args))
         }
 
-        if (isTRUE(controls_rv$limits$x)) {
-          xlim <- controls_rv$limits$xlim
-        } else {
-          xlim <- NULL
+        xlim <- if (isTRUE(controls_rv$limits$x)) {
+           controls_rv$limits$xlim
         }
-        if (isTRUE(controls_rv$limits$y)) {
-          ylim <- controls_rv$limits$ylim
-        } else {
-          ylim <- NULL
+        ylim <- if (isTRUE(controls_rv$limits$y)) {
+          controls_rv$limits$ylim
         }
         data_name <- data_chart$name %||% "data"
         gg_call <- ggcall(
@@ -311,7 +279,7 @@ esquisse_server <- function(id,
           show_notification = notify_warnings %||% input$notify_warnings  %||% "once"
         )
         ggplotCall$ggobj$plot
-      }, filename = "esquisse-plot")
+      }, filename = "esquisse-plot", width = reactive(controls_rv$width), height = reactive(controls_rv$height))
 
 
       # Close addin

R/esquisse-ui.R

@@ -15,6 +15,7 @@
 #' @param insert_code Logical, Display or not a button to insert the ggplot
 #'  code in the current user script (work only in RStudio).
 #' @param play_pause Display or not the play / pause button.
+#' @param layout_sidebar Put controls in a sidebar on the left rather than below the chart in dropdowns.
 #' @param downloads Export options available or `NULL` for no export. See [downloads_labels()].
 #'
 #' @return A `reactiveValues` with 3 slots :
@@ -33,6 +34,7 @@
 #' @importFrom shinyWidgets prettyToggle
 #' @importFrom rlang is_list
 #' @importFrom utils modifyList
+#' @importFrom bslib layout_sidebar sidebar
 #'
 #' @example examples/esquisse-module-1.R
 #'
@@ -45,6 +47,7 @@ esquisse_ui <- function(id,
                         controls = c("labs", "parameters", "appearance", "filters", "code"),
                         insert_code = FALSE,
                         play_pause = TRUE,
+                        layout_sidebar = FALSE,
                         downloads = downloads_labels()) {
   ns <- NS(id)
   header_btns <- list(settings = TRUE, close = TRUE, import = TRUE, show_data = TRUE)
@@ -95,40 +98,69 @@ esquisse_ui <- function(id,
 
     if (isTRUE(header)) tag_header,
 
-    tags$div(
-      class = "esquisse-geom-aes",
-      tags$div(
-        style = "padding: 3px 3px 0 3px; height: 144px;",
-        dropInput(
-          inputId = ns("geom"),
-          choicesNames = geomIcons()$names,
-          choicesValues = geomIcons()$values,
-          dropWidth = "292px",
-          width = "100%"
-        )
-      ),
-      select_aes_ui(ns("aes"))
-    ),
+    if (!isTRUE(layout_sidebar)) {
+      tagList(
+        select_geom_aes_ui(ns("geomaes")),
 
-    fillCol(
-      style = "overflow-y: auto;",
-      tags$div(
-        style = "height: 100%; min-height: 400px; overflow: hidden;",
-        play_pause_input(ns("play_plot"), show = play_pause),
-        ggplot_output(
-          id = ns("plooooooot"),
-          width = "100%",
-          height = "100%",
+        fillCol(
+          style = "overflow-y: auto;",
+          tags$div(
+            style = "height: 100%; min-height: 400px; overflow: auto;",
+            play_pause_input(ns("play_plot"), show = play_pause),
+            ggplot_output(
+              id = ns("plooooooot"),
+              width = "100%",
+              height = "100%",
+              downloads = if ("export" %in% controls) NULL else downloads
+            )
+          )
+        ),
+
+        controls_ui(
+          id = ns("controls"),
+          insert_code = insert_code,
+          controls = controls,
           downloads = downloads
         )
       )
-    ),
+    } else {
+      bslib::layout_sidebar(
+        padding = 0,
+        fillable = FALSE,
+        fill = FALSE,
+        height = "100%",
+        sidebar = bslib::sidebar(
+          position = "right",
+          # open = "always",
+          title = "CONTROLS",
+          width = 350,
+          controls_ui(
+            id = ns("controls"),
+            insert_code = insert_code,
+            controls = controls,
+            layout = "accordion",
+            downloads = downloads
+          )
+        ),
+        select_geom_aes_ui(ns("geomaes")),
 
-    controls_ui(
-      id = ns("controls"),
-      insert_code = insert_code,
-      controls = controls
-    )
+        tags$div(
+          style = css(
+            height = "calc(100% - 165px)",
+            minHeight = "400px",
+            overflow = "auto",
+            position = "relative"
+          ),
+          play_pause_input(ns("play_plot"), show = play_pause),
+          ggplot_output(
+            id = ns("plooooooot"),
+            width = "100%",
+            height = "100%",
+            downloads = if ("export" %in% controls) NULL else downloads
+          )
+        )
+      )
+    }
   )
 
   if (is.function(container)) {