R/mod_map.R

Defines functions mod_map_server mod_map_ui

#' Map UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd
mod_map_ui <- function(id) {
  ns <- shiny::NS(id)
  shiny::div(
    style = "calc(100vh - 120px) !important;",
    mapboxer::mapboxerOutput(ns("map"))
  )
}

#' Map Server Functions
#'
#' @noRd
mod_map_server <- function(id, address_and_neighbourhood, search_method, point_layers, aggregate_layers) {
  shiny::moduleServer(id, function(input, output, session) {
    ns <- session$ns

    # Initial map ----
    output$map <- mapboxer::renderMapboxer({
      map_toronto() %>%
        add_blank_amenity_density_layer() %>%
        add_blank_aggregate_layers() %>%
        add_blank_points_layers() %>%
        add_blank_address_layer() %>%
        # Observe zoom-out level, once rendered, to know whether to zoom back out to "city view"
        htmlwidgets::onRender("function() {
      // Send variable that map is loaded in order to trigger tour
      Shiny.onInputChange('mapLoaded', true);

      var map = mapboxer._widget['map-map-map'].map;
      // Get zoom level on zoom out, to know when to reset to city view
      map.on('zoomend', function () {
      var mapZoom = map.getZoom();
      Shiny.onInputChange('mapZoom', mapZoom);
      });

      // disable map rotation using right click + drag
      map.dragRotate.disable();

      // disable map rotation using touch rotation gesture
      map.touchZoomRotate.disableRotation();

      // Highlight / fill neighbourhood on hover

      let hoveredNghdId = null;
      // When the user moves their mouse over the neighbourhood_click layer, we'll update the
      // feature state for the feature under the mouse.
      // Note that the mouse is observed on neighbourhood_click, which is a fill layer, so it's observed when their mouse is inside the neighbourhood
      // But the layer that is actually updated is neighbourhood_hover_line, in order to just update the border of the neighbourhood
      map.on('mousemove', 'neighbourhood_click', (e) => {
        map.getCanvas().style.cursor = 'pointer';
        if (e.features.length > 0) {
          if (hoveredNghdId !== null) {
            map.setFeatureState(
              { source: 'neighbourhoods_data', sourceLayer: 'neighbourhoods-0jaap1', id: hoveredNghdId },
              { hover: false }
            );
          }
        hoveredNghdId = e.features[0].id;
          map.setFeatureState(
            { source: 'neighbourhoods_data', sourceLayer: 'neighbourhoods-0jaap1', id: hoveredNghdId },
            { hover: true }
          );
        }
      });
      // When the mouse leaves the neighbourhood_click layer, update the feature state of the
      // previously hovered feature.
      map.on('mouseleave', 'neighbourhood_click', () => {
        if (hoveredNghdId !== null) {
          map.setFeatureState(
            { source: 'neighbourhoods_data', sourceLayer: 'neighbourhoods-0jaap1', id: hoveredNghdId },
            { hover: false }
          );
        }
        hoveredNghdId = null;
        // Reset the cursor style
        map.getCanvas().style.cursor = '';
      });

        }")
    })

    # Observe clicking on map ----
    # Note that there is not actually an input called "map_onclick" - it comes built in with renderMapboxer
    shiny::observeEvent(
      input$map_onclick,
      {
        current_neighbourhood <- address_and_neighbourhood$neighbourhood
        clicked_neighbourhood <- input$map_onclick$props$neighbourhood

        # Only update anything if the current neighbourhood isn't the same as the clicked neighbourhood - it's annoying to get zoomed back out if you're already there!
        # This probably happens when you're clicking on a POINT in the current neighbourhood

        if (!identical(current_neighbourhood, clicked_neighbourhood) & !is.null(clicked_neighbourhood)) {
          # Clear inputs
          address_and_neighbourhood$address <- NULL
          address_and_neighbourhood$neighbourhood <- NULL

          # Update search method and neighbourhood, let the next observe handle actually updating the map :)
          search_method("neighbourhood")
          address_and_neighbourhood$neighbourhood <- clicked_neighbourhood
        }
      }
    )

    # Update zoom of map and highlighted apartment and/or neighbourhood based on search -----
    shiny::observeEvent(
      {
        search_method()
        address_and_neighbourhood$neighbourhood
      },
      ignoreNULL = FALSE,
      ignoreInit = TRUE,
      {
        if (search_method() == "address") {
          mapboxer::mapboxer_proxy(ns("map")) %>%
            zoom_map_to_address(address_and_neighbourhood$address) %>%
            zoom_map_to_neighbourhood(address_and_neighbourhood$neighbourhood) %>%
            mapboxer::update_mapboxer()
        } else if (search_method() == "neighbourhood") {
          mapboxer::mapboxer_proxy(ns("map")) %>%
            # Clear address
            toggle_layer_invisible("address_points") %>%
            zoom_map_to_neighbourhood(address_and_neighbourhood$neighbourhood) %>%
            mapboxer::update_mapboxer()
        } else if (search_method() == "back") {
          mapboxer::mapboxer_proxy(ns("map")) %>%
            # Clear address
            toggle_layer_invisible("address_points") %>%
            # Clear neighbourhood
            zoom_map_to_neighbourhood("none") %>%
            # Zoom back out to Toronto
            mapboxer::fit_bounds(sf::st_bbox(lemr::toronto), pitch = 0, bearing = bearing) %>%
            mapboxer::update_mapboxer()
        }
      }
    )

    # Update layers -----

    ## Point layers -----
    shiny::observeEvent(
      point_layers(),
      ignoreInit = TRUE,
      ignoreNULL = FALSE,
      priority = 0,
      {
        map <- mapboxer::mapboxer_proxy(ns("map"))

        # Turn selected layers on
        for (l in point_layers()) {
          map <- map %>%
            toggle_layer_visible(l)
        }

        # Turn not-selected layers off
        diff_layers <- setdiff(names(point_layers_choices), point_layers())

        for (l in diff_layers) {
          map <- map %>%
            toggle_layer_invisible(l)
        }

        map %>%
          mapboxer::update_mapboxer()
      }
    )

    ## Aggregate layers -----
    shiny::observeEvent(
      aggregate_layers(),
      ignoreInit = TRUE,
      ignoreNULL = FALSE,
      priority = 0,
      {
        map <- mapboxer::mapboxer_proxy(ns("map"))

        # Turn selected layers on
        for (l in aggregate_layers()) {
          map <- map %>%
            toggle_layer_visible(l)
        }

        # Turn not-selected layers off
        diff_layers <- setdiff(aggregate_layers_choices, aggregate_layers())

        for (l in diff_layers) {
          map <- map %>%
            toggle_layer_invisible(l)
        }

        map %>%
          mapboxer::update_mapboxer()
      }
    )
  })
}

## To be copied in the UI
# mod_map_ui("map")

## To be copied in the server
# mod_map_server("map")
purposeanalytics/lemur documentation built on Dec. 22, 2021, 10:52 a.m.