1# File src/library/grid/R/layout.R 2# Part of the R package, https://www.R-project.org 3# 4# Copyright (C) 1995-2016 The R Core Team 5# 6# This program is free software; you can redistribute it and/or modify 7# it under the terms of the GNU General Public License as published by 8# the Free Software Foundation; either version 2 of the License, or 9# (at your option) any later version. 10# 11# This program is distributed in the hope that it will be useful, 12# but WITHOUT ANY WARRANTY; without even the implied warranty of 13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14# GNU General Public License for more details. 15# 16# A copy of the GNU General Public License is available at 17# https://www.R-project.org/Licenses/ 18 19 20is.layout <- function(l) { 21 inherits(l, "layout") 22} 23 24# FIXME: The internal C code now does a lot of recycling of 25# unit values, units, and data. Can some/most/all of the 26# recycling stuff below be removed ? 27valid.layout <- function(nrow, ncol, widths, heights, respect, just) { 28 nrow <- as.integer(nrow) 29 ncol <- as.integer(ncol) 30 # make sure we're dealing with a unit object 31 if (!is.logical(respect)) { 32 respect <- as.matrix(respect) 33 if (!is.matrix(respect) || any(dim(respect) != c(nrow, ncol))) 34 stop("'respect' must be logical or an 'nrow' by 'ncol' matrix") 35 } 36 if (is.matrix(respect)) { 37 respect.mat <- matrix(as.integer(respect), 38 dim(respect)[1L], 39 dim(respect)[2L]) 40 respect <- 2 41 } 42 else respect.mat <- matrix(0L, nrow, ncol) 43 44 valid.just <- valid.just(just) 45 l <- list(nrow = nrow, ncol = ncol, 46 widths = widths, heights = heights, 47 respect = respect, valid.respect=as.integer(respect), 48 respect.mat = respect.mat, 49 just=just, valid.just=valid.just) 50 class(l) <- "layout" 51 l 52} 53 54layout.torture <- function() { 55 top.vp <- viewport(y=0, height=unit(1, "npc") - unit(1.5, "lines"), 56 just=c("centre", "bottom")) 57 do.label <- function(label) { 58 grid.rect(y=1, height=unit(1.5, "lines"), 59 just=c("center", "top")) 60 grid.text(label, 61 y=unit(1, "npc") - unit(1, "lines"), 62 gp=gpar(font=2)) 63 } 64 # 1 = all relative widths and heights 65 grid.show.layout(grid.layout(3,2), vp=top.vp) 66 do.label("All dimensions relative -- no respect") 67 # (1) with full respect 68 grid.show.layout(grid.layout(3,2, respect=TRUE), vp=top.vp) 69 do.label("All dimensions relative -- full respect") 70 # (1) with partial respect 71 grid.show.layout(grid.layout(3,2,respect=matrix(c(1,0,0,0,0,0), 3L, 2L, TRUE)), 72 vp=top.vp) 73 do.label("All dimensions relative -- only top-left cell respected") 74 # (1) with slightly weirder partial respect 75 grid.show.layout(grid.layout(3,2,respect=matrix(c(1,0,0,0,0,1), 3L, 2L, TRUE)), 76 vp=top.vp) 77 do.label("All relative -- top-left, bottom-right respected") 78 # 2 = combination of absolute and relative widths and heights 79 grid.show.layout(grid.layout(2, 3, 80 widths=unit(c(2,4,1), c("null", "cm", "null")), 81 heights=unit(c(6,4), c("cm", "null"))), 82 vp=top.vp) 83 do.label("Absolute and relative -- no respect") 84 # (2) with full respect 85 grid.show.layout(grid.layout(2, 3, 86 widths=unit(c(2,4,1), c("null", "cm", "null")), 87 heights=unit(c(6,4), c("cm", "null")), respect=TRUE), 88 vp=top.vp) 89 do.label("Absolute and relative -- full respect") 90 # (2) with partial respect 91 grid.show.layout(grid.layout(2, 3, 92 widths=unit(c(2,4,1), c("null", "cm", "null")), 93 heights=unit(c(6,4), c("cm", "null")), 94 respect=matrix(c(0,0,0,0,0,1), 2L, 3L, TRUE)), 95 vp=top.vp) 96 do.label("Absolute and relative -- bottom-right respected") 97} 98 99# Return the region allocated by the layout of the current viewport 100layoutRegion <- function(layout.pos.row=1, layout.pos.col=1) { 101 region <- grid.Call(C_layoutRegion, 102 # This conversion matches the vailidity check in 103 # valid.viewport() 104 if (is.null(layout.pos.row)) layout.pos.row 105 else as.integer(rep(layout.pos.row, length.out=2)), 106 if (is.null(layout.pos.col)) layout.pos.col 107 else as.integer(rep(layout.pos.col, length.out=2))) 108 list(left=unit(region[1L], "npc"), 109 bottom=unit(region[2L], "npc"), 110 width=unit(region[3L], "npc"), 111 height=unit(region[4L], "npc")) 112} 113 114#################### 115# Accessors 116#################### 117 118layout.nrow <- function(lay) { 119 lay$nrow 120} 121 122layout.ncol <- function(lay) { 123 lay$ncol 124} 125 126layout.widths <- function(lay) { 127 lay$widths 128} 129 130layout.heights <- function(lay) { 131 lay$heights 132} 133 134layout.respect <- function(lay) { 135 switch(lay$respect + 1, 136 FALSE, 137 TRUE, 138 lay$respect.mat) 139} 140 141#################### 142# Public constructor function 143#################### 144grid.layout <- function (nrow = 1, ncol = 1, 145 widths = unit(rep_len(1, ncol), "null"), 146 heights = unit(rep_len(1, nrow), "null"), 147 default.units = "null", 148 respect = FALSE, 149 just="centre") 150{ 151 if (!is.unit(widths)) 152 widths <- unit(widths, default.units) 153 if (!is.unit(heights)) 154 heights <- unit(heights, default.units) 155 valid.layout(nrow, ncol, widths, heights, respect, just) 156} 157 158#################### 159# Utility Functions 160#################### 161 162dim.layout <- function(x) { 163 c(x$nrow, x$ncol) 164} 165