mirror of
https://github.com/rstudio/shiny.git
synced 2026-04-07 03:00:20 -04:00
0d3aebc077
- Get rid of smooth--it doesn't make sense for our purposes since we always provide step - Don't do any rounding by default (this required changes in jslider) - Switch order of format and locale arguments - Animation should pause automatically when it reaches the end - Default to 1s animation interval - If animation is started when sliders are at the end, restart - Animation button click target ran the width of the slider
110 lines
3.8 KiB
R
110 lines
3.8 KiB
R
hasDecimals <- function(value) {
|
|
truncatedValue <- round(value)
|
|
return (!identical(value, truncatedValue))
|
|
}
|
|
|
|
# Create a new slider control (list of slider input element and the script
|
|
# tag used to configure it). This is a lower level control that should
|
|
# be wrapped in an "input" construct (e.g. sliderInput in bootstrap.R)
|
|
#
|
|
# this is a wrapper for: https://github.com/egorkhmelev/jslider
|
|
# (www/shared/slider contains js, css, and img dependencies)
|
|
slider <- function(inputId, min, max, value, step = NULL, ...,
|
|
round=FALSE, format='#,##0.#####', locale='us',
|
|
ticks=TRUE, animate=FALSE, playButton=NULL,
|
|
pauseButton=NULL, animationInterval=1000) {
|
|
# validate inputId
|
|
inputId <- as.character(inputId)
|
|
if (!is.character(inputId))
|
|
stop("inputId not specified")
|
|
|
|
# validate numeric inputs
|
|
if (!is.numeric(value) || !is.numeric(min) || !is.numeric(max))
|
|
stop("min, max, amd value must all be numeric values")
|
|
else if (min(value) < min)
|
|
stop(paste("slider initial value", value,
|
|
"is less than the specified minimum"))
|
|
else if (max(value) > max)
|
|
stop(paste("slider initial value", value,
|
|
"is greater than the specified maximum"))
|
|
else if (min > max)
|
|
stop(paste("slider maximum is greater than minimum"))
|
|
else if (!is.null(step)) {
|
|
if (!is.numeric(step))
|
|
stop("step is not a numeric value")
|
|
if (step > (max - min))
|
|
stop("step is greater than range")
|
|
}
|
|
|
|
# step
|
|
range <- max - min
|
|
if (is.null(step)) {
|
|
# short range or decimals means continuous decimal
|
|
if (range < 2 || hasDecimals(min) || hasDecimals(max))
|
|
step <- range / 250 # ~ one step per pixel
|
|
else
|
|
step = 1
|
|
}
|
|
|
|
# Default state is to not have ticks
|
|
if (identical(ticks, T)) {
|
|
# Automatic ticks
|
|
tickCount <- (range / step) + 1
|
|
if (tickCount <= 26)
|
|
ticks <- paste(rep('|', floor(tickCount)), collapse=';')
|
|
else {
|
|
ticks <- NULL
|
|
# # This is a smarter auto-tick algorithm, but to be truly useful
|
|
# # we need jslider to be able to space ticks irregularly
|
|
# tickSize <- 10^(floor(log10(range/0.39)))
|
|
# if ((range / tickSize) == floor(range / tickSize)) {
|
|
# ticks <- paste(rep('|', (range / tickSize) + 1), collapse=';')
|
|
# }
|
|
# else {
|
|
# ticks <- NULL
|
|
# }
|
|
}
|
|
}
|
|
else if (is.numeric(ticks) && length(ticks) == 1) {
|
|
# Use n ticks
|
|
ticks <- paste(rep('|', ticks), collapse=';')
|
|
}
|
|
else if (length(ticks) > 1 && (is.numeric(ticks) || is.character(ticks))) {
|
|
# Explicit ticks
|
|
ticks <- paste(ticks, collapse=';')
|
|
}
|
|
else {
|
|
ticks <- NULL
|
|
}
|
|
|
|
# build slider
|
|
sliderFragment <- list(
|
|
tags$head(
|
|
tags$link(rel="stylesheet",
|
|
type="text/css",
|
|
href="shared/slider/css/jquery.slider.min.css"),
|
|
|
|
tags$script(src="shared/slider/js/jquery.slider.min.js")
|
|
),
|
|
tags$input(id=inputId, type="slider",
|
|
name=inputId, value=paste(value, collapse=';'), class="jslider",
|
|
'data-from'=min, 'data-to'=max, 'data-step'=step,
|
|
'data-skin'='plastic', 'data-round'=round, 'data-locale'=locale,
|
|
'data-format'=format, 'data-scale'=ticks,
|
|
'data-smooth'='false',
|
|
'data-animation-interval'=animationInterval),
|
|
tags$script(type="text/javascript",
|
|
paste('jQuery("#', inputId, '").slider();', sep = ''))
|
|
)
|
|
|
|
sliderFragment[[length(sliderFragment)+1]] <-
|
|
tags$div(class='slider-animate-container',
|
|
tags$a(href='#',
|
|
class='slider-animate-button',
|
|
'data-target-id'=inputId,
|
|
tags$span(class='play', playButton),
|
|
tags$span(class='pause', pauseButton)))
|
|
|
|
return(sliderFragment)
|
|
}
|