set.seed(1)
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE, error = FALSE)
library(htmltools)
library(leaflet)
library(leaflet.extras)
library(dplyr)
library(rtrek)
clrs <- c("#87CEFF", "#C0FF3E", "#FF3030", "#BF3EFF", "#7FFFD4", "#FF1493", "#FFB90F", "#CD6839", "#698B22")
info_colors <- c("rgba(45, 45, 45, 0.9)", "#888888", "#ffffff")
ids <- c("galaxy1", "galaxy2")

eq_popup <- function(x, y){
  logo <- y$avatar[match(y$species, x$species)]
  logo <- paste0("<img src=\"", logo, "\" style=\"float:right;max-height:250px\"/>")
  info <- paste0("<div style=\"width:500px;height:270px;\">", logo, strong("Identification: "), x$loc, "<br/>", 
                 strong("Geopolitical domain: "), x$zone, "<br/>", strong("Primary species: "), x$species,
         "<br/>", strong("Stellar body: "), x$body, "<br/>", strong("Classification: "), x$category, "</div>")
  info
}

pop_opts <- popupOptions(closeButton = FALSE)

label_opts <- list(
  "background-color" = info_colors[1],
  "font-size" = "16px", "font-style" = "bold", "color" = info_colors[3], "border-color" = info_colors[2],
  "border-size" = "10px", "border-radius" = "4px")

img_style <- "position:absolute; top:10px; right:10px; height:100px; width:65px; padding:5px; z-index:500; background-color:rgba(255, 185, 15, 0.75); border-radius: 4px;"
sf_logo <- "C:/github/rtrek/data-raw/images/stlogo-white.png"

Homeworlds

This map highlights key species homeworlds.

id <- ids[1]
tiles <- st_tiles(id)
d <- st_tiles_data(id) %>% mutate(color = clrs) %>% tile_coords(id)
div(style = "position: relative;", img(src = knitr::image_uri(sf_logo), alt = "logo", height = 100, width = 65, style = img_style),
  leaflet(options = leafletOptions(crs = leafletCRS("L.CRS.Simple"), minZoom = 0, maxZoom = 7, attributionControl = FALSE), width = "100%", height = "600px") %>% 
    addTiles(urlTemplate = tiles) %>% setView(108, -75, 2) %>%
    addFullscreenControl() %>% addMiniMap(tiles = tiles, toggleDisplay = TRUE) %>%
    addPulseMarkers(data = d, lng = ~x, lat = ~y, icon = makePulseIcon(heartbeat = 1, color = ~color, iconSize = 16), 
                    popup = eq_popup(d, stSpecies), popupOptions = pop_opts,
                    label = ~loc, labelOptions = labelOptions(style = label_opts))
)

Base map tiles generated from source map Star trek Star Chart by Rob Archer.

Homeworlds 2

Same locations, different coordinate reference system.

id <- ids[2]
tiles <- st_tiles(id)
d <- st_tiles_data(id) %>% mutate(color = clrs) %>% tile_coords(id)
div(style = "position: relative;", img(src = knitr::image_uri(sf_logo), alt = "logo", height = 100, width = 65, style = img_style),
  leaflet(options = leafletOptions(crs = leafletCRS("L.CRS.Simple"), minZoom = 0, maxZoom = 7, attributionControl = FALSE), width = "100%", height = "600px") %>% 
    addTiles(urlTemplate = tiles) %>% setView(71, -60, 3) %>%
    addFullscreenControl() %>% addMiniMap(tiles = tiles, toggleDisplay = TRUE) %>%
    addPulseMarkers(data = d, lng = ~x, lat = ~y, icon = makePulseIcon(heartbeat = 1, color = ~color, iconSize = 16), 
                    popup = eq_popup(d, stSpecies), popupOptions = pop_opts,
                    label = ~loc, labelOptions = labelOptions(style = label_opts))
)

Base map tiles generated from source map AST MAP.



leonawicz/rtrek documentation built on Sept. 18, 2023, 11:29 p.m.