In UCANR-IGIS/uasimg: Drone Image Utilities

```{css echo=FALSE} h1.title { font-size: 32px; font-weight: 700; font-family: 'Open Sans', 'Helvetica Neue', Helvetica, Arial, sans-serif; } h3 { font-weight: 700; color: Navy; margin-bottom: 0.2 em; } p.compact { margin-bottom: 0; } p.toc_desc { padding-bottom: 0.5em; border-bottom: 1px solid gray; margin-bottom: 1em; font-style: italic; }

```r
knitr::opts_chunk$set(echo = TRUE)
library(htmltools)
library(leaflet)
library(base64enc)
library(xml2) 
library(knitr)
library(base64enc)

## Updated to return "" if target and base are identical
make_path_relative <- function(base, target) {
  base <- tolower(gsub("\\\\", "/", base))
  target <- tolower(gsub("\\\\", "/", target))
  if (base == target) {
    ""
  } else if (substr(base, 1, 1) == substr(target, 1, 1)) {
    common <- sub('^([^|]*)[^|]*(?:\\|\\1[^|]*)$', '^\\1/?', paste0(base, '|', target))
    paste0(gsub("/$", "", paste0(gsub('[^/]+/?', '../', sub(common, '', base)),
                                 sub(common, '', target))), "/")
  } else {
    ## warning("Resources are on different. Links may not work.")
    paste0(target, "/")
  }
}

# make_path_relative <- function(base, target) {
#   base <- tolower(gsub("\\\\", "/", base))
#   target <- tolower(gsub("\\\\", "/", target))
#   if (substr(base, 1, 1) == substr(target, 1, 1)) {
#     common <- sub('^([^|]*)[^|]*(?:\\|\\1[^|]*)$', '^\\1/?', paste0(base, '|', target))
#     paste0(gsub("/$", "", paste0(gsub('[^/]+/?', '../', sub(common, '', base)),
#            sub(common, '', target))), "/")
#   } else {
#     ## warning("Resources are on different. Links may not work.")
#     paste0(target, "/")
#   }
# }

## Print the subtitle
if (!is.null(params$toc_desc)) {
  print(p(params$toc_desc, class="toc_desc"))
}

## Parse data

## i_lst will hold lists, each list representing properties of one of the HTML files
i_lst <- list()

## Create a NULL object to store the sf objects
mcp_all_sf <- NULL

## Define some constants
span_ids <- c("name_use", "description", "contact", "pilot", "num_img", "size_mb", "camera_name")
meta_tags <- c("map_fn", "date_flown", "area_m2")

for (i in 1:length(params$html_reports)) {
  i_lst[[i]] <- list()
  i_lst[[i]]$html_full <- params$html_reports[i]

  ## Injest the HTML page
  #  html_tree <- XML::htmlTreeParse(readLines(i_lst[[i]]$html_full), useInternalNodes = TRUE)
  html_root <- read_html(i_lst[[i]]$html_full)

  ## Initialize a list to hold the metadata
  i_lst[[i]]$imgcol <- list()

  ## Grab content encoded in spans
  for (j in 1:length(span_ids)) {
    span_txt <- html_root %>%
      xml_find_first(paste0("//span[@id='", span_ids[j], "']")) %>%
      xml_text() %>%
      trimws()
    if (!is.na(span_txt)) {
      i_lst[[i]]$imgcol[[span_ids[j]]] <- span_txt
    }


  }

  ## Grab content encoded in meta tags
  for (j in 1:length(meta_tags)) {
    metatag_content <- html_root %>%
      xml_find_first(paste0("//meta[@name='", meta_tags[j], "']")) %>%
      xml_attr("content") %>%
      trimws()
    if (!is.na(metatag_content)) {
      i_lst[[i]]$imgcol[[meta_tags[j]]] <- metatag_content
    }
  }

  ## Extract the mcp_b64 character
  mcp_b64_txt <- html_root %>%
      xml_find_first(paste0("//meta[@name='mcp_b64']")) %>%
      xml_attr("content") %>%
      trimws()

  ## Convert the mcp_b64 character back to sf
  if (!is.na(mcp_b64_txt)) {
    mcp_sf <- base64decode(mcp_b64_txt) %>% unserialize() %>% st_transform(4326)
    mcp_all_sf <- rbind(mcp_all_sf, mcp_sf)
  }

}

if ((params$fltmap_show || params$fltmap_kml) && nrow(mcp_all_sf) > 0) {
  print(htmltools::h3("Flight Areas"))
}  


if (params$fltmap_show && nrow(mcp_all_sf) > 0) {

  ## Add tiles properties
  tiles_esri_url <- "http://server.arcgisonline.com/ArcGIS/rest/services/World_Imagery/MapServer/tile/{z}/{y}/{x}"

  tiles_esri_attr <- "Tiles &copy; Esri &mdash; Source: Esri, i-cubed, USDA, USGS, AEX, GeoEye, Getmapping, Aerogrid, IGN, IGP, UPR-EGP, and the GIS User Community"

  # cols_base <- sample(c("#89C5DA", "#DA5724", "#74D944", "#CE50CA", "#3F4921", "#C0717C",
  #                  "#CBD588", "#5F7FC7", "#673770", "#D3D93E", "#38333E", "#508578",
  #                  "#D7C1B1", "#689030", "#AD6F3B", "#CD9BCD", "#D14285", "#6DDE88",
  #                  "#652926", "#7FDCC0", "#C84248", "#8569D5", "#5E738F", "#D1A33D",
  #                  "#8A7C64", "#599861"), size = nrow(mcp_all_sf), replace = TRUE)

  ## cols_base <- rainbow(nrow(mcp_all_sf), end=5/6)[order(runif(nrow(mcp_all_sf)))]

  ## Create colors from green to orange (excluding yellow, which we'll save for supplemental boundary files)
  cols_base <- hsv(h = seq(from = 72 / 360, 
                         to = 1 + (24 / 360), 
                         length.out = nrow(mcp_all_sf)) %% 1,
                   s = 0.8)[order(runif(nrow(mcp_all_sf)))]


  # mcp_lbl <- basename(params$html_reports)
  html_fns <- basename(sapply(1:length(i_lst), function(i) i_lst[[i]]$html_full))

  mcp_popup <- paste0("<a href='#", html_fns, "'>",   
                      sapply(1:length(i_lst), function(i) i_lst[[i]]$imgcol$name_use),
                      "</a>")

  mcp_leaf <- leaflet(mcp_all_sf, width="750px", height="450px",
               options = leafletOptions(maxZoom = 23)) %>% 
    addTiles(tiles_esri_url, group="Satellite", attribution=tiles_esri_attr) %>%
    addTiles(group="Open Street Map") %>% 
    addLayersControl(baseGroups = c("Satellite", "Open Street Map"), 
                     options = layersControlOptions(collapsed = FALSE))

  ## Add background layers
  if (length(params$bg_lst) > 0) {
    for (j in 1:length(params$bg_lst)) {
      mcp_leaf <- mcp_leaf %>% 
        addPolylines(data = params$bg_lst[[j]]$kml_sf %>% st_geometry() %>% st_zm(), 
                     color = params$bg_lst[[j]]$color, 
                     weight = params$bg_lst[[j]]$weight,
                     opacity = 0.9)
    }
  }

  mcp_leaf <- mcp_leaf %>% 
    addPolygons(fillColor = cols_base, fillOpacity = 0.25, 
                color = cols_base, weight = 3, opacity = 0.5,
                popup = mcp_popup,
                highlightOptions = highlightOptions(weight = 5, fillOpacity = 0.3))

  mcp_leaf

}

## Create a link to the all flight areas KML
if (params$fltmap_kml && nrow(mcp_all_sf) > 0) {

  kml_fn <- "flight_areas.kml"

  ## Create a new XML document with a 'document' node
  library(xml2)
  nd_document <- xml_new_root("kml",
                              xmlns = "http://www.opengis.net/kml/2.2",
                              "xmlns:gx" = "http://www.google.com/kml/ext/2.2",
                              "xmlns:kml" = "http://www.opengis.net/kml/2.2",
                              "xmlns:atom" = "http://www.w3.org/2005/Atom") %>%
    xml_add_child("Document") %>%
    xml_add_child("name", "flight_areas") %>%
    xml_parent()

  ## Add a style to the document node
  nd_style_hc <- nd_document %>% xml_add_child("Style", id = "hollow-cyan")

  ## Add PolyStyle
  nd_style_hc %>%
    xml_add_child("PolyStyle") %>%
    xml_add_child("fill", "0")

  ## Add Line Style
  nd_style_hc %>%
    xml_add_child("LineStyle") %>%
    xml_add_child("color", "ffffffaa") %>%
    xml_add_sibling("width", "2")

  for (j in 1:nrow(mcp_all_sf)) {

    ## Create a new placemark node
    nd_placemark <- nd_document %>% xml_add_child("Placemark")

    ## Add a few base properties
    nd_placemark %>%
      xml_add_child("styleUrl", "#hollow-cyan") %>%
      xml_add_sibling("name", file_path_sans_ext(basename (params$html_reports[j])))

    ## Don't clamp to ground - LINE DISAPPEARS UNDER TREES
    ## xml_add_sibling("altitudeMode", "clampToGround") %>%

    ## Create the string of coordinates
    coords_chr <- mcp_all_sf %>%
      slice(j) %>%
      # st_transform(4326) %>%
      st_coordinates() %>%
      as_tibble() %>%
      mutate(coords = paste(X, Y, "0", sep = ",")) %>%
      pull(coords) %>%
      paste(collapse = " ")

    ## Create the placemark child nodes
    nd_placemark %>%
      xml_add_child("Polygon") %>%
      xml_add_child("outerBoundaryIs") %>%
      xml_add_child("LinearRing") %>%
      xml_add_child("coordinates", coords_chr)

  }  ## for j in 1:nrow(mcp_all_sf)

  ## Write to disk
  write_xml(nd_document %>% xml_root(), file = file.path(params$output_dir, kml_fn))

  ## Put the link in the HTML file
  print(htmltools::HTML("<p>Download: <a href=\"", kml_fn, "\">Flight area(s) (KML)</a></p>"))

}

href_target <- " target='_blank' rel='noopener'"

for (i in 1:length(i_lst)) {

  if (file.exists(i_lst[[i]]$html_full)) {
    html_fn <- basename(i_lst[[i]]$html_full)

    html_dir_rel <- make_path_relative(params$output_dir, dirname(i_lst[[i]]$html_full))

    if (i_lst[[i]]$imgcol$map_fn != "") {
      img_fn <- paste0(html_dir_rel, i_lst[[i]]$imgcol$map_fn )
      print(HTML(paste0("<div style='float:right;'><a href='", html_dir_rel, html_fn,
                       "'", href_target, "><img src='", html_dir_rel, i_lst[[i]]$imgcol$map_fn,
                     "' style='width:220px; padding:20px;'/></a></div>")))
    }

    print(HTML(paste0("<h3 id='", html_fn, "'><a href='", html_dir_rel, html_fn, "'", href_target, ">", 
                      i_lst[[i]]$imgcol$name_use, "</a></h3>")))

    if ("description" %in% names(i_lst[[i]]$imgcol)) {
      if (i_lst[[i]]$imgcol$description != "") {
        print(HTML(paste0("<p><em>", i_lst[[i]]$imgcol$description, "</em></p>")))
      }
    }

    print(HTML(paste0("<p class='compact'><strong>Date captured:</strong> ",
                      i_lst[[i]]$imgcol$date_flown, "</p>")))

    if ("pilot" %in% names(i_lst[[i]]$imgcol)) {
      if (i_lst[[i]]$imgcol$pilot != "") {
        print(HTML(paste0("<p class='compact'><strong>Pilot:</strong> ", 
                          i_lst[[i]]$imgcol$pilot, "</p>")))
      }
    }

    if ("camera_name" %in% names(i_lst[[i]]$imgcol)) {
      print(HTML(paste0("<p class='compact'><strong>Camera:</strong> ",
                      i_lst[[i]]$imgcol$camera_name, "</p>")))
    }

    print(HTML(paste0("<p class='compact'><strong>Num images:</strong> ",
                      i_lst[[i]]$imgcol$num_img, "</p>")))

    print(HTML(paste0("<p class='compact'><strong>Area:</strong> ",
                      round(as.numeric(i_lst[[i]]$imgcol$area_m2) / 4046.86, 1), " acres</p>")))

    print(HTML(paste0("<p class='compact'><strong>Data size:</strong> ",
                      format(as.numeric(i_lst[[i]]$imgcol$size_mb), big.mark = ","), " MB</p>")))

    if ("contact" %in% names(i_lst[[i]]$imgcol)) {
      if (i_lst[[i]]$imgcol$contact != "") {
        print(HTML(paste0("<p class='compact'><strong>Contact:</strong> ", 
                          i_lst[[i]]$imgcol$contact, "</p>")))
      }
    }

    print(HTML("<hr style='clear:both;'></hr>"))

  } else {
    print(HTML(paste0("<p>File not found:<br/><em>", i_lst[[i]]$html_full, "</em></p>")))
    print(HTML("<hr style='clear:both;'></hr>"))

  }

}

print(HTML("<div style=\"font-size:90%; font-style:italic; float:right;\">Created with <a href=\"https://github.com/ucanr-igis/uasimg\" target=\"_blank\" rel=\"noopener\">Drone Image Utils</a> for R</div>"))