sciplotr: GGplots with scientific themes

# https://github.com/tidyverse/ggplot2/blob/fa000f786cb0b641600b6de68ae0f96e2ffc5e75/R/guides-axis.r#L180
draw_axis <- function(break_positions, break_labels, axis_position, theme,
                      check.overlap = FALSE, angle = NULL, n.dodge = 1,
                      break_types = vctrs::vec_recycle("major", vctrs::vec_size(break_positions))) {
    axis_position <- match.arg(axis_position, cc("top", "bottom", "right", "left"))
    aesthetic <- if (axis_position %vin% cc("top", "bottom")) "x" else "y"

    # resolve elements
    line_element_name <- paste0("axis.line.", aesthetic, ".", axis_position)
    tick_element_name <- paste0("axis.ticks.", aesthetic, ".", axis_position)
    tick_length_element_name <- paste0("axis.ticks.length.", aesthetic, ".", axis_position)
    ## WATCH: obtaining minor tick element
    tick_minor_length_element_name <- paste0("sciplotr.axis.ticks.minor.length.", aesthetic, ".", axis_position)
    ##
    label_element_name <- paste0("axis.text.", aesthetic, ".", axis_position)

    line_element <- calc_element(line_element_name, theme)
    tick_element <- calc_element(tick_element_name, theme)
    tick_length <- calc_element(tick_length_element_name, theme)
    label_element <- calc_element(label_element_name, theme)
    ###
    tick_minor_length <- calc_element(tick_minor_length_element_name, theme) %||% u_(0 ~ pt)
    #panel_border_size  <- unit(calc_element("panel.border", theme)$size %||% 0, "mm")
    ###



    # override label element parameters for rotation
    if (rlang::inherits_any(label_element, "element_text")) {
        label_overrides <- ggplot2:::axis_label_element_overrides(axis_position, angle)
        # label_overrides is always an element_text(), but in order for the merge to
        # keep the new class, the override must also have the new class
        class(label_overrides) <- class(label_element)
        label_element <- ggplot2::merge_element(label_overrides, label_element)
    }

    # conditionally set parameters that depend on axis orientation
    is_vertical <- axis_position %vin% cc("left", "right")

    position_dim <- if (is_vertical) "y" else "x"
    non_position_dim <- if (is_vertical) "x" else "y"
    position_size <- if (is_vertical) "height" else "width"
    non_position_size <- if (is_vertical) "width" else "height"
    gtable_element <- if (is_vertical) gtable::gtable_row else gtable::gtable_col
    measure_gtable <- if (is_vertical) gtable::gtable_width else gtable::gtable_height
    measure_labels_non_pos <- if (is_vertical) grid::grobWidth else grid::grobHeight

    # conditionally set parameters that depend on which side of the panel
    # the axis is on
    is_second <- axis_position %vin% cc("right", "top")

    ### Experimetnal
    #if (is_vertical && !is_second) {
        #tick_length <- tick_length - panel_border_size * 0
        #tick_minor_length <- tick_minor_length - panel_border_size * 0
    #}
    ###

    tick_direction <- if (is_second) 1 else -1
    non_position_panel <- if (is_second) u_(0 ~ npc) else u_(1 ~ npc)
    tick_coordinate_order <- if (is_second) vctrs::vec_c(2L, 1L) else vctrs::vec_c(1L, 2L)

    # conditionally set the gtable ordering
    labels_first_gtable <- axis_position %vin% cc("left", "top") # refers to position in gtable

    # set common parameters
    n_breaks <- length(break_positions)
    opposite_positions <- cc("top" = "bottom", "bottom" = "top", "right" = "left", "left" = "right")
    axis_position_opposite <- unname(opposite_positions[axis_position])

    # draw elements
    line_grob <- rlang::exec(
        ggplot2::element_grob, line_element,
        !!position_dim := u_(0 ~ npc, 1 ~ npc),
        !!non_position_dim := grid::unit.c(non_position_panel, non_position_panel))

    if (n_breaks == 0) {
        return(
            ggplot2:::absoluteGrob(
                grid::gList(line_grob),
                width = grid::grobWidth(line_grob),
                height = grid::grobHeight(line_grob)))
    }

    # break_labels can be a list() of language objects
    if (is.list(break_labels)) {
        if (any(vapply(break_labels, is.language, logical(1))))
            break_labels <- do.call(expression, break_labels)
        else
            break_labels <- unlist(break_labels)
    }

    # calculate multiple rows/columns of labels (which is usually 1)

    n_breaks_major <- vctrs::vec_size(break_labels)
    dodge_pos <- rep(seq_len(n.dodge), length.out = n_breaks_major)
    dodge_indices <- split(seq_len(n_breaks_major), dodge_pos)
    labelled_pos <- break_positions[break_types == "major"]

    label_grobs <-
        purrr::map(dodge_indices,
            function(indices) {
                ggplot2:::draw_axis_labels(
                    break_positions = labelled_pos,
                    break_labels = break_labels[indices],
                    label_element = label_element,
                    is_vertical = is_vertical,
                    check.overlap = check.overlap)
            })


    ## Generating variable length ticks
    tick_length_actual <- rep(tick_length, n_breaks)

    tick_length_actual[break_types == "minor"] <- tick_minor_length

    actual_tick_pos <- unit.c(
        non_position_panel + tick_direction * tick_length_actual,
        rep(non_position_panel, n_breaks))
    #else
        #actual_tick_pos <- unit.c(non_position_panel + tick_direction * tick_length_actual,
                            #rep(non_position_panel, n_breaks))

    actual_tick_pos <-
        actual_tick_pos[as.vector(sapply(1:n_breaks - 1, function(x) x + c(1, n_breaks + 1)[tick_coordinate_order]))]


    ##
    ticks_grob <- exec(
        element_grob, tick_element,
        !!position_dim := rep(unit(break_positions, "native"), each = 2),
        !!non_position_dim := actual_tick_pos,
        id.lengths = rep(2, times = n_breaks))

    # create gtable
    non_position_sizes <- paste0(non_position_size, "s")
    label_dims <- do.call(unit.c, lapply(label_grobs, measure_labels_non_pos))
    grobs <- c(list(ticks_grob), label_grobs)
    grob_dims <- unit.c(tick_length, label_dims)

    if (labels_first_gtable) {
        grobs <- rev(grobs)
        grob_dims <- rev(grob_dims)
    }

    gt <- exec(
        gtable_element,
        name = "axis",
        grobs = grobs,
        !!non_position_sizes := grob_dims,
        !!position_size := unit(1, "npc"))

    # create viewport
    justvp <- exec(
        viewport,
        !!non_position_dim := non_position_panel,
        !!non_position_size := measure_gtable(gt),
        just = axis_position_opposite)

    ggplot2:::absoluteGrob(
        gList(line_grob, gt),
        width = gtable_width(gt),
        height = gtable_height(gt),
        vp = justvp)
}



# https://github.com/tidyverse/ggplot2/blob/115c3960d0fd068f1ca4cfe4650c0e0474aabba5/R/coord-cartesian-.r#L222
panel_guides_grob <- function(guides, position, theme) {
    guide <- ggplot2:::guide_for_position(guides, position) %||% ggplot2:::guide_none()
    guide_gengrob(guide, theme)
}

guide_gengrob.axis <- function(guide, theme) {
    aesthetic <- names(guide$key)[!grepl("^\\.", names(guide$key))][1]
    draw_axis(break_positions = guide$key[[aesthetic]],
        break_labels = guide$key[guide$key$.type == "major", ".label"],
        axis_position = guide$position, theme = theme, check.overlap = guide$check.overlap,
        angle = guide$angle, n.dodge = guide$n.dodge,
        break_types = guide$key[[".type"]])
}