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