From 3f6809f6ee9f9f1432d055e745d79221fd19abd2 Mon Sep 17 00:00:00 2001 From: pvictor Date: Tue, 12 Mar 2024 06:29:03 +0100 Subject: [PATCH] simplify toggleDisplay --- R/module-controls-appearance.R | 6 +++--- R/module-controls-labs.R | 30 +++++++++++++++--------------- R/module-controls-params.R | 20 ++++++++++---------- R/utils-shiny.R | 7 ++++--- 4 files changed, 32 insertions(+), 31 deletions(-) diff --git a/R/module-controls-appearance.R b/R/module-controls-appearance.R index a05efbfd..6ea44cad 100644 --- a/R/module-controls-appearance.R +++ b/R/module-controls-appearance.R @@ -138,14 +138,14 @@ controls_appearance_server <- function(id, ns <- session$ns observeEvent(type$palette, { - toggleDisplay(id = ns("controls-palette"), display = isTRUE(type$palette)) - toggleDisplay(id = ns("controls-fill-color"), display = !isTRUE(type$palette)) + toggleDisplay("controls-palette", display = isTRUE(type$palette)) + toggleDisplay("controls-fill-color", display = !isTRUE(type$palette)) }) observe({ req(aesthetics()) aesthetics <- names(aesthetics()) - toggleDisplay(id = ns("controls-shape"), display = type$controls %in% "point" & !"shape" %in% aesthetics) + toggleDisplay("controls-shape", display = type$controls %in% "point" & !"shape" %in% aesthetics) }) inputs_r <- reactive({ diff --git a/R/module-controls-labs.R b/R/module-controls-labs.R index d0d3f87d..a9a3025e 100644 --- a/R/module-controls-labs.R +++ b/R/module-controls-labs.R @@ -65,15 +65,15 @@ controls_labs_ui <- function(id) { } -controls_labs_server <- function(id, - data_table = reactive(NULL), +controls_labs_server <- function(id, + data_table = reactive(NULL), aesthetics = reactive(NULL)) { moduleServer( id = id, function(input, output, session) { - + ns <- session$ns - + # Reset labs ---- observeEvent(data_table(), { updateTextInput(session = session, inputId = "labs_title", value = character(0)) @@ -86,18 +86,18 @@ controls_labs_server <- function(id, updateTextInput(session = session, inputId = "labs_size", value = character(0)) updateTextInput(session = session, inputId = "labs_shape", value = character(0)) }) - + # display specific control according to aesthetics set observeEvent(aesthetics(), { aesthetics <- names(aesthetics()) - toggleDisplay(id = ns("controls-labs-fill"), display = "fill" %in% aesthetics) - toggleDisplay(id = ns("controls-labs-color"), display = "color" %in% aesthetics) - toggleDisplay(id = ns("controls-labs-size"), display = "size" %in% aesthetics) - toggleDisplay(id = ns("controls-labs-shape"), display = "shape" %in% aesthetics) - toggleDisplay(id = ns("controls-ribbon-color"), display = "ymin" %in% aesthetics) + toggleDisplay("controls-labs-fill", display = "fill" %in% aesthetics) + toggleDisplay("controls-labs-color", display = "color" %in% aesthetics) + toggleDisplay("controls-labs-size", display = "size" %in% aesthetics) + toggleDisplay("controls-labs-shape", display = "shape" %in% aesthetics) + toggleDisplay("controls-ribbon-color", display = "ymin" %in% aesthetics) }) - - + + # labs input labs_r <- debounce(reactive({ asth <- names(aesthetics()) @@ -117,8 +117,8 @@ controls_labs_server <- function(id, shape = labs_shape %empty% NULL ) }), millis = 1000) - - + + theme_r <- reactive({ inputs <- reactiveValuesToList(input) list( @@ -129,7 +129,7 @@ controls_labs_server <- function(id, y = get_labs_options(inputs, "y") ) }) - + return(list(labs = labs_r, theme = theme_r)) } ) diff --git a/R/module-controls-params.R b/R/module-controls-params.R index b1a05748..b0ce26db 100644 --- a/R/module-controls-params.R +++ b/R/module-controls-params.R @@ -214,27 +214,27 @@ controls_parameters_server <- function(id, ns <- session$ns observeEvent(use_facet(), { - toggleDisplay(id = ns("controls-facet"), display = isTRUE(use_facet())) + toggleDisplay("controls-facet", display = isTRUE(use_facet())) }) observeEvent(use_transX(), { - toggleDisplay(id = ns("controls-scale-trans-x"), display = isTRUE(use_transX())) + toggleDisplay("controls-scale-trans-x", display = isTRUE(use_transX())) }) observeEvent(use_transY(), { - toggleDisplay(id = ns("controls-scale-trans-y"), display = isTRUE(use_transY())) + toggleDisplay("controls-scale-trans-y", display = isTRUE(use_transY())) }) observeEvent(type$controls, { - toggleDisplay(id = ns("controls-position"), display = type$controls %in% c("bar", "line", "area", "histogram")) - toggleDisplay(id = ns("controls-histogram"), display = type$controls %in% "histogram") - toggleDisplay(id = ns("controls-density"), display = type$controls %in% c("density", "violin")) - toggleDisplay(id = ns("controls-scatter"), display = type$controls %in% "point") - toggleDisplay(id = ns("controls-size"), display = type$controls %in% c("point", "line", "step", "sf")) - toggleDisplay(id = ns("controls-violin"), display = type$controls %in% "violin") - toggleDisplay(id = ns("controls-jitter"), display = type$controls %in% c("boxplot", "violin")) + toggleDisplay("controls-position", display = type$controls %in% c("bar", "line", "area", "histogram")) + toggleDisplay("controls-histogram", display = type$controls %in% "histogram") + toggleDisplay("controls-density", display = type$controls %in% c("density", "violin")) + toggleDisplay("controls-scatter", display = type$controls %in% "point") + toggleDisplay("controls-size", display = type$controls %in% c("point", "line", "step", "sf")) + toggleDisplay("controls-violin", display = type$controls %in% "violin") + toggleDisplay("controls-jitter", display = type$controls %in% c("boxplot", "violin")) if (type$controls %in% c("point")) { updateSliderInput(session = session, inputId = "size", value = 1.5) diff --git a/R/utils-shiny.R b/R/utils-shiny.R index 899dbdc5..e13d9ef8 100644 --- a/R/utils-shiny.R +++ b/R/utils-shiny.R @@ -72,7 +72,7 @@ toggleDisplay <- function(id, } session$sendCustomMessage( type = "toggleDisplay", - message = list(id = id, display = display) + message = list(id = session$ns(id), display = display) ) } @@ -86,7 +86,8 @@ toggleDisplay <- function(id, #' @param session shiny session. #' #' @noRd -toggleBtn <- function(inputId, type = "disable", +toggleBtn <- function(inputId, + type = "disable", session = shiny::getDefaultReactiveDomain()) { session$sendCustomMessage( type = "togglewidget", @@ -175,7 +176,7 @@ resize <- function(id, with_moveable = TRUE, session = shiny::getDefaultReactiveDomain()) { session$sendCustomMessage( - if (isTRUE(with_moveable)) paste0("resize-", id) else "esquisse-resize-plot", + if (isTRUE(with_moveable)) paste0("resize-", id) else "esquisse-resize-plot", list( id = id, width = width,