animated conditional panel

[stla]

Hello,

Thank you for this package.

I did that a long time ago, but I have updated my code with conditionalJS, this is more convenient:

I wanted to propose you a PR but there's a problem: the hide effect is initially shown; how to initially hide the panel completely?

If you are not interested in a PR, perhaps I'll do a package. Cheers.

library(shiny)
library(shinyGizmo)

animateCSS <- function(effect, delay = 0, duration = 500, then = NULL){
  effect <- match.arg(effect, c(
    "bounce",
    "flash",
    "pulse",
    "rubberBand",
    "shakeX",
    "shakeY",
    "headShake",
    "swing",
    "tada",
    "wobble",
    "jello",
    "heartBeat",
    "backInDown",
    "backInLeft",
    "backInRight",
    "backInUp",
    "backOutDown",
    "backOutLeft",
    "backOutRight",
    "backOutUp",
    "bounceIn",
    "bounceInDown",
    "bounceInLeft",
    "bounceInRight",
    "bounceInUp",
    "bounceOut",
    "bounceOutDown",
    "bounceOutLeft",
    "bounceOutRight",
    "bounceOutUp",
    "fadeIn",
    "fadeInDown",
    "fadeInDownBig",
    "fadeInLeft",
    "fadeInLeftBig",
    "fadeInRight",
    "fadeInRightBig",
    "fadeInUp",
    "fadeInUpBig",
    "fadeInTopLeft",
    "fadeInTopRight",
    "fadeInBottomLeft",
    "fadeInBottomRight",
    "fadeOut",
    "fadeOutDown",
    "fadeOutDownBig",
    "fadeOutLeft",
    "fadeOutLeftBig",
    "fadeOutRight",
    "fadeOutRightBig",
    "fadeOutUp",
    "fadeOutUpBig",
    "fadeOutTopLeft",
    "fadeOutTopRight",
    "fadeOutBottomRight",
    "fadeOutBottomLeft",
    "flip",
    "flipInX",
    "flipInY",
    "flipOutX",
    "flipOutY",
    "lightSpeedInRight",
    "lightSpeedInLeft",
    "lightSpeedOutRight",
    "lightSpeedOutLeft",
    "rotateIn",
    "rotateInDownLeft",
    "rotateInDownRight",
    "rotateInUpLeft",
    "rotateInUpRight",
    "rotateOut",
    "rotateOutDownLeft",
    "rotateOutDownRight",
    "rotateOutUpLeft",
    "rotateOutUpRight",
    "hinge",
    "jackInTheBox",
    "rollIn",
    "rollOut",
    "zoomIn",
    "zoomInDown",
    "zoomInLeft",
    "zoomInRight",
    "zoomInUp",
    "zoomOut",
    "zoomOutDown",
    "zoomOutLeft",
    "zoomOutRight",
    "zoomOutUp",
    "slideInDown",
    "slideInLeft",
    "slideInRight",
    "slideInUp",
    "slideOutDown",
    "slideOutLeft",
    "slideOutRight",
    "slideOutUp"
  ))
  js <- paste(
    "    animateCSS('%s', {",
    "      delay: %d,",
    "      duration: %d,",
    "      callback: function(){",
    "        %s",
    "      }",
    "    });",
    sep = "\n"
  )
  sprintf(
    js, effect, delay, duration, 
    ifelse(is.null(then), "", paste0("$this.", then))
  )
}

animatedShow <- function(animation, fadeDuration){
  sprintf(paste(
    "var $this = $(this);",
    "$this.show(%d, function(){",
    "  $this.show().",
    animation,
    "});",
    sep = "\n"
  ), fadeDuration)
}

animatedHide <- function(animation, fadeDuration){
  paste(
    "var $this = $(this);",
    paste0("$this.show()."),
    sub(
      "\\{\n        \n      \\}",
      sprintf("{$this.hide(%d);}", fadeDuration),
      animation
    ),
    sep = "\n"
  )
}

ui <- fluidPage(
  tags$head(
    tags$link(rel = "stylesheet", href = "https://cdnjs.cloudflare.com/ajax/libs/animate.css/4.1.0/animate.compat.min.css"),
    tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/animateCSS/1.2.2/jquery.animatecss.min.js")
  ),
  sidebarPanel(
    actionButton("showplot", "Show/Hide")
  ),
  mainPanel(
    conditionalJS(
      plotOutput("plot"),
      condition = "input.showplot % 2 == 1",
      jsCalls$custom(
        true = animatedShow(
          animateCSS(
            "swing", delay = 0, duration = 2000, then = animateCSS("bounce")
          ),
          fadeDuration = 1000
        ),
        false = animatedHide(
          animateCSS("tada", then = animateCSS("jackInTheBox")), 
          fadeDuration = 1000
        )
      )
    )
  )
)

server <- function(input, output) {
  x <- rnorm(100)
  y <- rnorm(100)

  output$plot <- renderPlot({
    plot(x, y, pch = 19)
  })
}

shinyApp(ui, server)

[krystian8207]

Hi @stla.

The proposed addition to jsCalls seems really great, I'd be really happy to add it to the package. I'll take a look at the "hide issue" as soon as I can, and then we'll think about a proper PR together.

[stla]

Hello,

I've found a way to initially hide. I enclose everything in a div with all children hidden, and on showing the ui, I remove the css which hides the children.

animatedConditionalPanel <- function(
  ui, condition, 
  show, 
  hide = animateCSS("fadeOut", duration = 0), # default: no hide effect
  fadeIn = 0, fadeOut = 0
){
  randomID <- paste0(
    sample(c(letters,LETTERS), 20L, replace = TRUE),
    collapse = ""
  )
  conditionalJS(
    ui = tags$div(
      id = randomID,
      ui,
      tags$style(HTML(sprintf("#%s>* {visibility: hidden;}", randomID)))
    ),
    condition = condition,
    jsCalls$custom(
      true = paste0(
        sprintf("$('#%s>*').css('visibility', 'visible'); ", randomID), 
        animatedShow(
          show,
          fadeDuration = fadeIn
        )),
      false = animatedHide(
        hide, 
        fadeDuration = fadeOut
      )
    )
  )
}

[krystian8207]

The feature was added in version 0.2.2 in #13