# Constructor -------------------------------------------------------------

#' Compose guides on top of one another
#'
#' @description
#' This guide can place other guides on top of one another.
#'
#' @inheritParams compose_stack
#'
#' @return A `<ComposeOntop>` composite guide object.
#' @export
#' @family composition
#'
#' @details
#' ## Styling options
#'
#' There are no styling options in `theme()` for this composition.
#'
#'
#' @examples
#' # Using the ontop composition to get two types of ticks with different
#' # lengths
#' ggplot(mpg, aes(displ, hwy)) +
#'   geom_point() +
#'   guides(x = compose_ontop(
#'     guide_axis_base(
#'       key_manual(c(2, 4, 6)),
#'       theme = theme(
#'         axis.ticks = element_line(colour = "limegreen"),
#'         axis.ticks.length = unit(11, "pt")
#'       )
#'     ),
#'     guide_axis_base(
#'       key_manual(c(3, 5, 7)),
#'       theme = theme(
#'         axis.ticks = element_line(colour = "tomato"),
#'         axis.ticks.length = unit(5.5, "pt")
#'       )
#'     )
#'   ))
compose_ontop <- function(
  ..., args = list(),
  key = NULL, title = waiver(),
  angle = waiver(), theme = NULL, order = 0L,
  position = waiver(), available_aes = NULL
) {
  new_compose(
    guides = list2(...),
    title = title,
    theme = theme,
    key = key,
    angle = angle,
    available_aes = available_aes,
    order = order,
    position = position,
    name = "ontop_composition",
    super = ComposeOntop
  )
}

# Class -------------------------------------------------------------------

#' @export
#' @rdname legendry_extensions
#' @format NULL
#' @usage NULL
ComposeOntop <- ggproto(
  "ComposeOntop", Compose,

  draw = function(self, theme, position = NULL, direction = NULL,
                  params = self$params) {
    theme <- theme + params$theme

    params$position  <- position  <- params$position  %||% position
    params$direction <- direction <- params$direction %||% direction

    n_guides <- length(params$guides)
    guide_index <- seq_len(n_guides)
    grobs <- vector("list", n_guides)

    if (is_theta(position)) {
      stack_offset <- unit(cm(params$stack_offset %||% 0.0), "cm")
      offset <- stack_offset

      for (i in guide_index) {
        pars <- params$guide_params[[i]]
        pars$stack_offset <- stack_offset
        grob <- params$guides[[i]]$draw(
          theme = theme, position = position, direction = direction,
          params = pars
        )
        if (!is.null(grob$offset) && !is_zero(grob)) {
          offset <- unit(cm(max(grob$offset, offset)), "cm")
        }
        grobs[[i]] <- grob
      }
      keep <- !map_lgl(grobs, is_zero)
      if (!any(keep)) {
        return(zeroGrob())
      }
      offset <- offset - stack_offset
      grobs <- gTree(offset = offset, children = inject(gList(!!!grobs[keep])))
      return(grobs)
    }

    draw_label <- params$draw_label %||% TRUE

    for (i in guide_index) {
      pars <- params$guide_params[[i]]
      pars$draw_label <- draw_label
      grobs[[i]] <- params$guides[[i]]$draw(
        theme = theme, position = position, direction = direction, params = pars
      )
    }

    self$assemble_drawing(grobs, params = params)
  },

  assemble_drawing = function(grobs, layout = NULL, sizes = NULL, params, elements = NULL) {
    keep <- !map_lgl(grobs, is_zero)
    grobs <- grobs[keep]
    if (length(grobs) == 0L) {
      return(zeroGrob())
    }

    position <- params$position
    anchor <- unit(as.numeric(position %in% c("left", "bottom")), "npc")
    just <- opposite_position(position)

    widths  <- width_cm(grobs)
    heights <- height_cm(grobs)

    index <- seq_along(grobs)
    names <- paste0("guide-ontop", index)

    if (position %in% c("bottom", "top")) {
      height <- unit(max(heights), "cm")
      gt <- gtable(widths = unit(1.0, "npc"), heights = height) |>
        gtable_add_grob(grobs, t = 1L, l = 1L, name = names, clip = "off")
      vp <- viewport(y = anchor, height = height, just = just)
    } else {
      width <- unit(max(widths), "cm")
      gt <- gtable(widths = width, heights = unit(1.0, "npc")) |>
        gtable_add_grob(grobs, t = 1L, l = 1L, name = names, clip = "off")
      vp <- viewport(x = anchor, width = width, just = just)
    }

    absoluteGrob(
      grob   = gList(gt), vp = vp,
      width  = gtable_width(gt),
      height = gtable_height(gt)
    )
  }
)
