← Back to branch summary

~ubuntu-branches/ubuntu/oneiric/latticeextra/oneiric

« back to all changes in this revision

Viewing changes to R/layer.R

  • Committer: Bazaar Package Importer
  • Author(s): Dirk Eddelbuettel
  • Date: 2011-05-13 15:40:08 UTC
  • mfrom: (1.4.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20110513154008-ogqy8zo6elhazff4
Tags: 0.6-16-1
* New upstream release

* debian/control: Set (Build-)Depends: to current R version
* debian/control: Set Standards-Version: to current version 

Show diffs side-by-side

added added

removed removed

Lines of Context:
R/layer.R
134
134
        return(structure(c(unclass(object), unclass(lay)),
135
135
                         class = c("layer", "trellis")))
136
136
    }
137
 
    panel <- if (toString(object$call[[1]]) == "splom")
 
137
    panel <- if ("panel" %in% names(object$panel.args.common))
138
138
        object$panel.args.common$panel
139
139
    else object$panel
140
140
    panel <- if (is.function(panel)) panel
149
149
    ## a flag to indicate this panel function has layers
150
150
    ## (used by flattenPanel and undoLayer)
151
151
    .is.a.layer <- TRUE
152
 
    newpanel <- function(..., subscripts = TRUE) {
 
152
    newpanel <- function(...) {
153
153
        .UNDER <- unlist(lapply(lay, attr, "under"))
154
 
        ## underlayers only
155
 
        drawLayer(lay[.UNDER])
 
154
        ## underlaying items only
 
155
        drawLayer(lay[.UNDER], list(...))
156
156
        ## original panel function:
157
 
        panel(..., subscripts = subscripts)
158
 
        ## overlayers only
159
 
        drawLayer(lay[.UNDER == FALSE])
 
157
        panel(...)
 
158
        ## overlaying items only
 
159
        drawLayer(lay[.UNDER == FALSE], list(...))
160
160
    }
161
 
    object <- update(object, panel = newpanel)
 
161
    if ("panel" %in% names(object$panel.args.common))
 
162
        object$panel.args.common$panel <- newpanel
 
163
    else object$panel <- newpanel
162
164
    ## need this to allow further calls to update() to insert arguments:
163
165
    object$call <- call("update", ocall)
164
166
    object
165
167
}
166
168
 
167
 
drawLayer <- function(lay)
 
169
drawLayer <- function(lay, panelArgs = trellis.panelArgs())
168
170
{
169
171
    lay <- as.layer(lay)
170
172
    .UNDER <- unlist(lapply(lay, attr, "under"))
171
173
    ## underlayers, in reverse order
172
174
    for (.ITEM in rev(lay[.UNDER]))
173
 
        drawLayerItem(.ITEM)
 
175
        drawLayerItem(.ITEM, panelArgs)
174
176
    ## overlayers
175
177
    for (.ITEM in lay[.UNDER == FALSE])
176
 
        drawLayerItem(.ITEM)
 
178
        drawLayerItem(.ITEM, panelArgs)
177
179
    invisible()
178
180
}
179
181
 
180
 
drawLayerItem <- function(layer.item)
 
182
drawLayerItem <- function(layer.item, panelArgs)
181
183
{
182
184
    stopifnot(is.expression(layer.item))
183
185
    ## check that any restrictions on packets/rows/columns are met
240
242
    ## call panel.superpose for group layers
241
243
    if (isTRUE(attr(layer.item, "superpose"))) {
242
244
        do.call("panel.superpose",
243
 
                modifyList(trellis.panelArgs(),
 
245
                modifyList(panelArgs,
244
246
                  list(panel.groups = drawLayerItemPerGroup)))
245
247
    } else {
246
 
        do.call("drawLayerItemPerGroup", trellis.panelArgs())
 
248
        do.call("drawLayerItemPerGroup", panelArgs)
247
249
    }
248
250
}
249
251