Calendar: color properties of calendar objects

[SaschaKrenek]

Thanks for this nice R package of TOAST UI,
I just want to make a simple interactive lab equipment booking calendar, where different lab items should have different colors showing in the calendar. However, while defining the cal_props function gives me the drop down menu of the items, they aren't displayed in the defined color in the calendar. Do I miss something here or is there an issue?

library(shiny)
library(toastui)


ui <- fluidPage(  
  titlePanel("Lab Booking Calendar"),
  tabsetPanel(
    tabPanel("Lab 1",
             calendarOutput("lab1")
    ),
    tabPanel("Lab 2",
             calendarOutput("lab2")
    )
  )
)


server <- function(input, output, session) {
  
  output$lab1 <- renderCalendar({
    calendar(
      isReadOnly = F,
      defaultDate = Sys.Date(),
      view = "week",
      navigation = T,
      navOpts =  navigation_options(today_label = "heute", fmt_date = "DD.MM.YYYY", sep_date = " - "),
      useDetailPopup = T,
      useCreationPopup = T
    ) %>%
      cal_week_options(startDayOfWeek = 1, 
                       daynames = c("So","Mo","Di","Mi","Do","Fr"),
                       workweek = T,
                       hourStart = 6,
                       hourEnd = 20) %>%
      cal_props(
        list(
        id = 1,
        name = "Bench",
        color = "white",
        bgColor = "steelblue",
        borderColor = "steelblue"
      ),
      list(
        id = 2,
        name = "PCR-Hood",
        color = "white",
        bgColor = "forestgreen",
        borderColor = "forestgreen"
      )
      )
  })
  
  output$lab2 <- renderCalendar({
    calendar(
      isReadOnly = F,
      defaultDate = Sys.Date(),
      view = "week",
      navigation = T,
      navOpts =  navigation_options(today_label = "heute", prev_label = "Woche zurück", next_label = "Woche vor", fmt_date = "DD.MM.YYYY", sep_date = " - "),
      useDetailPopup = T,
      useCreationPopup = T
    ) %>%
      cal_week_options(startDayOfWeek = 1, 
                       daynames = c("So","Mo","Di","Mi","Do","Fr"),
                       workweek = T,
                       hourStart = 6,
                       hourEnd = 20) %>%
      cal_props(
        list(
          id = 3,
          name = "PCR-Cycler 1",
          color = "white",
          bgColor = "steelblue",
          borderColor = "steelblue"
        ),
        list(
          id = 4,
          name = "PCR-Cycler 2",
          color = "white",
          bgColor = "forestgreen",
          borderColor = "forestgreen"
        )
      )
  })
  
  observeEvent(input$lab1_add, {
    str(input$lab1_add)
    cal_proxy_add("lab1", input$lab1_add)
  })    
  observeEvent(input$lab1_update, {
    str(input$lab1_update)
    cal_proxy_update("lab1", input$lab1_update)
  })   
  observeEvent(input$lab1_delete, {
    str(input$lab1_delete)
    cal_proxy_delete("lab1", input$lab1_delete)
  })
  observeEvent(input$lab2_add, {
    str(input$lab2_add)
    cal_proxy_add("lab2", input$lab2_add)
  })    
  observeEvent(input$lab2_update, {
    str(input$lab2_update)
    cal_proxy_update("lab2", input$lab2_update)
  })   
  observeEvent(input$lab2_delete, {
    str(input$lab2_delete)
    cal_proxy_delete("lab2", input$lab2_delete)
  })
}

shinyApp(ui = ui, server = server)

[pvictor]

Hello,
Indeed cal_props() example is outdated, correct syntax is :

calendar(cal_demo_data()[, -c(9, 10, 11)]) %>%
  cal_props(
    list(
      id = "1",
      name = "PERSO",
      color = "lightblue",
      backgroundColor = "purple",
      borderColor = "magenta"
    ),
    list(
      id = "2",
      name = "WORK",
      color = "red",
      backgroundColor = "yellow",
      borderColor = "orange"
    )
  )

in your app, this should work:

library(shiny)
library(toastui)


ui <- fluidPage(  
  titlePanel("Lab Booking Calendar"),
  tabsetPanel(
    tabPanel(
      "Lab 1",
      calendarOutput("lab1")
    ),
    tabPanel(
      "Lab 2",
      calendarOutput("lab2")
    )
  )
)


server <- function(input, output, session) {
  
  output$lab1 <- renderCalendar({
    calendar(
      isReadOnly = FALSE,
      defaultDate = Sys.Date(),
      view = "week",
      navigation = TRUE,
      navOpts =  navigation_options(
        today_label = "heute",
        fmt_date = "DD.MM.YYYY", 
        sep_date = " - "
      ),
      useDetailPopup = TRUE,
      useCreationPopup = TRUE
    ) %>%
      cal_week_options(
        startDayOfWeek = 1, 
        daynames = c("So","Mo","Di","Mi","Do","Fr"),
        workweek = TRUE,
        hourStart = 6,
        hourEnd = 20
      ) %>%
      cal_props(
        list(
          id = "1",
          name = "Bench",
          color = "blue",
          backgroundColor = "yellow",
          borderColor = "red"
        ),
        list(
          id = "2",
          name = "PCR-Hood",
          color = "white",
          backgroundColor = "purple",
          borderColor = "orange"
        )
      )
  })
  
  output$lab2 <- renderCalendar({
    calendar(
      isReadOnly = FALSE,
      defaultDate = Sys.Date(),
      view = "week",
      navigation = TRUE,
      navOpts =  navigation_options(
        today_label = "heute",
        prev_label = "Woche zurück", 
        next_label = "Woche vor", 
        fmt_date = "DD.MM.YYYY",
        sep_date = " - "
      ),
      useDetailPopup = TRUE,
      useCreationPopup = TRUE
    ) %>%
      cal_week_options(
        startDayOfWeek = 1, 
        daynames = c("So","Mo","Di","Mi","Do","Fr"),
        workweek = TRUE,
        hourStart = 6,
        hourEnd = 20
      ) %>%
      cal_props(
        list(
          id = "3",
          name = "PCR-Cycler 1",
          color = "blue",
          backgroundColor = "yellow",
          borderColor = "red"
        ),
        list(
          id = "4",
          name = "PCR-Cycler 2",
          color = "white",
          backgroundColor = "purple",
          borderColor = "orange"
        )
      )
  })
  
  observeEvent(input$lab1_add, {
    str(input$lab1_add)
    cal_proxy_add("lab1", input$lab1_add)
  })    
  observeEvent(input$lab1_update, {
    str(input$lab1_update)
    cal_proxy_update("lab1", input$lab1_update)
  })   
  observeEvent(input$lab1_delete, {
    str(input$lab1_delete)
    cal_proxy_delete("lab1", input$lab1_delete)
  })
  observeEvent(input$lab2_add, {
    str(input$lab2_add)
    cal_proxy_add("lab2", input$lab2_add)
  })    
  observeEvent(input$lab2_update, {
    str(input$lab2_update)
    cal_proxy_update("lab2", input$lab2_update)
  })   
  observeEvent(input$lab2_delete, {
    str(input$lab2_delete)
    cal_proxy_delete("lab2", input$lab2_delete)
  })
}

shinyApp(ui = ui, server = server)