shiny/R/timer.R

# Return the current time, in milliseconds from epoch, with
# unspecified time zone.
now <- function() {
  as.numeric(Sys.time()) * 1000
}

TimerCallbacks <- setRefClass(
  'TimerCallbacks',
  fields = list(
    .nextId = 'integer',
    .funcs = 'Map',
    .times = 'data.frame'
  ),
  methods = list(
    initialize = function() {
      .nextId <<- 0L
    },
    schedule = function(millis, func) {
      id <- .nextId
      .nextId <<- .nextId + 1L
      
      t <- now()
      
      # TODO: Horribly inefficient, use a heap instead
      .times <<- rbind(.times, data.frame(time=t+millis,
                                          scheduled=t,
                                          id=id))
      .times <<- .times[order(.times$time),]
      
      .funcs$set(as.character(id), func)
      
      return(id)
    },
    timeToNextEvent = function() {
      if (dim(.times)[1] == 0)
        return(Inf)
      return(.times[1, 'time'] - now())
    },
    takeElapsed = function() {
      t <- now()
      elapsed <- .times$time < now()
      result <- .times[elapsed,]
      .times <<- .times[!elapsed,]
      
      # TODO: Examine scheduled column to check if any funny business
      #       has occurred with the system clock (e.g. if scheduled
      #       is later than now())
      
      return(result)
    },
    executeElapsed = function() {
      elapsed <- takeElapsed()
      if (length(elapsed) == 0)
        return(F)
      
      for (id in elapsed$id) {
        thisFunc <- .funcs$remove(as.character(id))
        # TODO: Catch exception, and...?
        # TODO: Detect NULL, and...?
        thisFunc()
      }
      return(T)
    }
  )
)

timerCallbacks <- TimerCallbacks$new()