Bug 17148: debug rasterImage orientation on Quartz

[hturner]

Reprex

Functions for reprex - source these first

get_rotated_corners <- function(
        xleft,
        ybottom,
        xright,
        ytop,
        x_rotate_center,
        y_rotate_center,
        angle_degree
) {
    sgn <- sign(xright - xleft)*sign(ytop - ybottom)
    angle_rad <- (angle_degree * pi / 180) * sgn
    
    # Calculate initial corner points
    corners_x <- c(xleft, xright, xright, xleft)
    corners_y <- c(ybottom, ybottom, ytop, ytop)
    
    # Calculate rotated corner points
    rotated_corners_x <- numeric(4)
    rotated_corners_y <- numeric(4)
    
    for (i in 1:4) {
        # Translate to origin
        x_translated <- corners_x[i] - x_rotate_center
        y_translated <- corners_y[i] - y_rotate_center
        
        # Rotate
        x_rotated <- x_translated * cos(angle_rad) - y_translated * sin(angle_rad)
        y_rotated <- x_translated * sin(angle_rad) + y_translated * cos(angle_rad)
        
        # Translate back
        rotated_corners_x[i] <- x_rotated + x_rotate_center
        rotated_corners_y[i] <- y_rotated + y_rotate_center
    }
    
    return(list(rotated_corners_x,rotated_corners_y))
}

raster4 <- function(starting_image, ending_image = starting_image,
                    angle = 20) {
    
    op <- par(bg = "thistle", mar = rep(2.5, 4)); on.exit(par(op))
    
    plot(1:10, type = "n", main = names(dev.cur()), asp = 1)
    mtext(R.version.string, cex = 0.75)
    abline(h = c(2, 4, 7, 9), lty = 2)
    abline(v = c(2, 4, 7, 9), lty = 2)
    
    # TOP LEFT
    
    ## Axes
    ### xleft to xright (allowing extra for arrow)
    arrows(x0 = 4, y0 = 7, x1 = 1.25, y1 = 7, length = 0.15, angle = 30,
           code = 2, lwd = 2)
    text(1.5, 6.5, labels = "x", cex = 1)
    ### ybottom to ytop (allowing extra for arrow) 
    arrows(x0 = 4, y0 = 7, x1 = 4, y1 = 9.75, length = 0.15, angle = 30,
           code = 2, lwd = 2)
    text(4.5, 9.5, labels = "y", cex = 1)
    
    ## Original top left square
    rasterImage(starting_image, xleft = 4, ybottom = 7, xright = 2, ytop = 9, angle = 0, interpolate = FALSE)
    rect(xleft = 4, ybottom = 7, xright = 2, ytop = 9, border = "black")
    
    ## Rotated top left square
    sgn <- sign(2 - 4)*sign(9 - 7) # negative if only one axes in negative direction
    rasterImage(ending_image, xleft = 4, ybottom = 7, xright = 2, ytop = 9, angle = angle*sgn, interpolate = FALSE)
    rotated_corners_top_left <- get_rotated_corners(
        xleft = 4, ybottom = 7, xright = 2, ytop = 9, # can I swap xleft and xright here?
        x_rotate_center = 4,
        y_rotate_center = 7,
        angle_degree = angle
    )
    polygon(rotated_corners_top_left[[1]], rotated_corners_top_left[[2]], border = "black")
    
    ## Rotation point of top left square
    points(4, 7, col = "green", pch = 16, cex = 1)
    
    # TOP RIGHT
    
    ## Axes
    ### xleft to xright (allowing extra for arrow)
    arrows(x0 = 7, y0 = 7, x1 = 9.75, y1 = 7, length = 0.15, angle = 30,
           code = 2, lwd = 2)
    text(9.5, 6.5, labels = "x", cex = 1)
    ### ybottom to ytop (allowing extra for arrow) 
    arrows(x0 = 7, y0 = 7, x1 = 7, y1 = 9.75, length = 0.15, angle = 30,
           code = 2, lwd = 2)
    text(6.5, 9.5, labels = "y", cex = 1)
    
    ## Original top right square
    rasterImage(starting_image, xleft = 7, ybottom = 7, xright = 9, ytop = 9, angle = 0, interpolate = FALSE)
    rect(xleft = 7, ybottom = 7, xright = 9, ytop = 9, border = "black")
    
    ## Rotated top right square
    sgn <- sign(9 - 7)*sign(9 - 7) # negative if only one axes in negative direction
    rasterImage(ending_image, xleft = 7, ybottom = 7, xright = 9, ytop = 9, angle = angle*sgn, interpolate = FALSE)
    rotated_corners_top_right <- get_rotated_corners(
        xleft = 7, ybottom = 7, xright = 9, ytop = 9,
        x_rotate_center = 7,
        y_rotate_center = 7,
        angle_degree = angle
    )
    polygon(rotated_corners_top_right[[1]], rotated_corners_top_right[[2]], border = "black")
    
    ## Rotation point of top right square
    points(7, 7, col = "green", pch = 16, cex = 1)
    
    # BOTTOM LEFT
    
    ## Axes
    ### xleft to xright (allowing extra for arrow)
    arrows(x0 = 4, y0 = 4, x1 = 1.25, y1 = 4, length = 0.15, angle = 30,
           code = 2, lwd = 2)
    text(1.5, 4.5, labels = "x", cex = 1)
    ### ybottom to ytop (allowing extra for arrow) 
    arrows(x0 = 4, y0 = 4, x1 = 4, y1 = 1.25, length = 0.15, angle = 30,
           code = 2, lwd = 2)
    text(4.5, 1.5, labels = "y", cex = 1)
    
    ## Original bottom left square
    rasterImage(starting_image, xleft = 4, ybottom = 4, xright = 2, ytop = 2, angle = 0, interpolate = FALSE)
    rect(xleft = 4, ybottom = 4, xright = 2, ytop = 2, border = "black")
    
    ## Rotated bottom left square
    sgn <- sign(2 - 4)*sign(2 - 4) # negative if only one axes in negative direction
    rasterImage(ending_image, xleft = 4, ybottom = 4, xright = 2, ytop = 2, angle = angle*sgn, interpolate = FALSE)
    rotated_corners_bottom_left <- get_rotated_corners(
        xleft = 4, ybottom = 4, xright = 2, ytop = 2,
        x_rotate_center = 4,
        y_rotate_center = 4,
        angle_degree = angle
    )
    polygon(rotated_corners_bottom_left[[1]], rotated_corners_bottom_left[[2]], border = "black")
    
    ## Rotation point of bottom left square
    points(4, 4, col = "green", pch = 16, cex = 1)
    
    # BOTTOM RIGHT
    
    ## Axes
    ### xleft to xright (allowing extra for arrow)
    arrows(x0 = 7, y0 = 4, x1 = 9.75, y1 = 4, length = 0.15, angle = 30,
           code = 2, lwd = 2)
    text(9.5, 4.5, labels = "x", cex = 1)
    ### ybottom to ytop (allowing extra for arrow) 
    arrows(x0 = 7, y0 = 4, x1 = 7, y1 = 1.25, length = 0.15, angle = 30,
           code = 2, lwd = 2)
    text(6.5, 1.5, labels = "y", cex = 1)
    
    ## Original bottom right square
    rasterImage(starting_image, xleft = 7, ybottom = 4, xright = 9, ytop = 2, angle=0, interpolate=FALSE)
    rect(7, 2, 9, 4, border = "black")
    
    ## Rotated bottom left square
    sgn <- sign(9 - 7)*sign(2 - 4) # negative if only one axes in negative direction
    rasterImage(ending_image, xleft = 7, ybottom = 4, xright = 9, ytop = 2, angle=angle*sgn, interpolate=FALSE)
    rotated_corners_bottom_right <- get_rotated_corners(
        xleft = 7, ybottom = 4, xright = 9, ytop = 2,
        x_rotate_center = 7,
        y_rotate_center = 4,
        angle_degree = angle
    )
    polygon(rotated_corners_bottom_right[[1]], rotated_corners_bottom_right[[2]], border = "black")
    
    ## Rotation point of bottom left square
    points(7, 4, col = "green", pch = 16, cex = 1)
    
    invisible(list(starting_image = starting_image, 
                   ending_image = ending_image, 
                   angle = angle))
    
}

f_start <- as.raster(rbind(
    c(0,  0,  0,  0),
    c(0, NA, NA, NA),
    c(0,  0,  0, NA),
    c(0, NA, NA, NA)
))
f_end <- as.raster(rbind(
    c(1,  1,  1,  1),
    c(1, NA, NA, NA),
    c(1,  1,  1, NA),
    c(1, NA, NA, NA)
))

raster4(f_start, f_end, angle = 20)

Expected result

This is the expected result which you get in Positron (with the ark graphics device) on in RStudio with the Cairo or AGG device (Tools > Global Options > General > Graphics > Backend):

Result with Quartz device

On a Quartz device (open with quartz() or change the backend in RStudio), you get:

There are a couple of issues here:

• The rasters have not been flipped to match the axes
• The location of the rotated raster (white F) is wrong when the y axis is flipped

Task

The task is to debug plotting on the Quartz device, to pin down where the code is wrong and how it might be fixed.

This requires Building R-Devel on macOS and debugging C code.