├── .Rbuildignore ├── .github ├── .gitignore └── workflows │ ├── R-CMD-check.yaml │ ├── pkgdown.yaml │ ├── pr-commands.yaml │ └── test-coverage.yaml ├── .gitignore ├── CODE_OF_CONDUCT.md ├── DESCRIPTION ├── LICENSE ├── LICENSE.md ├── NAMESPACE ├── NEWS.md ├── R ├── aaa.R ├── blend.R ├── blend_custom.R ├── bloom.R ├── blur.R ├── channels.R ├── circle_dither.R ├── colourspaces.R ├── custom.R ├── custom_dither.R ├── displace.R ├── dither.R ├── doc-object-support.R ├── filter-constructors.R ├── ggfx-package.R ├── ggplot.R ├── grid.R ├── group.R ├── halftone_dither.R ├── inner_glow.R ├── interpolate.R ├── kernel.R ├── mask.R ├── motion_blur.R ├── ordered_dither.R ├── outer_glow.R ├── raster-helpers.R ├── raster-location.R ├── raster.R ├── raster_store.R ├── rasterise_grob.R ├── reference.R ├── shade.R ├── shadow.R └── variable_blur.R ├── README.Rmd ├── README.md ├── _pkgdown.yml ├── codecov.yml ├── cran-comments.md ├── man ├── as_colourspace.Rd ├── as_group.Rd ├── as_reference.Rd ├── channel_spec.Rd ├── figures │ ├── README-example-1.png │ └── logo.png ├── ggfx-package.Rd ├── object_support.Rd ├── raster_helpers.Rd ├── raster_placement.Rd ├── render_context.Rd ├── with_blend.Rd ├── with_blend_custom.Rd ├── with_bloom.Rd ├── with_blur.Rd ├── with_custom.Rd ├── with_displacement.Rd ├── with_dither.Rd ├── with_inner_glow.Rd ├── with_interpolate.Rd ├── with_kernel.Rd ├── with_mask.Rd ├── with_motion_blur.Rd ├── with_ordered_dither.Rd ├── with_outer_glow.Rd ├── with_raster.Rd ├── with_shade.Rd ├── with_shadow.Rd └── with_variable_blur.Rd ├── pkgdown └── favicon │ ├── apple-touch-icon-120x120.png │ ├── apple-touch-icon-152x152.png │ ├── apple-touch-icon-180x180.png │ ├── apple-touch-icon-60x60.png │ ├── apple-touch-icon-76x76.png │ ├── apple-touch-icon.png │ ├── favicon-16x16.png │ ├── favicon-32x32.png │ └── favicon.ico └── vignettes ├── .gitignore ├── custom_filters.Rmd ├── geoms.Rmd └── ggfx.Rmd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^ggfx\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^README\.Rmd$ 4 | ^CODE_OF_CONDUCT\.md$ 5 | ^LICENSE\.md$ 6 | ^\.github/workflows/R-CMD-check\.yaml$ 7 | ^codecov\.yml$ 8 | ^\.github$ 9 | ^_pkgdown\.yml$ 10 | ^docs$ 11 | ^pkgdown$ 12 | ^cran-comments\.md$ 13 | ^CRAN-RELEASE$ 14 | ^CRAN-SUBMISSION$ 15 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | # 4 | # NOTE: This workflow is overkill for most R packages and 5 | # check-standard.yaml is likely a better choice. 6 | # usethis::use_github_action("check-standard") will install it. 7 | on: 8 | push: 9 | branches: [main, master] 10 | pull_request: 11 | branches: [main, master] 12 | 13 | name: R-CMD-check 14 | 15 | jobs: 16 | R-CMD-check: 17 | runs-on: ${{ matrix.config.os }} 18 | 19 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 20 | 21 | strategy: 22 | fail-fast: false 23 | matrix: 24 | config: 25 | - {os: macOS-latest, r: 'release'} 26 | 27 | - {os: windows-latest, r: 'release'} 28 | # Use 3.6 to trigger usage of RTools35 29 | - {os: windows-latest, r: '3.6'} 30 | 31 | # Use older ubuntu to maximise backward compatibility 32 | - {os: ubuntu-20.04, r: 'devel', http-user-agent: 'release'} 33 | - {os: ubuntu-20.04, r: 'release'} 34 | - {os: ubuntu-20.04, r: 'oldrel-1'} 35 | - {os: ubuntu-20.04, r: 'oldrel-2'} 36 | - {os: ubuntu-20.04, r: 'oldrel-3'} 37 | - {os: ubuntu-20.04, r: 'oldrel-4'} 38 | 39 | env: 40 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 41 | R_KEEP_PKG_SOURCE: yes 42 | 43 | steps: 44 | - uses: actions/checkout@v2 45 | 46 | - uses: r-lib/actions/setup-pandoc@v2 47 | 48 | - uses: r-lib/actions/setup-r@v2 49 | with: 50 | r-version: ${{ matrix.config.r }} 51 | http-user-agent: ${{ matrix.config.http-user-agent }} 52 | use-public-rspm: true 53 | 54 | - uses: r-lib/actions/setup-r-dependencies@v2 55 | with: 56 | extra-packages: any::rcmdcheck 57 | needs: check 58 | 59 | - uses: r-lib/actions/check-r-package@v2 60 | with: 61 | upload-snapshots: true 62 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | release: 9 | types: [published] 10 | workflow_dispatch: 11 | 12 | name: pkgdown 13 | 14 | jobs: 15 | pkgdown: 16 | runs-on: ubuntu-latest 17 | # Only restrict concurrency for non-PR jobs 18 | concurrency: 19 | group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} 20 | env: 21 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 22 | steps: 23 | - uses: actions/checkout@v2 24 | 25 | - uses: r-lib/actions/setup-pandoc@v2 26 | 27 | - uses: r-lib/actions/setup-r@v2 28 | with: 29 | use-public-rspm: true 30 | 31 | - uses: r-lib/actions/setup-r-dependencies@v2 32 | with: 33 | extra-packages: any::pkgdown, local::. 34 | needs: website 35 | 36 | - name: Build site 37 | run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) 38 | shell: Rscript {0} 39 | 40 | - name: Deploy to GitHub pages 🚀 41 | if: github.event_name != 'pull_request' 42 | uses: JamesIves/github-pages-deploy-action@4.1.4 43 | with: 44 | clean: false 45 | branch: gh-pages 46 | folder: docs 47 | -------------------------------------------------------------------------------- /.github/workflows/pr-commands.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | issue_comment: 5 | types: [created] 6 | 7 | name: Commands 8 | 9 | jobs: 10 | document: 11 | if: ${{ github.event.issue.pull_request && (github.event.comment.author_association == 'MEMBER' || github.event.comment.author_association == 'OWNER') && startsWith(github.event.comment.body, '/document') }} 12 | name: document 13 | runs-on: ubuntu-latest 14 | env: 15 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 16 | steps: 17 | - uses: actions/checkout@v2 18 | 19 | - uses: r-lib/actions/pr-fetch@v2 20 | with: 21 | repo-token: ${{ secrets.GITHUB_TOKEN }} 22 | 23 | - uses: r-lib/actions/setup-r@v2 24 | with: 25 | use-public-rspm: true 26 | 27 | - uses: r-lib/actions/setup-r-dependencies@v2 28 | with: 29 | extra-packages: any::roxygen2 30 | needs: pr-document 31 | 32 | - name: Document 33 | run: roxygen2::roxygenise() 34 | shell: Rscript {0} 35 | 36 | - name: commit 37 | run: | 38 | git config --local user.name "$GITHUB_ACTOR" 39 | git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com" 40 | git add man/\* NAMESPACE 41 | git commit -m 'Document' 42 | 43 | - uses: r-lib/actions/pr-push@v2 44 | with: 45 | repo-token: ${{ secrets.GITHUB_TOKEN }} 46 | 47 | style: 48 | if: ${{ github.event.issue.pull_request && (github.event.comment.author_association == 'MEMBER' || github.event.comment.author_association == 'OWNER') && startsWith(github.event.comment.body, '/style') }} 49 | name: style 50 | runs-on: ubuntu-latest 51 | env: 52 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 53 | steps: 54 | - uses: actions/checkout@v2 55 | 56 | - uses: r-lib/actions/pr-fetch@v2 57 | with: 58 | repo-token: ${{ secrets.GITHUB_TOKEN }} 59 | 60 | - uses: r-lib/actions/setup-r@v2 61 | 62 | - name: Install dependencies 63 | run: install.packages("styler") 64 | shell: Rscript {0} 65 | 66 | - name: Style 67 | run: styler::style_pkg() 68 | shell: Rscript {0} 69 | 70 | - name: commit 71 | run: | 72 | git config --local user.name "$GITHUB_ACTOR" 73 | git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com" 74 | git add \*.R 75 | git commit -m 'Style' 76 | 77 | - uses: r-lib/actions/pr-push@v2 78 | with: 79 | repo-token: ${{ secrets.GITHUB_TOKEN }} 80 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: test-coverage 10 | 11 | jobs: 12 | test-coverage: 13 | runs-on: ubuntu-latest 14 | env: 15 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 16 | 17 | steps: 18 | - uses: actions/checkout@v2 19 | 20 | - uses: r-lib/actions/setup-r@v2 21 | with: 22 | use-public-rspm: true 23 | 24 | - uses: r-lib/actions/setup-r-dependencies@v2 25 | with: 26 | extra-packages: any::covr 27 | needs: coverage 28 | 29 | - name: Test coverage 30 | run: covr::codecov(quiet = FALSE) 31 | shell: Rscript {0} 32 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | ggfx.Rproj 5 | docs 6 | inst/doc 7 | -------------------------------------------------------------------------------- /CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Code of Conduct 2 | 3 | As contributors and maintainers of this project, we pledge to respect all people who 4 | contribute through reporting issues, posting feature requests, updating documentation, 5 | submitting pull requests or patches, and other activities. 6 | 7 | We are committed to making participation in this project a harassment-free experience for 8 | everyone, regardless of level of experience, gender, gender identity and expression, 9 | sexual orientation, disability, personal appearance, body size, race, ethnicity, age, or religion. 10 | 11 | Examples of unacceptable behavior by participants include the use of sexual language or 12 | imagery, derogatory comments or personal attacks, trolling, public or private harassment, 13 | insults, or other unprofessional conduct. 14 | 15 | Project maintainers have the right and responsibility to remove, edit, or reject comments, 16 | commits, code, wiki edits, issues, and other contributions that are not aligned to this 17 | Code of Conduct. Project maintainers who do not follow the Code of Conduct may be removed 18 | from the project team. 19 | 20 | Instances of abusive, harassing, or otherwise unacceptable behavior may be reported by 21 | opening an issue or contacting one or more of the project maintainers. 22 | 23 | This Code of Conduct is adapted from the Contributor Covenant 24 | (https://www.contributor-covenant.org), version 1.0.0, available at 25 | https://contributor-covenant.org/version/1/0/0/. 26 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: ggfx 2 | Title: Pixel Filters for 'ggplot2' and 'grid' 3 | Version: 1.0.1.9000 4 | Authors@R: 5 | c(person(given = "Thomas Lin", 6 | family = "Pedersen", 7 | role = c("aut", "cre"), 8 | email = "thomasp85@gmail.com", 9 | comment = c(ORCID = "0000-0002-5147-4711")), 10 | person(given = "RStudio", 11 | role = c("cph", "fnd"))) 12 | Description: Provides a range of filters that can be applied to layers from the 13 | 'ggplot2' package and its extensions, along with other graphic elements such 14 | as guides and theme elements. The filters are applied at render time and 15 | thus uses the exact pixel dimensions needed. 16 | License: MIT + file LICENSE 17 | Encoding: UTF-8 18 | Roxygen: list(markdown = TRUE) 19 | Imports: 20 | magick (>= 2.7.1), 21 | ragg, 22 | grid, 23 | ggplot2, 24 | grDevices, 25 | gtable, 26 | rlang 27 | RoxygenNote: 7.2.1 28 | URL: https://ggfx.data-imaginist.com, https://github.com/thomasp85/ggfx 29 | BugReports: https://github.com/thomasp85/ggfx/issues 30 | Suggests: 31 | covr, 32 | knitr, 33 | rmarkdown, 34 | farver (>= 2.1.0) 35 | VignetteBuilder: knitr 36 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2021 2 | COPYRIGHT HOLDER: ggfx authors 3 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2021 ggfx authors 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # ggfx (development version) 2 | 3 | # ggfx 1.0.1 4 | 5 | * General upkeep 6 | 7 | # ggfx 1.0.0 8 | 9 | * Added a `NEWS.md` file to track changes to the package. 10 | -------------------------------------------------------------------------------- /R/aaa.R: -------------------------------------------------------------------------------- 1 | is_rcmd_check <- function() { 2 | if (identical(Sys.getenv("NOT_CRAN"), "true")) { 3 | FALSE 4 | } else { 5 | Sys.getenv("_R_CHECK_PACKAGE_NAME_", "") != "" 6 | } 7 | } 8 | -------------------------------------------------------------------------------- /R/blend_custom.R: -------------------------------------------------------------------------------- 1 | #' Create a custom blend type 2 | #' 3 | #' Many of the blend types available in [with_blend()] are variations over the 4 | #' formula: `a*src*dst + b*src + c*dst + d`, where `src` stands for the channel 5 | #' value in the source image and `dst` stands for the destination image (the 6 | #' background). Multiply is e.g. defined as `a:1, b:0, c:0, d:0`. This filter 7 | #' gives you free reign over setting the coefficient of the blend calculation. 8 | #' 9 | #' @param a,b,c,d The coefficients defining the blend operation 10 | #' @inheritParams with_blend 11 | #' @inheritParams with_blur 12 | #' 13 | #' @return Depending on the input, either a `grob`, `Layer`, list of `Layer`s, 14 | #' `guide`, or `element` object. Assume the output can be used in the same 15 | #' context as the input. 16 | #' 17 | #' @family blend filters 18 | #' 19 | #' @export 20 | #' 21 | #' @examples 22 | #' library(ggplot2) 23 | #' ggplot(mpg, aes(class, hwy)) + 24 | #' as_reference(geom_boxplot(fill = 'green'), 'box') + 25 | #' with_blend_custom(geom_point(colour = 'red'), 26 | #' bg_layer = 'box', a = -0.5, b = 1, c = 1) 27 | #' 28 | with_blend_custom <- function(x, bg_layer, a = 0, b = 0, c = 0, d = 0, 29 | flip_order = FALSE, alpha = NA, ...) { 30 | UseMethod('with_blend_custom') 31 | } 32 | #' @importFrom grid gTree 33 | #' @export 34 | with_blend_custom.grob <- function(x, bg_layer, a = 0, b = 0, c = 0, d = 0, 35 | flip_order = FALSE, alpha = NA, ..., id = NULL, 36 | include = is.null(id)) { 37 | gTree(grob = x, bg_layer = bg_layer, a = a, b = b, c = c, d = d, 38 | flip_order = flip_order, alpha = tolower(alpha), id = id, include = isTRUE(include), 39 | cl = c('custom_blend_grob', 'filter_grob')) 40 | } 41 | #' @export 42 | with_blend_custom.Layer <- function(x, bg_layer, a = 0, b = 0, c = 0, d = 0, 43 | flip_order = FALSE, alpha = NA, ..., id = NULL, 44 | include = is.null(id)) { 45 | filter_layer_constructor(x, with_blend_custom, 'CustomBlendedGeom', a = a, b = b, 46 | c = c, d = d, flip_order = flip_order, alpha = alpha, ..., 47 | include = include, ids = list(id = id, bg_layer = bg_layer)) 48 | } 49 | #' @export 50 | with_blend_custom.list <- function(x, bg_layer, a = 0, b = 0, c = 0, d = 0, 51 | flip_order = FALSE, alpha = NA, ..., id = NULL, 52 | include = is.null(id)) { 53 | filter_list_constructor(x, with_blend_custom, 'CustomBlendedGeom', a = a, b = b, 54 | c = c, d = d, flip_order = flip_order, alpha = alpha, ..., 55 | include = include, ids = list(id = id, bg_layer = bg_layer)) 56 | } 57 | #' @export 58 | with_blend_custom.ggplot <- function(x, bg_layer, a = 0, b = 0, c = 0, d = 0, 59 | flip_order = FALSE, alpha = NA, ignore_background = TRUE, 60 | ...) { 61 | filter_ggplot_constructor(x, with_blend_custom, bg_layer = bg_layer, a = a, b = b, 62 | c = c, d = d, flip_order = flip_order, alpha = alpha, 63 | ..., ignore_background = ignore_background) 64 | } 65 | #' @export 66 | with_blend_custom.character <- function(x, bg_layer, a = 0, b = 0, c = 0, d = 0, 67 | flip_order = FALSE, alpha = NA, ..., id = NULL, 68 | include = is.null(id)) { 69 | filter_character_constructor(x, with_blend_custom, 'CustomBlendedGeom', a = a, 70 | b = b, c = c, d = d, flip_order = FALSE, alpha = alpha, 71 | ..., include = include, ids = list(id = id, bg_layer = bg_layer)) 72 | } 73 | #' @export 74 | with_blend_custom.function <- with_blend_custom.character 75 | #' @export 76 | with_blend_custom.formula <- with_blend_custom.character 77 | #' @export 78 | with_blend_custom.raster <- with_blend_custom.character 79 | #' @export 80 | with_blend_custom.nativeRaster <- with_blend_custom.character 81 | #' @export 82 | with_blend_custom.element <- function(x, bg_layer, a = 0, b = 0, c = 0, d = 0, 83 | flip_order = FALSE, alpha = NA, ...) { 84 | filter_element_constructor(x, with_blend_custom, bg_layer = bg_layer, a = a, 85 | b = b, c = c, d = d, flip_order = flip_order, 86 | alpha = alpha, ...) 87 | } 88 | #' @export 89 | with_blend_custom.guide <- function(x, bg_layer, a = 0, b = 0, c = 0, d = 0, 90 | flip_order = FALSE, alpha = NA, ...) { 91 | filter_guide_constructor(x, with_blend_custom, bg_layer = bg_layer, a = a, 92 | b = b, c = c, d = d, flip_order = flip_order, 93 | alpha = alpha, ...) 94 | } 95 | 96 | #' @rdname raster_helpers 97 | #' @importFrom magick image_read image_blur image_destroy image_composite geometry_size_pixels image_info image_resize image_convert 98 | #' @export 99 | #' @keywords internal 100 | blend_custom_raster <- function(x, bg_layer, a, b, c, d, flip_order = FALSE, alpha = NA) { 101 | raster <- image_read(x) 102 | dim <- image_info(raster) 103 | bg_layer <- get_layer(bg_layer) 104 | bg_layer <- image_read(bg_layer) 105 | bg_layer <- image_resize(bg_layer, geometry_size_pixels(dim$width, dim$height, FALSE)) 106 | layers <- list(bg_layer, raster) 107 | if (flip_order) layers <- rev(layers) 108 | result <- image_composite(layers[[1]], layers[[2]], 'Mathematics', 109 | compose_args = paste(a, b, c, d, sep = ',')) 110 | if (!is.na(alpha)) { 111 | alpha_mask <- if (alpha == 'src') layers[[2]] else layers[[1]] 112 | result <- image_composite(alpha_mask, result, operator = 'in') 113 | } 114 | x <- as.integer(result) 115 | image_destroy(raster) 116 | image_destroy(bg_layer) 117 | image_destroy(result) 118 | x 119 | } 120 | 121 | #' @importFrom grid makeContent setChildren gList 122 | #' @export 123 | makeContent.custom_blend_grob <- function(x) { 124 | ras <- rasterise_grob(x$grob) 125 | raster <- blend_custom_raster(ras$raster, x$bg_layer, x$a, x$b, x$c, x$d, x$flip_order) 126 | raster <- groberize_raster(raster, ras$location, ras$dimension, x$id, x$include) 127 | setChildren(x, gList(raster)) 128 | } 129 | -------------------------------------------------------------------------------- /R/bloom.R: -------------------------------------------------------------------------------- 1 | #' Apply bloom to your layer 2 | #' 3 | #' Bloom is the effect of strong light sources spilling over into neighbouring 4 | #' dark areas. It is used a lot in video games and movies to give the effect of 5 | #' strong light, even though the monitor is not itself capable of showing light 6 | #' at that strength. 7 | #' 8 | #' @param threshold_lower,threshold_upper The lowest channel value to consider 9 | #' emitting light and the highest channel value that should be considered 10 | #' maximum light strength, given in percent 11 | #' @param sigma The standard deviation of the gaussian kernel used for the 12 | #' bloom. Will affect the size of the halo around light objects 13 | #' @param strength A value between 0 and 1 to use for changing the strength of 14 | #' the effect. 15 | #' @param keep_alpha Should the alpha channel of the layer be kept, effectively 16 | #' limiting the bloom effect to the filtered layer. Setting this to false will 17 | #' allow the bloom to spill out to the background, but since it is not being 18 | #' blended correctly with the background the effect looks off. 19 | #' @inheritParams with_blur 20 | #' 21 | #' @return Depending on the input, either a `grob`, `Layer`, list of `Layer`s, 22 | #' `guide`, or `element` object. Assume the output can be used in the same 23 | #' context as the input. 24 | #' 25 | #' @export 26 | #' 27 | #' @examples 28 | #' library(ggplot2) 29 | #' points <- data.frame( 30 | #' x = runif(1000), 31 | #' y = runif(1000), 32 | #' col = runif(1000) 33 | #' ) 34 | #' ggplot(points, aes(x, y, colour = col)) + 35 | #' with_bloom( 36 | #' geom_point(size = 10), 37 | #' ) + 38 | #' scale_colour_continuous(type = 'viridis') 39 | #' 40 | with_bloom <- function(x, threshold_lower = 80, threshold_upper = 100, 41 | sigma = 5, strength = 1, keep_alpha = TRUE, ...) { 42 | UseMethod('with_bloom') 43 | } 44 | #' @importFrom grid gTree 45 | #' @export 46 | with_bloom.grob <- function(x, threshold_lower = 80, threshold_upper = 100, 47 | sigma = 5, strength = 1, keep_alpha = TRUE, ..., background = NULL, 48 | id = NULL, include = is.null(id)) { 49 | gTree(grob = x, threshold_lower = threshold_lower, 50 | threshold_upper = threshold_upper, sigma = sigma, strength = strength, 51 | keep_alpha = keep_alpha, background = background, id = id, 52 | include = isTRUE(include), cl = c('bloom_grob', 'filter_grob')) 53 | } 54 | #' @export 55 | with_bloom.Layer <- function(x, threshold_lower = 80, threshold_upper = 100, 56 | sigma = 5, strength = 1, keep_alpha = TRUE, ..., id = NULL, 57 | include = is.null(id)) { 58 | filter_layer_constructor(x, with_bloom, 'BloomGeom', 59 | threshold_lower = threshold_lower, 60 | threshold_upper = threshold_upper, sigma = sigma, 61 | strength = strength, keep_alpha = keep_alpha, ..., 62 | include = include, ids = list(id = id)) 63 | } 64 | #' @export 65 | with_bloom.list <- function(x, threshold_lower = 80, threshold_upper = 100, 66 | sigma = 5, strength = 1, keep_alpha = TRUE, ..., id = NULL, 67 | include = is.null(id)) { 68 | filter_list_constructor(x, with_bloom, 'BloomGeom', 69 | threshold_lower = threshold_lower, 70 | threshold_upper = threshold_upper, sigma = sigma, 71 | strength = strength, keep_alpha = keep_alpha, ..., 72 | include = include, ids = list(id = id)) 73 | } 74 | #' @export 75 | with_bloom.ggplot <- function(x, threshold_lower = 80, threshold_upper = 100, 76 | sigma = 5, strength = 1, keep_alpha = TRUE, 77 | ignore_background = TRUE, ...) { 78 | filter_ggplot_constructor(x, with_bloom, threshold_lower = threshold_lower, 79 | threshold_upper = threshold_upper, sigma = sigma, 80 | strength = strength, keep_alpha = keep_alpha, ..., 81 | ignore_background = ignore_background) 82 | } 83 | #' @export 84 | with_bloom.character <- function(x, threshold_lower = 80, threshold_upper = 100, 85 | sigma = 5, strength = 1, keep_alpha = TRUE, ..., id = NULL, 86 | include = is.null(id)) { 87 | filter_character_constructor(x, with_bloom, 'BloomGeom', 88 | threshold_lower = threshold_lower, 89 | threshold_upper = threshold_upper, sigma = sigma, 90 | strength = strength, keep_alpha = keep_alpha, ..., 91 | include = include, ids = list(id = id)) 92 | } 93 | #' @export 94 | with_bloom.function <- with_bloom.character 95 | #' @export 96 | with_bloom.formula <- with_bloom.character 97 | #' @export 98 | with_bloom.raster <- with_bloom.character 99 | #' @export 100 | with_bloom.nativeRaster <- with_bloom.character 101 | #' @export 102 | with_bloom.element <- function(x, threshold_lower = 80, threshold_upper = 100, 103 | sigma = 5, strength = 1, keep_alpha = TRUE, ...) { 104 | filter_element_constructor(x, with_bloom, threshold_lower = threshold_lower, 105 | threshold_upper = threshold_upper, sigma = sigma, 106 | strength = strength, keep_alpha = keep_alpha, ...) 107 | } 108 | #' @export 109 | with_bloom.guide <- function(x, threshold_lower = 80, threshold_upper = 100, 110 | sigma = 5, strength = 1, keep_alpha = TRUE, ...) { 111 | filter_guide_constructor(x, with_bloom, threshold_lower = threshold_lower, 112 | threshold_upper = threshold_upper, sigma = sigma, 113 | strength = strength, keep_alpha = keep_alpha, ...) 114 | } 115 | 116 | #' @rdname raster_helpers 117 | #' @importFrom magick image_read image_level image_blur image_destroy image_composite 118 | #' @export 119 | #' @keywords internal 120 | bloom_raster <- function(x, threshold_lower = 80, threshold_upper = 100, 121 | sigma = 5, strength = 1, keep_alpha = TRUE) { 122 | raster <- image_read(x) 123 | dim <- image_info(raster) 124 | bloom <- image_level(raster, threshold_lower, threshold_upper) 125 | bloom <- image_blur(bloom, radius = 0, sigma = sigma) 126 | bloom <- image_composite( 127 | raster, 128 | image_composite(raster, bloom, 'LinearDodge'), 'Blend', 129 | compose_args = paste(as.integer(strength * 100)) 130 | ) 131 | if (keep_alpha) { 132 | bloom <- image_composite(bloom, raster, 'CopyOpacity') 133 | } 134 | x <- as.integer(bloom) 135 | image_destroy(raster) 136 | image_destroy(bloom) 137 | x 138 | } 139 | 140 | #' @importFrom grid makeContent setChildren gList 141 | #' @export 142 | makeContent.bloom_grob <- function(x) { 143 | ras <- rasterise_grob(x$grob) 144 | raster <- bloom_raster(ras$raster, x$threshold_lower, x$threshold_upper, 145 | to_pixels(x$sigma), x$strength, x$keep_alpha) 146 | raster <- groberize_raster(raster, ras$location, ras$dimension, x$id, x$include) 147 | setChildren(x, gList(x$background, raster)) 148 | } 149 | -------------------------------------------------------------------------------- /R/blur.R: -------------------------------------------------------------------------------- 1 | #' Apply a gaussian blur to your layer 2 | #' 3 | #' This filter adds a blur to the provided ggplot layer. The amount of blur can 4 | #' be controlled and the result can optionally be put underneath the original 5 | #' layer. 6 | #' 7 | #' @param x A ggplot2 layer object, a ggplot, a grob, or a character string 8 | #' naming a filter 9 | #' @param sigma The standard deviation of the gaussian kernel. Increase it to 10 | #' apply more blurring. If a numeric it will be interpreted as given in pixels. 11 | #' If a unit object it will automatically be converted to pixels at rendering 12 | #' time 13 | #' @param stack Should the original layer be placed on top? 14 | #' @param ... Arguments to be passed on to methods. See 15 | #' [the documentation of supported object][object_support] for a description of 16 | #' object specific arguments. 17 | #' 18 | #' @return Depending on the input, either a `grob`, `Layer`, list of `Layer`s, 19 | #' `guide`, or `element` object. Assume the output can be used in the same 20 | #' context as the input. 21 | #' 22 | #' @family blur filters 23 | #' 24 | #' @export 25 | #' 26 | #' @examples 27 | #' library(ggplot2) 28 | #' ggplot(mtcars, aes(mpg, disp)) + 29 | #' with_blur(geom_point(data = mtcars, size = 3), sigma = 3) 30 | #' 31 | with_blur <- function(x, sigma = 0.5, stack = FALSE, ...) { 32 | UseMethod('with_blur') 33 | } 34 | #' @importFrom grid gTree 35 | #' @export 36 | with_blur.grob <- function(x, sigma, stack = FALSE, background = NULL, 37 | ..., id = NULL, include = is.null(id)) { 38 | gTree(grob = x, sigma = sigma, background = background, stack = stack, id = id, 39 | include = isTRUE(include), cl = c('blur_grob', 'filter_grob')) 40 | } 41 | #' @export 42 | with_blur.Layer <- function(x, sigma = 0.5, stack = FALSE, ..., id = NULL, 43 | include = is.null(id)) { 44 | filter_layer_constructor(x, with_blur, 'BlurredGeom', sigma = sigma, 45 | stack = stack, ..., include = include, 46 | ids = list(id = id)) 47 | } 48 | #' @export 49 | with_blur.list <- function(x, sigma = 0.5, stack = FALSE, ..., id = NULL, 50 | include = is.null(id)) { 51 | filter_list_constructor(x, with_blur, 'BlurredGeom', sigma = sigma, 52 | stack = stack, ..., include = include, 53 | ids = list(id = id)) 54 | } 55 | #' @export 56 | with_blur.ggplot <- function(x, sigma = 0.5, stack = FALSE, 57 | ignore_background = TRUE, ...) { 58 | filter_ggplot_constructor(x, with_blur, sigma = sigma, stack = stack, ..., 59 | ignore_background = ignore_background) 60 | } 61 | #' @export 62 | with_blur.character <- function(x, sigma = 0.5, stack = FALSE, ..., id = NULL, 63 | include = is.null(id)) { 64 | filter_character_constructor(x, with_blur, 'BlurredGeom', sigma = sigma, 65 | stack = stack, ..., include = include, 66 | ids = list(id = id)) 67 | } 68 | #' @export 69 | with_blur.function <- with_blur.character 70 | #' @export 71 | with_blur.formula <- with_blur.character 72 | #' @export 73 | with_blur.raster <- with_blur.character 74 | #' @export 75 | with_blur.nativeRaster <- with_blur.character 76 | #' @export 77 | with_blur.element <- function(x, sigma = 0.5, stack = FALSE, ...) { 78 | filter_element_constructor(x, with_blur, sigma = sigma, stack = stack, ...) 79 | } 80 | #' @export 81 | with_blur.guide <- function(x, sigma = 0.5, stack = FALSE, ...) { 82 | filter_guide_constructor(x, with_blur, sigma = sigma, stack = stack, ...) 83 | } 84 | 85 | #' @rdname raster_helpers 86 | #' @importFrom magick image_read image_blur image_destroy image_composite 87 | #' @return A nativeRaster object 88 | #' @export 89 | #' @keywords internal 90 | blur_raster <- function(x, sigma = 0.5, stack = FALSE) { 91 | raster <- image_read(x) 92 | blurred <- image_blur(raster, radius = 0, sigma = sigma) 93 | if (stack) { 94 | blurred <- image_composite(blurred, raster) 95 | } 96 | x <- as.integer(blurred) 97 | image_destroy(raster) 98 | image_destroy(blurred) 99 | x 100 | } 101 | 102 | #' @importFrom grid makeContent setChildren gList 103 | #' @export 104 | makeContent.blur_grob <- function(x) { 105 | ras <- rasterise_grob(x$grob) 106 | raster <- blur_raster(ras$raster, to_pixels(x$sigma), x$stack) 107 | raster <- groberize_raster(raster, ras$location, ras$dimension, x$id, x$include) 108 | setChildren(x, gList(x$background, raster)) 109 | } 110 | -------------------------------------------------------------------------------- /R/channels.R: -------------------------------------------------------------------------------- 1 | #' Set a channel of interest from a layer 2 | #' 3 | #' Some effects uses a particular channel for specific parameters, such as 4 | #' [with_displacement()], which grabs the relative x and y displacements from 5 | #' different channels in some other layer. To facilitate specifying which 6 | #' channel to use from a layer (which is always multichannel), you can wrap the 7 | #' specification in a channel specifier given below. If a filter requires a 8 | #' specific channel and none is specified it will default to `luminance` (based 9 | #' on the `hcl` colour space) 10 | #' 11 | #' @param x Any object interpretable as a layer 12 | #' @param colourspace The colourspace the channel should be extracted from. 13 | #' @param channel The name of a channel in the given colourspace 14 | #' @param invert Should the channel values be inverted before use 15 | #' 16 | #' @return `x` with a channel spec attached 17 | #' 18 | #' @rdname channel_spec 19 | #' @name Channels 20 | #' 21 | #' @examples 22 | #' library(ggplot2) 23 | #' volcano_long <- data.frame( 24 | #' x = as.vector(col(volcano)), 25 | #' y = as.vector(row(volcano)), 26 | #' z = as.vector(volcano) 27 | #' ) 28 | #' 29 | #' # invert the green channel 30 | #' ggplot(volcano_long, aes(y, x)) + 31 | #' as_reference( 32 | #' geom_contour_filled(aes(z = z, fill = after_stat(level))), 33 | #' id = 'contours' 34 | #' ) + 35 | #' as_colourspace( 36 | #' ch_red('contours'), 37 | #' ch_green('contours', invert = TRUE), 38 | #' ch_blue('contours') 39 | #' ) 40 | #' 41 | NULL 42 | 43 | #' @rdname channel_spec 44 | #' @export 45 | ch_red <- function(x, colourspace = 'sRGB', invert = FALSE) { 46 | set_channel(x, 'Red', colourspace = colourspace, invert = invert) 47 | } 48 | #' @rdname channel_spec 49 | #' @export 50 | ch_green <- function(x, colourspace = 'sRGB', invert = FALSE) { 51 | set_channel(x, 'Green', colourspace = colourspace, invert = invert) 52 | } 53 | #' @rdname channel_spec 54 | #' @export 55 | ch_blue <- function(x, colourspace = 'sRGB', invert = FALSE) { 56 | set_channel(x, 'Blue', colourspace = colourspace, invert = invert) 57 | } 58 | #' @rdname channel_spec 59 | #' @export 60 | ch_alpha <- function(x, colourspace = 'sRGB', invert = FALSE) { 61 | set_channel(x, 'Alpha', colourspace = colourspace, invert = invert) 62 | } 63 | #' @rdname channel_spec 64 | #' @export 65 | ch_hue <- function(x, colourspace = 'HCL', invert = FALSE) { 66 | set_channel(x, 'Hue', colourspace = colourspace, invert = invert) 67 | } 68 | #' @rdname channel_spec 69 | #' @export 70 | ch_chroma <- function(x, colourspace = 'HCL', invert = FALSE) { 71 | set_channel(x, 'Chroma', colourspace = colourspace, invert = invert) 72 | } 73 | #' @rdname channel_spec 74 | #' @export 75 | ch_luminance <- function(x, colourspace = 'HCL', invert = FALSE) { 76 | set_channel(x, 'Luminance', colourspace = colourspace, invert = invert) 77 | } 78 | #' @rdname channel_spec 79 | #' @export 80 | ch_saturation <- function(x, colourspace = 'HSL', invert = FALSE) { 81 | set_channel(x, 'Saturation', colourspace = colourspace, invert = invert) 82 | } 83 | #' @rdname channel_spec 84 | #' @export 85 | ch_lightness <- function(x, colourspace = 'HSL', invert = FALSE) { 86 | set_channel(x, 'Lightness', colourspace = colourspace, invert = invert) 87 | } 88 | #' @rdname channel_spec 89 | #' @export 90 | ch_cyan <- function(x, colourspace = 'CMYK', invert = FALSE) { 91 | set_channel(x, 'Cyan', colourspace = colourspace, invert = invert) 92 | } 93 | #' @rdname channel_spec 94 | #' @export 95 | ch_magenta <- function(x, colourspace = 'CMYK', invert = FALSE) { 96 | set_channel(x, 'Magenta', colourspace = colourspace, invert = invert) 97 | } 98 | #' @rdname channel_spec 99 | #' @export 100 | ch_yellow <- function(x, colourspace = 'CMYK', invert = FALSE) { 101 | set_channel(x, 'Yellow', colourspace = colourspace, invert = invert) 102 | } 103 | #' @rdname channel_spec 104 | #' @export 105 | ch_black <- function(x, colourspace = 'CMYK', invert = FALSE) { 106 | set_channel(x, 'Black', colourspace = colourspace, invert = invert) 107 | } 108 | #' @rdname channel_spec 109 | #' @export 110 | ch_key <- ch_black 111 | #' @rdname channel_spec 112 | #' @export 113 | ch_custom <- function(x, channel, colourspace, invert = FALSE) { 114 | set_channel(x, channel, colourspace = colourspace, invert = invert) 115 | } 116 | 117 | ch_default <- function(x) { 118 | if (!has_channel(x)) { 119 | ch_luminance(x) 120 | } else { 121 | x 122 | } 123 | } 124 | 125 | has_channel <- function(x) { 126 | !is.null(attr(x, 'layer_channel')) 127 | } 128 | set_channel <- function(x, channel, colourspace, invert = invert) { 129 | attr(x, 'layer_channel') <- channel 130 | attr(x, 'channel_colourspace') <- colourspace 131 | attr(x, 'invert') <- invert 132 | x 133 | } 134 | get_channel <- function(x) { 135 | attr(x, 'layer_channel') 136 | } 137 | get_channel_space <- function(x) { 138 | attr(x, 'channel_colourspace') 139 | } 140 | get_channel_inverted <- function(x) { 141 | attr(x, 'invert') 142 | } 143 | -------------------------------------------------------------------------------- /R/circle_dither.R: -------------------------------------------------------------------------------- 1 | #' @rdname with_ordered_dither 2 | #' 3 | #' @param black Should the map consist of dark circles expanding into the light, 4 | #' or the reverse 5 | #' 6 | #' @export 7 | with_circle_dither <- function(x, map_size = 7, levels = NULL, black = TRUE, 8 | colourspace = 'sRGB', offset = NULL, ...) { 9 | UseMethod('with_circle_dither') 10 | } 11 | #' @importFrom grid gTree 12 | #' @export 13 | with_circle_dither.grob <- function(x, map_size = 7, levels = NULL, 14 | black = TRUE, colourspace = 'sRGB', 15 | offset = NULL, background = NULL, ..., 16 | id = NULL, include = is.null(id)) { 17 | if (!map_size %in% c(5, 6, 7)) { 18 | abort('Unknown map size. Possible values are: 5, 6, or 7') 19 | } 20 | map <- paste0('c', map_size, 'x', map_size, if (black) 'b' else 'w') 21 | if (length(levels) > 0) { 22 | map <- paste0(map, ',', paste(as.integer(levels), collapse = ',')) 23 | } 24 | gTree(grob = x, map = map, colourspace = tolower(colourspace), offset = offset, 25 | background = background, id = id, include = isTRUE(include), 26 | cl = c('ordered_dither_grob', 'filter_grob')) 27 | } 28 | #' @export 29 | with_circle_dither.Layer <- function(x, map_size = 7, levels = NULL, 30 | black = TRUE, colourspace = 'sRGB', 31 | offset = NULL, ..., id = NULL, 32 | include = is.null(id)) { 33 | filter_layer_constructor(x, with_circle_dither, 'CircleDitheredGeom', 34 | map_size = map_size, levels = levels, black = black, 35 | colourspace = colourspace, offset = offset, ..., 36 | include = include, ids = list(id = id)) 37 | } 38 | #' @export 39 | with_circle_dither.list <- function(x, map_size = 7, levels = NULL, 40 | black = TRUE, colourspace = 'sRGB', 41 | offset = NULL, ..., id = NULL, 42 | include = is.null(id)) { 43 | filter_list_constructor(x, with_circle_dither, 'CircleDitheredGeom', 44 | map_size = map_size, levels = levels, black = black, 45 | colourspace = colourspace, offset = offset, ..., 46 | include = include, ids = list(id = id)) 47 | } 48 | #' @export 49 | with_circle_dither.ggplot <- function(x, map_size = 7, levels = NULL, 50 | black = TRUE, colourspace = 'sRGB', 51 | offset = NULL, ignore_background = TRUE, 52 | ...) { 53 | filter_ggplot_constructor(x, with_circle_dither, map_size = map_size, 54 | levels = levels, black = black, 55 | colourspace = colourspace, offset = offset, ..., 56 | ignore_background = ignore_background) 57 | } 58 | #' @export 59 | with_circle_dither.character <- function(x, map_size = 7, levels = NULL, 60 | black = TRUE, colourspace = 'sRGB', 61 | offset = NULL, ..., id = NULL, 62 | include = is.null(id)) { 63 | filter_character_constructor(x, with_circle_dither, 'CircleDitheredGeom', 64 | map_size = map_size, levels = levels, 65 | black = black, colourspace = colourspace, 66 | offset = offset, ..., include = include, 67 | ids = list(id = id)) 68 | } 69 | #' @export 70 | with_circle_dither.function <- with_circle_dither.character 71 | #' @export 72 | with_circle_dither.formula <- with_circle_dither.character 73 | #' @export 74 | with_circle_dither.raster <- with_circle_dither.character 75 | #' @export 76 | with_circle_dither.nativeRaster <- with_circle_dither.character 77 | #' @export 78 | with_circle_dither.element <- function(x, map_size = 7, levels = NULL, 79 | black = TRUE, colourspace = 'sRGB', 80 | offset = NULL, ...) { 81 | filter_element_constructor(x, with_circle_dither, map_size = map_size, 82 | levels = levels, black = black, 83 | colourspace = colourspace, offset = offset, ...) 84 | } 85 | #' @export 86 | with_circle_dither.guide <- function(x, map_size = 7, levels = NULL, 87 | black = TRUE, colourspace = 'sRGB', 88 | offset = NULL, ...) { 89 | filter_guide_constructor(x, with_circle_dither, map_size = map_size, 90 | levels = levels, black = black, 91 | colourspace = colourspace, offset = offset, ...) 92 | } 93 | -------------------------------------------------------------------------------- /R/colourspaces.R: -------------------------------------------------------------------------------- 1 | #' Collect channels into a single layer of a specific colourspace 2 | #' 3 | #' If you need to work on single channels one by one you can use the different 4 | #' [ch_*()][ch_red] selectors. If the result needs to be combined again into a 5 | #' colour layer you can use `as_colourspace` and pass in the required channels 6 | #' to make up the colourspace. By default the alpha channel will be created as 7 | #' the combination of the alpha channels from the provided channel layers. 8 | #' Alternatively you can set `auto_opacity = FALSE` and provide one additional 9 | #' channel which will then be used as alpha. 10 | #' 11 | #' @param ... A range of layers to combine. If there are no channel spec set the 12 | #' luminosity will be used 13 | #' @param colourspace Which colourspace should the provided colour channels be 14 | #' interpreted as coming from. 15 | #' @param auto_opacity Should the opacity be derived from the input layers or 16 | #' taken from a provided alpha channel 17 | #' @inheritParams as_reference 18 | #' 19 | #' @return A list of `Layer` objects 20 | #' 21 | #' @family layer references 22 | #' 23 | #' @export 24 | #' 25 | #' @examples 26 | #' library(ggplot2) 27 | #' 28 | #' segments <- data.frame( 29 | #' x = runif(300), 30 | #' y = runif(300), 31 | #' xend = runif(300), 32 | #' yend = runif(300) 33 | #' ) 34 | #' 35 | #' # We use 'white' as that is the maximum value in all channels 36 | #' ggplot(mapping = aes(x, y, xend = xend, yend = yend)) + 37 | #' as_colourspace( 38 | #' geom_segment(data = segments[1:100,], colour = 'white'), 39 | #' geom_segment(data = segments[101:200,], colour = 'white'), 40 | #' geom_segment(data = segments[201:300,], colour = 'white'), 41 | #' colourspace = 'CMY' 42 | #' ) 43 | #' 44 | as_colourspace <- function(..., colourspace = 'sRGB', auto_opacity = TRUE, 45 | id = NULL, include = is.null(id)) { 46 | UseMethod("as_colourspace") 47 | } 48 | #' @importFrom ggplot2 geom_blank 49 | #' @importFrom grid gTree 50 | #' @export 51 | as_colourspace.Layer <- function(..., colourspace = 'sRGB', auto_opacity = TRUE, 52 | id = NULL, include = is.null(id)) { 53 | layers <- list(...) 54 | ids <- as.list(paste0('__<', id, '>__<', seq_along(layers), '>__')) 55 | needs_channel <- !vapply(layers, has_channel, logical(1)) 56 | ids[needs_channel] <- lapply(ids[needs_channel], ch_luminance) 57 | layers <- Map(as_reference, x = layers, id = ids) 58 | if (any(!vapply(layers, inherits, logical(1), 'Layer'))) { 59 | abort('All objects must be layers references') 60 | } 61 | group_layer <- filter_layer_constructor( 62 | geom_blank(data = data.frame(x = 1), inherit.aes = FALSE), 63 | function(x, ..., id) { 64 | gTree(grob = x, colourspace = colourspace, auto_opacity = auto_opacity, id = id, include = include, 65 | ids = list(...), cl = c('combined_channels_grob', 'filter_grob')) 66 | }, 67 | 'CombinedGeom', 68 | ids = c(list(id = id), ids)) 69 | c(layers, list(group_layer)) 70 | } 71 | #' @export 72 | as_colourspace.list <- as_colourspace.Layer 73 | #' @export 74 | as_colourspace.character <- as_colourspace.Layer 75 | #' @export 76 | as_colourspace.function <- as_colourspace.Layer 77 | #' @export 78 | as_colourspace.formula <- as_colourspace.Layer 79 | #' @export 80 | as_colourspace.raster <- as_colourspace.Layer 81 | #' @export 82 | as_colourspace.nativeRaster <- as_colourspace.Layer 83 | 84 | #' @importFrom grid makeContent setChildren gList 85 | #' @export 86 | makeContent.combined_channels_grob <- function(x) { 87 | ras <- rasterise_grob(x$grob) 88 | channels <- lapply(x$ids, get_layer_channel) 89 | raster <- image_combine(do.call(c, channels), colorspace = x$colourspace) 90 | lapply(channels, image_destroy) 91 | if (x$auto_opacity) { 92 | opacity <- lapply(x$ids, get_layer_channel, alpha = TRUE) 93 | final_opacity <- Reduce(function(b, t) image_composite(b, t, 'plus'), opacity) 94 | raster <- image_composite(raster, final_opacity, 'CopyOpacity') 95 | lapply(opacity, image_destroy) 96 | image_destroy(final_opacity) 97 | } 98 | raster <- groberize_raster(raster, ras$location, ras$dimension, x$id, x$include) 99 | setChildren(x, gList(raster)) 100 | } 101 | -------------------------------------------------------------------------------- /R/custom.R: -------------------------------------------------------------------------------- 1 | #' Apply a custom filter 2 | #' 3 | #' This function allows you to apply a custom filtering function to a layer. The 4 | #' function must take a `nativeRaster` object as the first argument along with 5 | #' any other arguments passed to `...`. Be aware that the raster spans the full 6 | #' device size and not just the viewport currently rendered to. This is because 7 | #' graphics may extend outside of the viewport depending on the clipping 8 | #' settings. You can use [get_viewport_area()] along with all the other raster 9 | #' helpers provided by ggfx to facilitate working with the input raster. See the 10 | #' example below for some inspiration. 11 | #' 12 | #' @param filter A function taking a `nativeRaster` object as the first argument 13 | #' along with whatever you pass in to `...` 14 | #' @param ... Additional arguments to `filter` 15 | #' @inheritParams with_blur 16 | #' 17 | #' @return Depending on the input, either a `grob`, `Layer`, list of `Layer`s, 18 | #' `guide`, or `element` object. Assume the output can be used in the same 19 | #' context as the input. 20 | #' 21 | #' @export 22 | #' 23 | #' @examples 24 | #' library(ggplot2) 25 | #' flip_raster <- function(raster, horizontal = TRUE) { 26 | #' # Get the viewport area of the raster 27 | #' vp <- get_viewport_area(raster) 28 | #' 29 | #' # Get the columns and rows of the raster - reverse order depending on 30 | #' # the value of horizontal 31 | #' dims <- dim(vp) 32 | #' rows <- seq_len(dims[1]) 33 | #' cols <- seq_len(dims[2]) 34 | #' if (horizontal) { 35 | #' cols <- rev(cols) 36 | #' } else { 37 | #' rows <- rev(rows) 38 | #' } 39 | #' 40 | #' # change the order of columns or rows in the viewport raster 41 | #' vp <- index_raster(vp, cols, rows) 42 | #' 43 | #' # Assign the modified viewport back 44 | #' set_viewport_area(raster, vp) 45 | #' } 46 | #' 47 | #' ggplot() + 48 | #' with_custom( 49 | #' geom_text(aes(0.5, 0.75, label = 'Flippediflop!'), size = 10), 50 | #' filter = flip_raster, 51 | #' horizontal = TRUE 52 | #' ) 53 | #' 54 | #' ggplot() + 55 | #' with_custom( 56 | #' geom_text(aes(0.5, 0.75, label = 'Flippediflop!'), size = 10), 57 | #' filter = flip_raster, 58 | #' horizontal = FALSE 59 | #' ) 60 | #' 61 | with_custom <- function(x, filter, ...) { 62 | UseMethod('with_custom') 63 | } 64 | #' @importFrom grid gTree 65 | #' @export 66 | with_custom.grob <- function(x, filter, ..., background = NULL, id = NULL, 67 | include = is.null(id)) { 68 | gTree(grob = x, filter = filter, args = list(...), background = background, 69 | id = id, include = isTRUE(include), cl = c('custom_filter_grob', 'filter_grob')) 70 | } 71 | #' @export 72 | with_custom.Layer <- function(x, filter, ..., id = NULL, include = is.null(id)) { 73 | filter_layer_constructor(x, with_custom, 'CustomFilteredGeom', filter = filter, 74 | ..., include = include, ids = list(id = id)) 75 | } 76 | #' @export 77 | with_custom.list <- function(x, filter, ..., id = NULL, include = is.null(id)) { 78 | filter_list_constructor(x, with_custom, 'CustomFilteredGeom', filter = filter, 79 | ..., include = include, ids = list(id = id)) 80 | } 81 | #' @export 82 | with_custom.ggplot <- function(x, filter, ignore_background = TRUE, ...) { 83 | filter_ggplot_constructor(x, with_custom, filter = filter, ..., 84 | ignore_background = ignore_background) 85 | } 86 | #' @export 87 | with_custom.character <- function(x, filter, ..., id = NULL, include = is.null(id)) { 88 | filter_character_constructor(x, with_custom, 'CustomFilteredGeom', filter = filter, 89 | ..., include = include, ids = list(id = id)) 90 | } 91 | #' @export 92 | with_custom.function <- with_custom.character 93 | #' @export 94 | with_custom.formula <- with_custom.character 95 | #' @export 96 | with_custom.raster <- with_custom.character 97 | #' @export 98 | with_custom.nativeRaster <- with_custom.character 99 | #' @export 100 | with_custom.element <- function(x, filter, ...) { 101 | filter_element_constructor(x, with_custom, filter = filter, ...) 102 | } 103 | #' @export 104 | with_custom.guide <- function(x, filter, ...) { 105 | filter_guide_constructor(x, with_custom, filter = filter, ...) 106 | } 107 | 108 | #' @importFrom grid makeContent setChildren gList 109 | #' @export 110 | makeContent.custom_filter_grob <- function(x) { 111 | ras <- rasterise_grob(x$grob) 112 | raster <- do.call(x$filter, c(list(ras$raster), x$args)) 113 | raster <- groberize_raster(raster, ras$location, ras$dimension, x$id, x$include) 114 | setChildren(x, gList(x$background, raster)) 115 | } 116 | -------------------------------------------------------------------------------- /R/custom_dither.R: -------------------------------------------------------------------------------- 1 | #' @rdname with_ordered_dither 2 | #' 3 | #' @param map The name of the threshold map to use as understood by 4 | #' [magick::image_ordered_dither()] 5 | #' 6 | #' @export 7 | #' 8 | with_custom_dither <- function(x, map = 'checks', levels = NULL, 9 | colourspace = 'sRGB', offset = NULL, ...) { 10 | UseMethod('with_custom_dither') 11 | } 12 | #' @importFrom grid gTree 13 | #' @export 14 | with_custom_dither.grob <- function(x, map = 'checks', levels = NULL, 15 | colourspace = 'sRGB', offset = NULL, 16 | background = NULL, ..., id = NULL, 17 | include = is.null(id)) { 18 | if (length(levels) > 0) { 19 | map <- paste0(map, ',', paste(as.integer(levels), collapse = ',')) 20 | } 21 | gTree(grob = x, map = map, colourspace = tolower(colourspace), offset = offset, 22 | background = background, id = id, include = isTRUE(include), 23 | cl = c('ordered_dither_grob', 'filter_grob')) 24 | } 25 | #' @export 26 | with_custom_dither.Layer <- function(x, map = 'checks', levels = NULL, 27 | colourspace = 'sRGB', offset = NULL, ..., 28 | id = NULL, include = is.null(id)) { 29 | filter_layer_constructor(x, with_custom_dither, 'CustomDitheredGeom', 30 | map = map, levels = levels, colourspace = colourspace, 31 | offset = offset, ..., include = include, 32 | ids = list(id = id)) 33 | } 34 | #' @export 35 | with_custom_dither.list <- function(x, map = 'checks', levels = NULL, 36 | colourspace = 'sRGB', offset = NULL, ..., 37 | id = NULL, include = is.null(id)) { 38 | filter_list_constructor(x, with_custom_dither, 'CustomDitheredGeom', 39 | map = map, levels = levels, colourspace = colourspace, 40 | offset = offset, ..., include = include, 41 | ids = list(id = id)) 42 | } 43 | #' @export 44 | with_custom_dither.ggplot <- function(x, map = 'checks', levels = NULL, 45 | colourspace = 'sRGB', offset = NULL, 46 | ignore_background = TRUE, ...) { 47 | filter_ggplot_constructor(x, with_custom_dither, map = map, 48 | levels = levels, colourspace = colourspace, 49 | offset = offset, ..., 50 | ignore_background = ignore_background) 51 | } 52 | #' @export 53 | with_custom_dither.character <- function(x, map = 'checks', levels = NULL, 54 | colourspace = 'sRGB', offset = NULL, ..., 55 | id = NULL, include = is.null(id)) { 56 | filter_character_constructor(x, with_custom_dither, 'CustomDitheredGeom', 57 | map = map, levels = levels, 58 | colourspace = colourspace, offset = offset, ..., 59 | include = include, ids = list(id = id)) 60 | } 61 | #' @export 62 | with_custom_dither.function <- with_custom_dither.character 63 | #' @export 64 | with_custom_dither.formula <- with_custom_dither.character 65 | #' @export 66 | with_custom_dither.raster <- with_custom_dither.character 67 | #' @export 68 | with_custom_dither.nativeRaster <- with_custom_dither.character 69 | #' @export 70 | with_custom_dither.element <- function(x, map = 'checks', levels = NULL, 71 | colourspace = 'sRGB', offset = NULL, ...) { 72 | filter_element_constructor(x, with_custom_dither, map = map, levels = levels, 73 | colourspace = colourspace, offset = offset, ...) 74 | } 75 | #' @export 76 | with_custom_dither.guide <- function(x, map = 'checks', levels = NULL, 77 | colourspace = 'sRGB', offset = NULL, ...) { 78 | filter_guide_constructor(x, with_custom_dither, map = map, levels = levels, 79 | colourspace = colourspace, offset = offset, ...) 80 | } 81 | -------------------------------------------------------------------------------- /R/displace.R: -------------------------------------------------------------------------------- 1 | #' Apply a displacement map to a layer 2 | #' 3 | #' This filter displaces the pixels based on the colour values of another layer 4 | #' or raster object. As such it can be used to distort the content of the layer. 5 | #' 6 | #' @param x_map,y_map The displacement maps to use. Can either be a string 7 | #' identifying a registered filter, or a raster object. The maps will be resized 8 | #' to match the dimensions of x. Only one channel will be used - see 9 | #' [the docs on channels][Channels] for info on how to set them. 10 | #' @param x_scale,y_scale How much displacement should a maximal channel value 11 | #' correspond to? If a numeric it will be interpreted as pixel dimensions. If a 12 | #' unit object it will be converted to pixel dimension when rendered. 13 | #' @inheritParams with_blur 14 | #' 15 | #' @return Depending on the input, either a `grob`, `Layer`, list of `Layer`s, 16 | #' `guide`, or `element` object. Assume the output can be used in the same 17 | #' context as the input. 18 | #' 19 | #' @export 20 | #' 21 | #' @examples 22 | #' library(ggplot2) 23 | #' ggplot() + 24 | #' as_reference( 25 | #' geom_polygon(aes(c(0, 1, 1), c(0, 0, 1)), colour = NA, fill = 'magenta' ), 26 | #' id = "displace_map" 27 | #' ) + 28 | #' with_displacement( 29 | #' geom_text(aes(0.5, 0.5, label = 'Displacements!'), size = 10), 30 | #' x_map = ch_red("displace_map"), 31 | #' y_map = ch_blue("displace_map"), 32 | #' x_scale = unit(0.025, 'npc'), 33 | #' y_scale = unit(0.025, 'npc') 34 | #' ) 35 | #' 36 | with_displacement <- function(x, x_map, y_map = x_map, x_scale = 1, y_scale = x_scale, ...) { 37 | UseMethod('with_displacement') 38 | } 39 | #' @importFrom grid gTree 40 | #' @export 41 | with_displacement.grob <- function(x, x_map, y_map = x_map, x_scale = 1, y_scale = x_scale, ..., 42 | background = NULL, id = NULL, include = is.null(id)) { 43 | gTree(grob = x, x_map = x_map, y_map = y_map, x_scale = x_scale, 44 | y_scale = y_scale, background = background, id = id, 45 | include = isTRUE(include), cl = c('displacement_grob', 'filter_grob')) 46 | } 47 | #' @export 48 | with_displacement.Layer <- function(x, x_map, y_map = x_map, x_scale = 1, y_scale = x_scale, ..., 49 | id = NULL, include = is.null(id)) { 50 | filter_layer_constructor(x, with_displacement, 'DisplacedGeom', x_scale = x_scale, 51 | y_scale = y_scale, ..., include = include, 52 | ids = list(id = id, x_map = x_map, y_map = y_map)) 53 | } 54 | #' @export 55 | with_displacement.list <- function(x, x_map, y_map = x_map, x_scale = 1, y_scale = x_scale, ..., 56 | id = NULL, include = is.null(id)) { 57 | filter_list_constructor(x, with_displacement, 'DisplacedGeom', x_scale = x_scale, 58 | y_scale = y_scale, ..., include = include, 59 | ids = list(id = id, x_map = x_map, y_map = y_map)) 60 | } 61 | #' @export 62 | with_displacement.ggplot <- function(x, x_map, y_map = x_map, x_scale = 1, y_scale = x_scale, 63 | ignore_background = TRUE, ...) { 64 | filter_ggplot_constructor(x, with_displacement, x_map = x_map, y_map = y_map, 65 | x_scale = x_scale, y_scale = y_scale, ..., 66 | ignore_background = ignore_background) 67 | } 68 | #' @export 69 | with_displacement.character <- function(x, x_map, y_map = x_map, x_scale = 1, y_scale = x_scale, ..., 70 | id = NULL, include = is.null(id)) { 71 | filter_character_constructor(x, with_displacement, 'DisplacedGeom', x_scale = x_scale, 72 | y_scale = y_scale, ..., include = include, 73 | ids = list(id = id, x_map = x_map, y_map = y_map)) 74 | } 75 | #' @export 76 | with_displacement.function <- with_displacement.character 77 | #' @export 78 | with_displacement.formula <- with_displacement.character 79 | #' @export 80 | with_displacement.raster <- with_displacement.character 81 | #' @export 82 | with_displacement.nativeRaster <- with_displacement.character 83 | #' @export 84 | with_displacement.element <- function(x, x_map, y_map = x_map, x_scale = 1, y_scale = x_scale, ...) { 85 | filter_element_constructor(x, with_displacement, x_map = x_map, y_map = y_map, 86 | x_scale = x_scale, y_scale = y_scale, ...) 87 | } 88 | #' @export 89 | with_displacement.guide <- function(x, x_map, y_map = x_map, x_scale = 1, y_scale = x_scale, ...) { 90 | filter_guide_constructor(x, with_displacement, x_map = x_map, y_map = y_map, 91 | x_scale = x_scale, y_scale = y_scale, ...) 92 | } 93 | 94 | #' @rdname raster_helpers 95 | #' @importFrom magick image_read image_blur image_destroy image_composite geometry_size_pixels image_info image_resize image_combine 96 | #' @export 97 | #' @keywords internal 98 | displace_raster <- function(x, x_map, y_map = x_map, x_scale = 1, y_scale = x_scale) { 99 | raster <- image_read(x) 100 | dim <- image_info(raster) 101 | x_map <- get_layer_channel(x_map) 102 | x_map <- image_resize(x_map, geometry_size_pixels(dim$width, dim$height, FALSE)) 103 | y_map <- get_layer_channel(y_map) 104 | y_map <- image_resize(y_map, geometry_size_pixels(dim$width, dim$height, FALSE)) 105 | map <- image_combine(c(x_map, y_map)) 106 | raster <- image_composite(raster, map, 'displace', compose_args = paste0(x_scale, 'x', y_scale)) 107 | x <- as.integer(raster) 108 | image_destroy(raster) 109 | image_destroy(map) 110 | image_destroy(x_map) 111 | image_destroy(y_map) 112 | x 113 | } 114 | 115 | #' @importFrom grid makeContent setChildren gList 116 | #' @export 117 | makeContent.displacement_grob <- function(x) { 118 | ras <- rasterise_grob(x$grob) 119 | raster <- displace_raster(ras$raster, x$x_map, x$y_map, to_pixels(x$x_scale), to_pixels(x$y_scale)) 120 | raster <- groberize_raster(raster, ras$location, ras$dimension, x$id, x$include) 121 | setChildren(x, gList(x$background, raster)) 122 | } 123 | -------------------------------------------------------------------------------- /R/dither.R: -------------------------------------------------------------------------------- 1 | #' Dither image using Floyd-Steinberg error correction dithering 2 | #' 3 | #' This filter reduces the number of colours in your layer and uses the 4 | #' Floyd-Steinberg algorithm to even out the error introduced by the colour 5 | #' reduction. 6 | #' 7 | #' @param max_colours The maximum number of colours to use. The result may 8 | #' contain fewer colours but never more. 9 | #' @param colourspace In which colourspace should the dithering be calculated 10 | #' @inheritParams with_blur 11 | #' 12 | #' @return Depending on the input, either a `grob`, `Layer`, list of `Layer`s, 13 | #' `guide`, or `element` object. Assume the output can be used in the same 14 | #' context as the input. 15 | #' 16 | #' @family dithering filters 17 | #' 18 | #' @export 19 | #' 20 | #' @examples 21 | #' library(ggplot2) 22 | #' ggplot(faithfuld, aes(waiting, eruptions)) + 23 | #' with_dither( 24 | #' geom_raster(aes(fill = density), interpolate = TRUE), 25 | #' max_colours = 10 26 | #' ) + 27 | #' scale_fill_continuous(type = 'viridis') 28 | #' 29 | with_dither <- function(x, max_colours = 256, colourspace = 'sRGB', ...) { 30 | UseMethod('with_dither') 31 | } 32 | #' @importFrom grid gTree 33 | #' @export 34 | with_dither.grob <- function(x, max_colours = 256, colourspace = 'sRGB', 35 | background = NULL, ..., id = NULL, 36 | include = is.null(id)) { 37 | gTree(grob = x, max_colours = max_colours, colourspace = colourspace, 38 | background = background, id = id, include = isTRUE(include), 39 | cl = c('dither_grob', 'filter_grob')) 40 | } 41 | #' @export 42 | with_dither.Layer <- function(x, max_colours = 256, colourspace = 'sRGB', ..., 43 | id = NULL, include = is.null(id)) { 44 | filter_layer_constructor(x, with_dither, 'DitheredGeom', 45 | max_colours = max_colours, colourspace = colourspace, 46 | ..., include = include, ids = list(id = id)) 47 | } 48 | #' @export 49 | with_dither.list <- function(x, max_colours = 256, colourspace = 'sRGB', ..., 50 | id = NULL, include = is.null(id)) { 51 | filter_list_constructor(x, with_dither, 'DitheredGeom', 52 | max_colours = max_colours, colourspace = colourspace, 53 | ..., include = include, ids = list(id = id)) 54 | } 55 | #' @export 56 | with_dither.ggplot <- function(x, max_colours = 256, colourspace = 'sRGB', 57 | ignore_background = TRUE, ...) { 58 | filter_ggplot_constructor(x, with_dither, max_colours = max_colours, 59 | colourspace = colourspace, ..., 60 | ignore_background = ignore_background) 61 | } 62 | #' @export 63 | with_dither.character <- function(x, max_colours = 256, colourspace = 'sRGB', ..., 64 | id = NULL, include = is.null(id)) { 65 | filter_character_constructor(x, with_dither, 'DitheredGeom', 66 | max_colours = max_colours, 67 | colourspace = colourspace, ..., include = include, 68 | ids = list(id = id)) 69 | } 70 | #' @export 71 | with_dither.function <- with_dither.character 72 | #' @export 73 | with_dither.formula <- with_dither.character 74 | #' @export 75 | with_dither.raster <- with_dither.character 76 | #' @export 77 | with_dither.nativeRaster <- with_dither.character 78 | #' @export 79 | with_dither.element <- function(x, max_colours = 256, colourspace = 'sRGB', ...) { 80 | filter_element_constructor(x, with_dither, max_colours = max_colours, 81 | colourspace = colourspace, ...) 82 | } 83 | #' @export 84 | with_dither.guide <- function(x, max_colours = 256, colourspace = 'sRGB', ...) { 85 | filter_guide_constructor(x, with_dither, max_colours = max_colours, 86 | colourspace = colourspace, ...) 87 | } 88 | 89 | #' @rdname raster_helpers 90 | #' @importFrom magick image_read image_quantize image_destroy image_composite 91 | #' @export 92 | #' @keywords internal 93 | dither_raster <- function(x, max_colours = 256, colourspace = 'sRGB') { 94 | raster <- image_read(x) 95 | dithered <- image_quantize(raster, max = max_colours, colorspace = colourspace) 96 | x <- as.integer(dithered) 97 | image_destroy(raster) 98 | image_destroy(dithered) 99 | x 100 | } 101 | 102 | #' @importFrom grid makeContent setChildren gList 103 | #' @export 104 | makeContent.dither_grob <- function(x) { 105 | ras <- rasterise_grob(x$grob) 106 | raster <- dither_raster(ras$raster, x$max_colours, x$colourspace) 107 | raster <- groberize_raster(raster, ras$location, ras$dimension, x$id, x$include) 108 | setChildren(x, gList(x$background, raster)) 109 | } 110 | -------------------------------------------------------------------------------- /R/doc-object-support.R: -------------------------------------------------------------------------------- 1 | #' Supported object types 2 | #' 3 | #' The different filters provided by ggfx are applicable to a wide range of 4 | #' object types. Rather than documenting how to use them with each type in every 5 | #' documentation entry, the information is collected here. While the examples 6 | #' will use [with_blur()] they are general and applicable to all filters in 7 | #' ggfx. 8 | #' 9 | #' @section Method specific arguments: 10 | #' 11 | #' - `id`: A string that identifies the result of this filter, to be referenced 12 | #' by other filters in the same graphic. 13 | #' - `include`: A logical flag that indicates whether the filtered image should 14 | #' be displayed. By default, the result will not be displayed if it is given 15 | #' an `id` (as it is assumed that it is meant for later use), but this can be 16 | #' overewritten by setting `include = TRUE`. 17 | #' - `ignore_background`: Should the background of the plot be removed before 18 | #' applying the filter and re-added afterwards? 19 | #' - `background`: A grob to draw below the result of the filter. Mainly for 20 | #' internal use for supporting `ignore_background`. 21 | #' 22 | #' @section Filtering layers: 23 | #' This is perhaps the most common and obvious use of ggfx, and the one 24 | #' show-cased in the respective docs of each filter. In order to apply a filter 25 | #' to a ggplot2 layer you wrap it around the layer constructor (usually a 26 | #' `geom_*()` function) and pass in additional parameters after it: 27 | #' 28 | #' ```r 29 | #' ggplot(mtcars) + 30 | #' with_blur( 31 | #' geom_point(aes(x = mpg, y = disp)), 32 | #' sigma = 4 33 | #' ) 34 | #' ``` 35 | #' 36 | #' Apart from the arguments specific to the filter, layer filters also take an 37 | #' `id`, and `include` argument. Providing an id (as a string) will make this 38 | #' filter be referable by other filters. By default this turns of rendering of 39 | #' the result, but setting `include = TRUE` will turn rendering back on (while 40 | #' still making it referable). Referable layers should **always** come before 41 | #' whatever other layer ends up referring to them, since ggfx does not have 42 | #' control over the rendering order. Not following this rule will have undefined 43 | #' consequences (either an error or a weird plot - or maybe the correct result) 44 | #' 45 | #' @section Filtering layer references: 46 | #' While the first argument to a filter is mostly some sort of graphic 47 | #' generating object, it can also be a text string referring to another filter. 48 | #' This allows you to string together filters, should you so choose. The big 49 | #' caveat is that filtering a reference will always result in a layer - i.e. it 50 | #' is not compatible outside of ggplot2. 51 | #' 52 | #' ```r 53 | #' ggplot(mtcars) + 54 | #' with_blur( 55 | #' geom_point(aes(x = mpg, y = disp)), 56 | #' sigma = 4, 57 | #' id = 'blurred_points' 58 | #' ) + 59 | #' with_shadow( 60 | #' 'blurred_points' 61 | #' ) 62 | #' ``` 63 | #' 64 | #' @section Filtering guides: 65 | #' ggplot2 does not only consist of layers - there are all sort of other graphic 66 | #' elements around them. Guides are one such type of element and these can be 67 | #' filtered by wrapping the filter around the guide constructor: 68 | #' 69 | #' ```r 70 | #' ggplot(mtcars) + 71 | #' geom_point(aes(x = mpg, y = disp, colour = gear)) + 72 | #' guides(colour = with_blur(guide_colourbar(), sigma = 4)) 73 | #' ``` 74 | #' 75 | #' There is a caveat here in that it is not possible to use this with the string 76 | #' shorthand (i.e. `with_blur('colourbar')` won't work) — you have to use the 77 | #' functional form. 78 | #' 79 | #' @section Filtering theme elements: 80 | #' Theme elements, like guides, is another non-layer graphic that is amenable to 81 | #' filtering. It can be done by wrapping the `element_*()` constructor with a 82 | #' filter: 83 | #' 84 | #' ```r 85 | #' ggplot(mtcars) + 86 | #' geom_point(aes(x = mpg, y = disp)) + 87 | #' ggtitle("A blurry title") + 88 | #' theme(plot.title = with_blur(element_text(), sigma = 4)) 89 | #' ``` 90 | #' 91 | #' There is a caveat here as well. The filtering doesn't get carried through 92 | #' inheritance so you cannot set filtering at a top-level element and expect all 93 | #' child elements to be filtered. 94 | #' 95 | #' @section Filtering ggplots: 96 | #' While you normally only want to add a filter to a part of the plot, it is 97 | #' also possible to add it to everthing, simply by wrapping the filter function 98 | #' around the plot. You can elect to remove the background element while 99 | #' applying the filter and add it back on afterwards by setting 100 | #' `ignore_background = TRUE` on the filter 101 | #' 102 | #' ```r 103 | #' p <- ggplot(mtcars) + 104 | #' geom_point(aes(x = mpg, y = disp)) 105 | #' 106 | #' with_blur(p, sigma = 4) 107 | #' ``` 108 | #' 109 | #' An alternative is to put the filter around the [ggplot()] call, which will 110 | #' have the same effect and may fit better with your plot construction code 111 | #' 112 | #' ```r 113 | #' with_blur(ggplot(mtcars), sigma = 4) + 114 | #' geom_point(aes(x = mpg, y = disp)) 115 | #' ``` 116 | #' 117 | #' @section Filtering grobs: 118 | #' At the lowest level, it is possible to apply a filter to a grob. This is what 119 | #' powers all of the above at some level and that power is also available to 120 | #' you. It is done in the same manner as all of the above, by wrapping the grob 121 | #' in a filter: 122 | #' 123 | #' ```r 124 | #' blurred_circle <- with_blur(circleGrob(), sigma = 4) 125 | #' 126 | #' grid.newpage() 127 | #' grid.draw(blurred_circle) 128 | #' ``` 129 | #' 130 | #' As with layers, filters applied to grobs also take an `id` and `include` 131 | #' argument and they have the same effect. It should be noted that it can be 132 | #' difficult to grasp the rendering order of elements in a manually created grid 133 | #' graphics, so take care when using filters that refer to each other as the 134 | #' rule about the rendering order still applies. 135 | #' 136 | #' There are not a lot of people who use grid directly, but if you develop 137 | #' ggplot2 extensions the ability to apply filters to grobs means that you can 138 | #' create geoms with filters build right into them! 139 | #' 140 | #' @rdname object_support 141 | #' @name object_support 142 | #' 143 | #' @return All filters will generally return a new version of the same object, 144 | #' the only exception being filtering of rasters, functions, and references 145 | #' which returns a Layer object 146 | NULL 147 | -------------------------------------------------------------------------------- /R/filter-constructors.R: -------------------------------------------------------------------------------- 1 | #' @importFrom ggplot2 ggproto 2 | filter_layer_constructor <- function(x, .filter, .name, ..., ids) { 3 | parent_geom <- x$geom 4 | ggproto(NULL, x, 5 | geom = ggproto(.name, parent_geom, 6 | draw_layer = function(self, data, params, layout, coord) { 7 | grobs <- parent_geom$draw_layer(data, params, layout, coord) 8 | lapply(seq_along(grobs), function(i) { 9 | refs <- lapply(ids, raster_id, index = i) 10 | do.call(.filter, c(list(grobs[[i]], ...), refs)) 11 | }) 12 | } 13 | ) 14 | ) 15 | } 16 | 17 | filter_list_constructor <- function(x, .filter, .name, ..., ids) { 18 | is_layer <- vapply(x, inherits, logical(1), what = 'Layer') 19 | if (sum(is_layer) == 0) { 20 | warn('Nothing to apply a filter to') 21 | } else if (sum(is_layer) == 1) { 22 | x[[which(is_layer)]] <- filter_layer_constructor(x[[which(is_layer)]], .filter, .name, ..., ids = ids) 23 | } else { 24 | group_id <- sample(1e9, 1) 25 | group <- do.call(as_group, c(x[is_layer], list(id = group_id))) 26 | x <- list(group, x[!is_layer], filter_character_constructor(group_id, .filter, .name, ..., ids = ids)) 27 | } 28 | x 29 | } 30 | 31 | filter_ggplot_constructor <- function(x, .filter, ..., ignore_background) { 32 | x[['.__filter']] <- list( 33 | fun = .filter, 34 | settings = list(...), 35 | ignore_background = ignore_background 36 | ) 37 | class(x) <- c('filtered_ggplot', class(x)) 38 | x 39 | } 40 | 41 | #' @importFrom ggplot2 geom_blank ggproto 42 | filter_character_constructor <- function(x, .filter, .name, ..., ids) { 43 | layer <- geom_blank(data = data.frame(x = 1), inherit.aes = FALSE) 44 | parent_geom <- layer$geom 45 | ggproto(NULL, layer, 46 | geom = ggproto(.name, parent_geom, 47 | draw_layer = function(self, data, params, layout, coord) { 48 | grobs <- parent_geom$draw_layer(data, params, layout, coord) 49 | grobs <- lapply(seq_along(grobs), function(i) reference_grob(raster_id(x, i))) 50 | lapply(seq_along(grobs), function(i) { 51 | refs <- lapply(ids, raster_id, index = i) 52 | do.call(.filter, c(list(grobs[[i]], ...), refs)) 53 | }) 54 | } 55 | ) 56 | ) 57 | } 58 | 59 | filter_element_constructor <- function(x, .filter, ...) { 60 | x[['.__filter']] <- list( 61 | fun = .filter, 62 | settings = list(...) 63 | ) 64 | class(x) <- c('filtered_element', class(x)) 65 | x 66 | } 67 | 68 | filter_guide_constructor <- function(x, .filter, ...) { 69 | x[['.__filter']] <- list( 70 | fun = .filter, 71 | settings = list(...) 72 | ) 73 | class(x) <- c('filtered_guide', class(x)) 74 | x 75 | } 76 | -------------------------------------------------------------------------------- /R/ggfx-package.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | "_PACKAGE" 3 | 4 | # The following block is used by usethis to automatically manage 5 | # roxygen namespace tags. Modify with care! 6 | ## usethis namespace: start 7 | #' @import rlang 8 | ## usethis namespace: end 9 | NULL 10 | -------------------------------------------------------------------------------- /R/ggplot.R: -------------------------------------------------------------------------------- 1 | #' @importFrom ggplot2 ggplot_build 2 | #' @export 3 | ggplot_build.filtered_ggplot <- function(plot) { 4 | plot <- NextMethod() 5 | class(plot) <- c('filtered_gtable', class(plot)) 6 | plot 7 | } 8 | #' @importFrom ggplot2 ggplot_gtable 9 | #' @importFrom gtable gtable_filter 10 | #' @export 11 | ggplot_gtable.filtered_gtable <- function(data) { 12 | table <- NextMethod() 13 | filter <- data$plot[['.__filter']] 14 | bg <- NULL 15 | if (filter$ignore_background) { 16 | bg <- gtable_filter(table, 'background', trim = FALSE) 17 | table <- gtable_filter(table, 'background', trim = FALSE, invert = TRUE) 18 | } 19 | do.call(filter$fun, c(list(table, background = bg), filter$settings)) 20 | } 21 | 22 | #' @importFrom ggplot2 element_grob 23 | #' @export 24 | element_grob.filtered_element <- function(element, ...) { 25 | grob <- NextMethod() 26 | filter <- element[['.__filter']] 27 | do.call(filter$fun, c(list(grob), filter$settings)) 28 | } 29 | 30 | #' @importFrom ggplot2 guide_gengrob 31 | #' @export 32 | guide_gengrob.filtered_guide <- function(guide, theme) { 33 | grob <- NextMethod() 34 | filter <- guide[['.__filter']] 35 | do.call(filter$fun, c(list(grob), filter$settings)) 36 | } 37 | -------------------------------------------------------------------------------- /R/grid.R: -------------------------------------------------------------------------------- 1 | #' @importFrom grid widthDetails grobWidth 2 | #' @export 3 | widthDetails.filter_grob <- function(x) { 4 | grobWidth(x$grob) 5 | } 6 | 7 | #' @importFrom grid heightDetails grobHeight 8 | #' @export 9 | heightDetails.filter_grob <- function(x) { 10 | grobHeight(x$grob) 11 | } 12 | 13 | #' @importFrom grid ascentDetails grobAscent 14 | #' @export 15 | ascentDetails.filter_grob <- function(x) { 16 | grobAscent(x$grob) 17 | } 18 | 19 | #' @importFrom grid descentDetails grobDescent 20 | #' @export 21 | descentDetails.filter_grob <- function(x) { 22 | grobDescent(x$grob) 23 | } 24 | 25 | #' @export 26 | `[[.filter_grob` <- function(x, ..., drop = TRUE) { 27 | if (..1 %in% names(x)) { 28 | .subset2(x, ...) 29 | } else { 30 | .subset2(x, 'grob')[[...]] 31 | } 32 | } 33 | #' @export 34 | `$.filter_grob` <- function(x, name) { 35 | if (name %in% names(x)) { 36 | .subset2(x, name) 37 | } else { 38 | .subset2(x, 'grob')[[name]] 39 | } 40 | } 41 | -------------------------------------------------------------------------------- /R/group.R: -------------------------------------------------------------------------------- 1 | #' Collect layers into a group that can be treated as a single layer 2 | #' 3 | #' While you often want to apply filters to layers one by one, there are times 4 | #' when one filter should be applied to a collection of layers as if they were 5 | #' one. This can be achieved by first combining all the layers into a group with 6 | #' `as_group()` and applying the filter to the resulting group. This can only be 7 | #' done to ggplot2 layers and grobs as the other supported objects are not part 8 | #' of a graphic stack. 9 | #' 10 | #' @param ... A range of layers to combine 11 | #' @inheritParams as_reference 12 | #' 13 | #' @return A list of `Layer` objects or a [gTree][grid::gTree] depending on the 14 | #' input 15 | #' 16 | #' @family layer references 17 | #' 18 | #' @export 19 | #' 20 | #' @examples 21 | #' library(ggplot2) 22 | #' 23 | #' # With no grouping the filters on layers are applied one by one 24 | #' ggplot(mtcars, aes(mpg, disp)) + 25 | #' with_shadow(geom_smooth(alpha = 1), sigma = 4) + 26 | #' with_shadow(geom_point(), sigma = 4) 27 | #' 28 | #' # Grouping the layers allows you to apply a filter on the combined result 29 | #' ggplot(mtcars, aes(mpg, disp)) + 30 | #' as_group( 31 | #' geom_smooth(alpha = 1), 32 | #' geom_point(), 33 | #' id = 'group_1' 34 | #' ) + 35 | #' with_shadow('group_1', sigma = 4) 36 | #' 37 | as_group <- function(..., id = NULL, include = is.null(id)) { 38 | UseMethod("as_group") 39 | } 40 | #' @importFrom grid is.grob 41 | #' @export 42 | as_group.grob <- function(..., id = NULL, include = is.null(id)) { 43 | grobs <- list(...) 44 | if (any(!vapply(grobs, is.grob, logical(1)))) { 45 | abort('All objects must be grobs') 46 | } 47 | gTree(grobs = grobs, id = id, include = include, cl = 'grouped_grob') 48 | } 49 | #' @importFrom ggplot2 geom_blank 50 | #' @importFrom grid gTree 51 | #' @export 52 | as_group.Layer <- function(..., id = NULL, include = is.null(id)) { 53 | layers <- list(...) 54 | ids <- paste0('__<', id, '>__<', seq_along(layers), '>__') 55 | layers <- Map(as_reference, x = layers, id = ids) 56 | if (any(!vapply(layers, inherits, logical(1), 'Layer'))) { 57 | abort('All objects must be ggplot2 layers') 58 | } 59 | group_layer <- filter_layer_constructor( 60 | geom_blank(data = data.frame(x = 1), inherit.aes = FALSE), 61 | function(x, ..., id) { 62 | gTree(grob = x, id = id, include = include, ids = list(...), 63 | cl = c('combined_layer_grob', 'filter_grob')) 64 | }, 65 | 'CombinedGeom', 66 | ids = c(list(id = id), as.list(ids))) 67 | c(layers, list(group_layer)) 68 | } 69 | #' @export 70 | as_group.list <- as_group.Layer 71 | #' @export 72 | as_group.character <- as_group.Layer 73 | #' @export 74 | as_group.function <- as_group.Layer 75 | #' @export 76 | as_group.formula <- as_group.Layer 77 | #' @export 78 | as_group.raster <- as_group.Layer 79 | #' @export 80 | as_group.nativeRaster <- as_group.Layer 81 | 82 | #' @importFrom grid makeContent setChildren gList 83 | #' @export 84 | makeContent.grouped_grob <- function(x) { 85 | rasters <- lapply(x$grobs, rasterise_grob) 86 | location <- rasters[[1]]$location 87 | dimension <- rasters[[1]]$dimension 88 | rasters <- lapply(rasters, function(ras) image_read(ras$raster)) 89 | raster <- Reduce(function(b, t) image_composite(b, t, 'over'), rasters) 90 | lapply(rasters, image_destroy) 91 | raster <- groberize_raster(as.integer(raster), location, dimension, x$id, x$include) 92 | setChildren(x, gList(raster)) 93 | } 94 | 95 | #' @importFrom grid makeContent setChildren gList 96 | #' @export 97 | makeContent.combined_layer_grob <- function(x) { 98 | ras <- rasterise_grob(x$grob) 99 | layers <- lapply(x$ids, function(id) image_read(get_layer(id))) 100 | raster <- Reduce(function(b, t) image_composite(b, t, 'over'), layers) 101 | lapply(layers, image_destroy) 102 | raster <- groberize_raster(as.integer(raster), ras$location, ras$dimension, x$id, x$include) 103 | setChildren(x, gList(raster)) 104 | } 105 | -------------------------------------------------------------------------------- /R/halftone_dither.R: -------------------------------------------------------------------------------- 1 | #' @rdname with_ordered_dither 2 | #' 3 | #' @param angled Should the halftone pattern be at an angle or orthogonal 4 | #' @param offset The angle offset between the colour channels 5 | #' 6 | #' @export 7 | with_halftone_dither <- function(x, map_size = 8, levels = NULL, angled = TRUE, 8 | colourspace = 'sRGB', offset = NULL, ...) { 9 | UseMethod('with_halftone_dither') 10 | } 11 | #' @importFrom grid gTree 12 | #' @export 13 | with_halftone_dither.grob <- function(x, map_size = 8, levels = NULL, 14 | angled = TRUE, colourspace = 'sRGB', 15 | offset = NULL, background = NULL, ..., 16 | id = NULL, include = is.null(id)) { 17 | if (!map_size %in% c(4, 6, 8, 16)) { 18 | abort('Unknown map size. Possible values are: 4, 6, 8, or 16') 19 | } 20 | map <- paste0('h', map_size, 'x', map_size) 21 | if (angled) { 22 | if (map_size == 16) abort('map size cannot be 16 for angled halftone') 23 | map <- paste0(map, 'a') 24 | } else { 25 | map <- paste0(map, 'o') 26 | } 27 | if (length(levels) > 0) { 28 | map <- paste0(map, ',', paste(as.integer(levels), collapse = ',')) 29 | } 30 | gTree(grob = x, map = map, colourspace = tolower(colourspace), offset = offset, 31 | background = background, id = id, include = isTRUE(include), 32 | cl = c('ordered_dither_grob', 'filter_grob')) 33 | } 34 | #' @export 35 | with_halftone_dither.Layer <- function(x, map_size = 8, levels = NULL, 36 | angled = TRUE, colourspace = 'sRGB', 37 | offset = NULL, ..., id = NULL, 38 | include = is.null(id)) { 39 | filter_layer_constructor(x, with_halftone_dither, 'HalftoneDitheredGeom', 40 | map_size = map_size, levels = levels, angled = angled, 41 | colourspace = colourspace, offset = offset, ..., 42 | include = include, ids = list(id = id)) 43 | } 44 | #' @export 45 | with_halftone_dither.list <- function(x, map_size = 8, levels = NULL, 46 | angled = TRUE, colourspace = 'sRGB', 47 | offset = NULL, ..., id = NULL, 48 | include = is.null(id)) { 49 | filter_list_constructor(x, with_halftone_dither, 'HalftoneDitheredGeom', 50 | map_size = map_size, levels = levels, angled = angled, 51 | colourspace = colourspace, offset = offset, ..., 52 | include = include, ids = list(id = id)) 53 | } 54 | #' @export 55 | with_halftone_dither.ggplot <- function(x, map_size = 8, levels = NULL, 56 | angled = TRUE, colourspace = 'sRGB', 57 | offset = NULL, ignore_background = TRUE, 58 | ...) { 59 | filter_ggplot_constructor(x, with_halftone_dither, map_size = map_size, 60 | levels = levels, angled = angled, 61 | colourspace = colourspace, offset = offset, ..., 62 | ignore_background = ignore_background) 63 | } 64 | #' @export 65 | with_halftone_dither.character <- function(x, map_size = 8, levels = NULL, 66 | angled = TRUE, colourspace = 'sRGB', 67 | offset = NULL, ..., id = NULL, 68 | include = is.null(id)) { 69 | filter_character_constructor(x, with_halftone_dither, 'HalftoneDitheredGeom', 70 | map_size = map_size, levels = levels, 71 | angled = angled, colourspace = colourspace, 72 | offset = offset, ..., include = include, 73 | ids = list(id = id)) 74 | } 75 | #' @export 76 | with_halftone_dither.function <- with_halftone_dither.character 77 | #' @export 78 | with_halftone_dither.formula <- with_halftone_dither.character 79 | #' @export 80 | with_halftone_dither.raster <- with_halftone_dither.character 81 | #' @export 82 | with_halftone_dither.nativeRaster <- with_halftone_dither.character 83 | #' @export 84 | with_halftone_dither.element <- function(x, map_size = 8, levels = NULL, 85 | angled = TRUE, colourspace = 'sRGB', 86 | offset = NULL, ...) { 87 | filter_element_constructor(x, with_halftone_dither, map_size = map_size, 88 | levels = levels, angled = angled, 89 | colourspace = colourspace, offset = NULL, ...) 90 | } 91 | #' @export 92 | with_halftone_dither.guide <- function(x, map_size = 8, levels = NULL, 93 | angled = TRUE, colourspace = 'sRGB', 94 | offset = NULL, ...) { 95 | filter_guide_constructor(x, with_halftone_dither, map_size = map_size, 96 | levels = levels, angled = angled, 97 | colourspace = colourspace, offset = offset, ...) 98 | } 99 | -------------------------------------------------------------------------------- /R/inner_glow.R: -------------------------------------------------------------------------------- 1 | #' Apply an inner glow to your layer 2 | #' 3 | #' This filter adds an inner glow to your layer with a specific colour and size. 4 | #' The best effect is often had by drawing the stroke separately so the glow is 5 | #' only applied to the fill. 6 | #' 7 | #' @inheritParams with_blur 8 | #' @param colour The colour of the glow 9 | #' @param expand An added dilation to the glow mask before blurring it 10 | #' 11 | #' @return Depending on the input, either a `grob`, `Layer`, list of `Layer`s, 12 | #' `guide`, or `element` object. Assume the output can be used in the same 13 | #' context as the input. 14 | #' 15 | #' @family glow filters 16 | #' 17 | #' @export 18 | #' 19 | #' @examples 20 | #' library(ggplot2) 21 | #' 22 | #' ggplot(mtcars, aes(as.factor(gear), disp)) + 23 | #' with_inner_glow( 24 | #' geom_boxplot(), 25 | #' colour = 'red', 26 | #' sigma = 10 27 | #' ) 28 | #' 29 | #' # This gives a red tone to the lines as well which may not be desirable 30 | #' # This can be fixed by drawing fill and stroke separately 31 | #' ggplot(mtcars, aes(as.factor(gear), disp)) + 32 | #' with_inner_glow( 33 | #' geom_boxplot(colour = NA), 34 | #' colour = 'red', 35 | #' sigma = 10 36 | #' ) + 37 | #' geom_boxplot(fill = NA) 38 | #' 39 | with_inner_glow <- function(x, colour = 'black', sigma = 3, expand = 0, ...) { 40 | UseMethod('with_inner_glow') 41 | } 42 | #' @importFrom grid gTree 43 | #' @export 44 | with_inner_glow.grob <- function(x, colour = 'black', sigma = 3, expand = 0, 45 | background = NULL, ..., id = NULL, 46 | include = is.null(id)) { 47 | gTree(grob = x, colour = colour, sigma = sigma, expand = expand, 48 | background = background, id = id, include = isTRUE(include), 49 | cl = c('inner_glow_grob', 'filter_grob')) 50 | } 51 | #' @export 52 | with_inner_glow.Layer <- function(x, colour = 'black', sigma = 3, expand = 0, 53 | ..., id = NULL, include = is.null(id)) { 54 | filter_layer_constructor(x, with_inner_glow, 'InnerGlowGeom', colour = colour, 55 | sigma = sigma, expand = expand, ..., include = include, 56 | ids = list(id = id)) 57 | } 58 | #' @export 59 | with_inner_glow.list <- function(x, colour = 'black', sigma = 3, expand = 0, 60 | ..., id = NULL, include = is.null(id)) { 61 | filter_list_constructor(x, with_inner_glow, 'InnerGlowGeom', colour = colour, 62 | sigma = sigma, expand = expand, ..., include = include, 63 | ids = list(id = id)) 64 | } 65 | #' @export 66 | with_inner_glow.ggplot <- function(x, colour = 'black', sigma = 3, expand = 0, 67 | ignore_background = TRUE, ...) { 68 | filter_ggplot_constructor(x, with_inner_glow, colour = colour, sigma = sigma, 69 | expand = expand, ..., 70 | ignore_background = ignore_background) 71 | } 72 | #' @export 73 | with_inner_glow.character <- function(x, colour = 'black', sigma = 3, expand = 0, 74 | ..., id = NULL, include = is.null(id)) { 75 | filter_character_constructor(x, with_inner_glow, 'InnerGlowGeom', colour = colour, 76 | sigma = sigma, expand = expand, ..., 77 | include = include, ids = list(id = id)) 78 | } 79 | #' @export 80 | with_inner_glow.function <- with_inner_glow.character 81 | #' @export 82 | with_inner_glow.formula <- with_inner_glow.character 83 | #' @export 84 | with_inner_glow.raster <- with_inner_glow.character 85 | #' @export 86 | with_inner_glow.nativeRaster <- with_inner_glow.character 87 | #' @export 88 | with_inner_glow.element <- function(x, colour = 'black', sigma = 3, expand = 0, 89 | ...) { 90 | filter_element_constructor(x, with_inner_glow, colour = colour, sigma = sigma, 91 | expand = expand, ...) 92 | } 93 | #' @export 94 | with_inner_glow.guide <- function(x, colour = 'black', sigma = 3, expand = 0, 95 | ...) { 96 | filter_guide_constructor(x, with_inner_glow, colour = colour, sigma = sigma, 97 | expand = expand, ...) 98 | } 99 | 100 | #' @rdname raster_helpers 101 | #' @importFrom magick image_read image_blur image_destroy image_composite image_separate image_colorize image_morphology 102 | #' @export 103 | #' @keywords internal 104 | inner_glow_raster <- function(x, colour = 'black', sigma = 3, expand = 0) { 105 | raster <- image_read(x) 106 | expand <- round(expand, 1) 107 | mask <- image_negate(image_separate(raster, 'alpha')) 108 | if (expand >= 0.5) { 109 | mask <- image_morphology(mask, 'Dilate', kernel = paste0('Disk:', expand)) 110 | } 111 | glow <- image_composite( 112 | raster, 113 | mask, 114 | 'CopyOpacity' 115 | ) 116 | image_destroy(mask) 117 | glow <- image_colorize(glow, 100, colour) 118 | glow <- image_blur(glow, radius = 0, sigma = sigma) 119 | glow <- image_composite(raster, glow, 'atop') 120 | x <- as.integer(glow) 121 | image_destroy(raster) 122 | image_destroy(glow) 123 | x 124 | } 125 | 126 | #' @importFrom grid makeContent setChildren gList 127 | #' @export 128 | makeContent.inner_glow_grob <- function(x) { 129 | ras <- rasterise_grob(x$grob) 130 | raster <- inner_glow_raster(ras$raster, x$colour, to_pixels(x$sigma), to_pixels(x$expand)) 131 | raster <- groberize_raster(raster, ras$location, ras$dimension, x$id, x$include) 132 | setChildren(x, gList(x$background, raster)) 133 | } 134 | -------------------------------------------------------------------------------- /R/interpolate.R: -------------------------------------------------------------------------------- 1 | #' Blend two layerrs together by averaging them out 2 | #' 3 | #' Two layers can be blended together in the literal sense (not like 4 | #' [with_blend()]) so that the result is the average of the two. This is the 5 | #' purpose of `with_interpolate()`. 6 | #' 7 | #' @param bg_layer The layer to blend with 8 | #' @param src_percent,bg_percent The contribution of this layer and the 9 | #' background layer to the result. Should be between 0 and 100 10 | #' @inheritParams with_blur 11 | #' 12 | #' @return Depending on the input, either a `grob`, `Layer`, list of `Layer`s, 13 | #' `guide`, or `element` object. Assume the output can be used in the same 14 | #' context as the input. 15 | #' 16 | #' @family blend filters 17 | #' 18 | #' @export 19 | #' 20 | #' @examples 21 | #' library(ggplot2) 22 | #' ggplot(mpg, aes(class, hwy)) + 23 | #' as_reference(geom_boxplot(), 'box') + 24 | #' with_interpolate(geom_point(), bg_layer = 'box', src_percent = 70) 25 | #' 26 | with_interpolate <- function(x, bg_layer, src_percent, 27 | bg_percent = 100 - src_percent, ...) { 28 | UseMethod('with_interpolate') 29 | } 30 | #' @importFrom grid gTree 31 | #' @export 32 | with_interpolate.grob <- function(x, bg_layer, src_percent, 33 | bg_percent = 100 - src_percent, ..., id = NULL, 34 | include = is.null(id)) { 35 | gTree(grob = x, bg_layer = bg_layer, src_percent = src_percent, 36 | bg_percent = bg_percent, id = id, include = isTRUE(include), 37 | cl = c('interpolate_grob', 'filter_grob')) 38 | } 39 | #' @export 40 | with_interpolate.Layer <- function(x, bg_layer, src_percent, 41 | bg_percent = 100 - src_percent, ..., id = NULL, 42 | include = is.null(id)) { 43 | filter_layer_constructor(x, src_percent = src_percent, bg_percent = bg_percent, 44 | with_interpolate, 'InterpolatedGeom', ..., 45 | include = include, ids = list(id = id, bg_layer = bg_layer)) 46 | } 47 | #' @export 48 | with_interpolate.list <- function(x, bg_layer, src_percent, 49 | bg_percent = 100 - src_percent, ..., id = NULL, 50 | include = is.null(id)) { 51 | filter_list_constructor(x, src_percent = src_percent, bg_percent = bg_percent, 52 | with_interpolate, 'InterpolatedGeom', ..., 53 | include = include, ids = list(id = id, bg_layer = bg_layer)) 54 | } 55 | #' @export 56 | with_interpolate.ggplot <- function(x, bg_layer, src_percent, 57 | bg_percent = 100 - src_percent, 58 | ignore_background = TRUE, ...) { 59 | filter_ggplot_constructor(x, with_interpolate, bg_layer = bg_layer, 60 | src_percent = src_percent, bg_percent = bg_percent, 61 | ..., ignore_background = ignore_background) 62 | } 63 | #' @export 64 | with_interpolate.character <- function(x, bg_layer, src_percent, 65 | bg_percent = 100 - src_percent, ..., 66 | id = NULL, include = is.null(id)) { 67 | filter_character_constructor(x, src_percent = src_percent, bg_percent = bg_percent, 68 | with_interpolate, 'InterpolatedGeom', ..., 69 | include = include, ids = list(id = id, bg_layer = bg_layer)) 70 | } 71 | #' @export 72 | with_interpolate.function <- with_interpolate.character 73 | #' @export 74 | with_interpolate.formula <- with_interpolate.character 75 | #' @export 76 | with_interpolate.raster <- with_interpolate.character 77 | #' @export 78 | with_interpolate.nativeRaster <- with_interpolate.character 79 | #' @export 80 | with_interpolate.element <- function(x, bg_layer, src_percent, 81 | bg_percent = 100 - src_percent, ...) { 82 | filter_element_constructor(x, with_interpolate, bg_layer = bg_layer, 83 | src_percent = src_percent, bg_percent = bg_percent, 84 | ...) 85 | } 86 | #' @export 87 | with_interpolate.guide <- function(x, bg_layer, src_percent, 88 | bg_percent = 100 - src_percent, ...) { 89 | filter_guide_constructor(x, with_interpolate, bg_layer = bg_layer, 90 | src_percent = src_percent, bg_percent = bg_percent, 91 | ...) 92 | } 93 | 94 | #' @rdname raster_helpers 95 | #' @importFrom magick image_read image_blur image_destroy image_composite geometry_size_pixels image_info image_resize image_convert 96 | #' @export 97 | #' @keywords internal 98 | interpolate_raster <- function(x, bg_layer, src_percent, bg_percent) { 99 | src_percent <- max(min(src_percent, 100), 0) 100 | bg_percent <- max(min(bg_percent, 100), 0) 101 | raster <- image_read(x) 102 | dim <- image_info(raster) 103 | bg_layer <- get_layer(bg_layer) 104 | bg_layer <- image_read(bg_layer) 105 | bg_layer <- image_resize(bg_layer, geometry_size_pixels(dim$width, dim$height, FALSE)) 106 | raster <- image_composite(bg_layer, raster, 'Blend', compose_args = paste0(src_percent, 'x', bg_percent)) 107 | x <- as.integer(raster) 108 | image_destroy(raster) 109 | image_destroy(bg_layer) 110 | x 111 | } 112 | 113 | #' @importFrom grid makeContent setChildren gList 114 | #' @export 115 | makeContent.interpolate_grob <- function(x) { 116 | ras <- rasterise_grob(x$grob) 117 | raster <- interpolate_raster(ras$raster, x$bg_layer, x$src_percent, x$bg_percent) 118 | raster <- groberize_raster(raster, ras$location, ras$dimension, x$id, x$include) 119 | setChildren(x, gList(raster)) 120 | } 121 | -------------------------------------------------------------------------------- /R/kernel.R: -------------------------------------------------------------------------------- 1 | #' Apply a gaussian blur to your layer 2 | #' 3 | #' This filter allows you to apply a custom kernel to your layer, thus giving 4 | #' you more control than e.g. [with_blur()] which is also applying a kernel. 5 | #' 6 | #' @inheritParams with_blur 7 | #' @inheritParams magick::image_convolve 8 | #' 9 | #' @return Depending on the input, either a `grob`, `Layer`, list of `Layer`s, 10 | #' `guide`, or `element` object. Assume the output can be used in the same 11 | #' context as the input. 12 | #' 13 | #' @export 14 | #' 15 | #' @examples 16 | #' library(ggplot2) 17 | #' # Add directional blur using the comet kernel 18 | #' ggplot(mtcars, aes(mpg, disp)) + 19 | #' with_kernel(geom_point(size = 3), 'Comet:0,10') 20 | #' 21 | with_kernel <- function(x, kernel = 'Gaussian:0x2', iterations = 1, scaling = NULL, 22 | bias = NULL, stack = FALSE, ...) { 23 | UseMethod('with_kernel') 24 | } 25 | #' @importFrom grid gTree 26 | #' @export 27 | with_kernel.grob <- function(x, kernel = 'Gaussian:0x2', iterations = 1, 28 | scaling = NULL, bias = NULL, stack = FALSE, 29 | background = NULL, ..., id = NULL, include = is.null(id)) { 30 | gTree(grob = x, kernel = kernel, iterations = iterations, scaling = scaling, 31 | bias = bias, background = background, stack = stack, id = id, 32 | include = isTRUE(include), cl = c('kernel_grob', 'filter_grob')) 33 | } 34 | #' @export 35 | with_kernel.Layer <- function(x, kernel = 'Gaussian:0x2', iterations = 1, 36 | scaling = NULL, bias = NULL, stack = FALSE, ..., 37 | id = NULL, include = is.null(id)) { 38 | filter_layer_constructor(x, with_kernel, 'ConvolvedGeom', kernel = kernel, 39 | iterations = iterations, scaling = scaling, bias = bias, 40 | stack = stack, ..., include = include, ids = list(id = id)) 41 | } 42 | #' @export 43 | with_kernel.list <- function(x, kernel = 'Gaussian:0x2', iterations = 1, 44 | scaling = NULL, bias = NULL, stack = FALSE, ..., 45 | id = NULL, include = is.null(id)) { 46 | filter_list_constructor(x, with_kernel, 'ConvolvedGeom', kernel = kernel, 47 | iterations = iterations, scaling = scaling, bias = bias, 48 | stack = stack, ..., include = include, ids = list(id = id)) 49 | } 50 | #' @export 51 | with_kernel.ggplot <- function(x, kernel = 'Gaussian:0x2', iterations = 1, 52 | scaling = NULL, bias = NULL, stack = FALSE, 53 | ignore_background = TRUE, ...) { 54 | filter_ggplot_constructor(x, with_kernel, kernel = kernel, iterations = iterations, 55 | scaling = scaling, bias = bias, stack = stack, ..., 56 | ignore_background = ignore_background) 57 | } 58 | #' @export 59 | with_kernel.character <- function(x, kernel = 'Gaussian:0x2', iterations = 1, 60 | scaling = NULL, bias = NULL, stack = FALSE, ..., 61 | id = NULL, include = is.null(id)) { 62 | filter_character_constructor(x, with_kernel, 'ConvolvedGeom', kernel = kernel, 63 | iterations = iterations, scaling = scaling, bias = bias, 64 | stack = stack, ..., include = include, ids = list(id = id)) 65 | } 66 | #' @export 67 | with_kernel.function <- with_kernel.character 68 | #' @export 69 | with_kernel.formula <- with_kernel.character 70 | #' @export 71 | with_kernel.raster <- with_kernel.character 72 | #' @export 73 | with_kernel.nativeRaster <- with_kernel.character 74 | #' @export 75 | with_kernel.element <- function(x, kernel = 'Gaussian:0x2', iterations = 1, 76 | scaling = NULL, bias = NULL, stack = FALSE, ...) { 77 | filter_element_constructor(x, with_kernel, kernel = kernel, iterations = iterations, 78 | scaling = scaling, bias = bias, stack = stack, ...) 79 | } 80 | #' @export 81 | with_kernel.guide <- function(x, kernel = 'Gaussian:0x2', iterations = 1, 82 | scaling = NULL, bias = NULL, stack = FALSE, ...) { 83 | filter_guide_constructor(x, with_kernel, kernel = kernel, iterations = iterations, 84 | scaling = scaling, bias = bias, stack = stack, ...) 85 | } 86 | 87 | 88 | #' @rdname raster_helpers 89 | #' @importFrom magick image_read image_convolve image_destroy image_composite 90 | #' @export 91 | #' @keywords internal 92 | convolve_grob <- function(x, kernel, iterations = 1, scaling = NULL, bias = NULL, stack = FALSE) { 93 | raster <- image_read(x) 94 | convolved <- image_convolve(raster, kernel = kernel, iterations = iterations, 95 | scaling = scaling, bias = bias) 96 | if (stack) { 97 | convolved <- image_composite(convolved, raster) 98 | } 99 | x <- as.integer(convolved) 100 | image_destroy(raster) 101 | image_destroy(convolved) 102 | x 103 | } 104 | 105 | #' @importFrom grid makeContent setChildren gList 106 | #' @export 107 | makeContent.kernel_grob <- function(x) { 108 | ras <- rasterise_grob(x$grob) 109 | raster <- convolve_grob(ras$raster, x$kernel, iterations = x$iterations, 110 | scaling = x$scaling, bias = x$bias, stack = x$stack) 111 | raster <- groberize_raster(raster, ras$location, ras$dimension, x$id, x$include) 112 | setChildren(x, gList(x$background, raster)) 113 | } 114 | -------------------------------------------------------------------------------- /R/mask.R: -------------------------------------------------------------------------------- 1 | #' Apply a mask to a layer 2 | #' 3 | #' This filter applies a mask to the given layer, i.e. sets the opacity of the 4 | #' layer based on another layer 5 | #' 6 | #' @param mask The layer to use as mask. Can either be a string 7 | #' identifying a registered filter, or a raster object. Will by default extract 8 | #' the luminosity of the layer and use that as mask. To pick another channel use 9 | #' one of the [channel specification][Channels] function. 10 | #' @param invert Should the mask be inverted before applying it 11 | #' @inheritParams with_blur 12 | #' 13 | #' @return Depending on the input, either a `grob`, `Layer`, list of `Layer`s, 14 | #' `guide`, or `element` object. Assume the output can be used in the same 15 | #' context as the input. 16 | #' 17 | #' @family blend filters 18 | #' 19 | #' @export 20 | #' 21 | #' @examples 22 | #' library(ggplot2) 23 | #' volcano_raster <- as.raster((volcano - min(volcano))/diff(range(volcano))) 24 | #' circle <- data.frame( 25 | #' x = cos(seq(0, 2*pi, length.out = 360)), 26 | #' y = sin(seq(0, 2*pi, length.out = 360)) 27 | #' ) 28 | #' 29 | #' ggplot() + 30 | #' as_reference( 31 | #' geom_polygon(aes(x = x, y = y), circle), 32 | #' id = 'circle' 33 | #' ) + 34 | #' with_mask( 35 | #' annotation_raster(volcano_raster, -1, 1, -1, 1, TRUE), 36 | #' mask = ch_alpha('circle') 37 | #' ) 38 | #' 39 | #' # use invert = TRUE to flip the mask 40 | #' ggplot() + 41 | #' as_reference( 42 | #' geom_polygon(aes(x = x, y = y), circle), 43 | #' id = 'circle' 44 | #' ) + 45 | #' with_mask( 46 | #' annotation_raster(volcano_raster, -1, 1, -1, 1, TRUE), 47 | #' mask = ch_alpha('circle'), 48 | #' invert = TRUE 49 | #' ) 50 | #' 51 | with_mask <- function(x, mask, invert = FALSE, ...) { 52 | UseMethod('with_mask') 53 | } 54 | #' @importFrom grid gTree 55 | #' @export 56 | with_mask.grob <- function(x, mask, invert = FALSE, ..., background = NULL, id = NULL, 57 | include = is.null(id)) { 58 | gTree(grob = x, mask = mask, invert = invert, background = background, 59 | id = id, include = isTRUE(include), cl = c('masked_grob', 'filter_grob')) 60 | } 61 | #' @export 62 | with_mask.Layer <- function(x, mask, invert = FALSE, ..., id = NULL, include = is.null(id)) { 63 | filter_layer_constructor(x, with_mask, 'MaskedGeom', invert = invert, ..., 64 | include = include, ids = list(id = id, mask = mask)) 65 | } 66 | #' @export 67 | with_mask.list <- function(x, mask, invert = FALSE, ..., id = NULL, include = is.null(id)) { 68 | filter_list_constructor(x, with_mask, 'MaskedGeom', invert = invert, ..., 69 | include = include, ids = list(id = id, mask = mask)) 70 | } 71 | #' @export 72 | with_mask.ggplot <- function(x, mask, invert = FALSE, ignore_background = TRUE, ...) { 73 | filter_ggplot_constructor(x, with_mask, mask = mask, invert = invert, ..., 74 | ignore_background = ignore_background) 75 | } 76 | #' @export 77 | with_mask.character <- function(x, mask, invert = FALSE, ..., id = NULL, 78 | include = is.null(id)) { 79 | filter_character_constructor(x, with_mask, 'MaskedGeom', invert = invert, ..., 80 | include = include, ids = list(id = id, mask = mask)) 81 | } 82 | #' @export 83 | with_mask.function <- with_mask.character 84 | #' @export 85 | with_mask.formula <- with_mask.character 86 | #' @export 87 | with_mask.raster <- with_mask.character 88 | #' @export 89 | with_mask.nativeRaster <- with_mask.character 90 | #' @export 91 | with_mask.element <- function(x, mask, invert = FALSE, ...) { 92 | filter_element_constructor(x, with_mask, mask = mask, invert = invert, ...) 93 | } 94 | #' @export 95 | with_mask.guide <- function(x, mask, invert = FALSE, ...) { 96 | filter_guide_constructor(x, with_mask, mask = mask, invert = invert, ...) 97 | } 98 | 99 | #' @rdname raster_helpers 100 | #' @importFrom magick image_read image_info image_resize geometry_size_pixels image_separate image_combine image_negate image_blank 101 | #' @export 102 | #' @keywords internal 103 | mask_raster <- function(x, mask, invert = FALSE) { 104 | raster <- image_read(x) 105 | dim <- image_info(raster) 106 | mask <- get_layer_channel(mask) 107 | mask <- image_resize(mask, geometry_size_pixels(dim$width, dim$height, FALSE)) 108 | if (invert) { 109 | mask <- image_negate(mask) 110 | } 111 | mask <- image_composite(image_separate(raster, 'alpha'), mask, 'multiply') 112 | result <- image_composite(raster, mask, 'CopyOpacity') 113 | x <- as.integer(result) 114 | image_destroy(raster) 115 | image_destroy(mask) 116 | image_destroy(result) 117 | x 118 | } 119 | 120 | #' @importFrom grid makeContent setChildren gList 121 | #' @export 122 | makeContent.masked_grob <- function(x) { 123 | ras <- rasterise_grob(x$grob) 124 | raster <- mask_raster(ras$raster, x$mask, x$invert) 125 | raster <- groberize_raster(raster, ras$location, ras$dimension, x$id, x$include) 126 | setChildren(x, gList(x$background, raster)) 127 | } 128 | -------------------------------------------------------------------------------- /R/motion_blur.R: -------------------------------------------------------------------------------- 1 | #' Apply a motion blur to your layer 2 | #' 3 | #' This filter adds a directional blur to the provided ggplot layer. The amount 4 | #' of blur, as well as the angle, can be controlled. 5 | #' 6 | #' @param sigma The standard deviation of the gaussian kernel. Increase it to 7 | #' apply more blurring. If a numeric it will be interpreted as given in pixels. 8 | #' If a unit object it will automatically be converted to pixels at rendering 9 | #' time 10 | #' @param angle Direction of the movement in degrees (0 corresponds to a 11 | #' left-to-right motion and the angles move in clockwise direction) 12 | #' @inheritParams with_blur 13 | #' 14 | #' @return Depending on the input, either a `grob`, `Layer`, list of `Layer`s, 15 | #' `guide`, or `element` object. Assume the output can be used in the same 16 | #' context as the input. 17 | #' 18 | #' @family blur filters 19 | #' 20 | #' @export 21 | #' 22 | #' @examplesIf !ggfx:::is_rcmd_check() 23 | #' library(ggplot2) 24 | #' ggplot(mtcars, aes(mpg, disp)) + 25 | #' with_motion_blur( 26 | #' geom_point(size = 3), 27 | #' sigma = 6, 28 | #' angle = -45 29 | #' ) 30 | #' 31 | with_motion_blur <- function(x, sigma = 0.5, angle = 0, ...) { 32 | UseMethod('with_motion_blur') 33 | } 34 | #' @importFrom grid gTree 35 | #' @export 36 | with_motion_blur.grob <- function(x, sigma, angle = 0, background = NULL, ..., 37 | id = NULL, include = is.null(id)) { 38 | gTree(grob = x, sigma = sigma, background = background, angle = angle, id = id, 39 | include = isTRUE(include), cl = c('motion_blur_grob', 'filter_grob')) 40 | } 41 | #' @export 42 | with_motion_blur.Layer <- function(x, sigma = 0.5, angle = 0, ..., id = NULL, 43 | include = is.null(id)) { 44 | filter_layer_constructor(x, with_motion_blur, 'MotionBlurredGeom', 45 | sigma = sigma, angle = angle, ..., include = include, 46 | ids = list(id = id)) 47 | } 48 | #' @export 49 | with_motion_blur.list <- function(x, sigma = 0.5, angle = 0, ..., id = NULL, 50 | include = is.null(id)) { 51 | filter_list_constructor(x, with_motion_blur, 'MotionBlurredGeom', 52 | sigma = sigma, angle = angle, ..., include = include, 53 | ids = list(id = id)) 54 | } 55 | #' @export 56 | with_motion_blur.ggplot <- function(x, sigma = 0.5, angle = 0, 57 | ignore_background = TRUE, ...) { 58 | filter_ggplot_constructor(x, with_motion_blur, sigma = sigma, angle = angle, 59 | ..., ignore_background = ignore_background) 60 | } 61 | #' @export 62 | with_motion_blur.character <- function(x, sigma = 0.5, angle = 0, ..., id = NULL, 63 | include = is.null(id)) { 64 | filter_character_constructor(x, with_motion_blur, 'MotionBlurredGeom', 65 | sigma = sigma, angle = angle, ..., 66 | include = include, ids = list(id = id)) 67 | } 68 | #' @export 69 | with_motion_blur.function <- with_motion_blur.character 70 | #' @export 71 | with_motion_blur.formula <- with_motion_blur.character 72 | #' @export 73 | with_motion_blur.raster <- with_motion_blur.character 74 | #' @export 75 | with_motion_blur.nativeRaster <- with_motion_blur.character 76 | #' @export 77 | with_motion_blur.element <- function(x, sigma = 0.5, angle = 0, ...) { 78 | filter_element_constructor(x, with_motion_blur, sigma = sigma, angle = angle, 79 | ...) 80 | } 81 | #' @export 82 | with_motion_blur.guide <- function(x, sigma = 0.5, angle = 0, ...) { 83 | filter_guide_constructor(x, with_motion_blur, sigma = sigma, angle = angle, 84 | ...) 85 | } 86 | 87 | #' @rdname raster_helpers 88 | #' @importFrom magick image_read image_motion_blur image_destroy image_composite 89 | #' @export 90 | #' @keywords internal 91 | motion_blur_raster <- function(x, sigma = 0.5, angle = 0) { 92 | raster <- image_read(x) 93 | blurred <- image_motion_blur(raster, radius = 0, sigma = sigma, angle = angle) 94 | x <- as.integer(blurred) 95 | image_destroy(raster) 96 | image_destroy(blurred) 97 | x 98 | } 99 | 100 | #' @importFrom grid makeContent setChildren gList 101 | #' @export 102 | makeContent.motion_blur_grob <- function(x) { 103 | ras <- rasterise_grob(x$grob) 104 | raster <- motion_blur_raster(ras$raster, to_pixels(x$sigma), x$angle) 105 | raster <- groberize_raster(raster, ras$location, ras$dimension, x$id, x$include) 106 | setChildren(x, gList(x$background, raster)) 107 | } 108 | -------------------------------------------------------------------------------- /R/outer_glow.R: -------------------------------------------------------------------------------- 1 | #' Apply an outer glow to your layer 2 | #' 3 | #' This filter adds an outer glow to your layer with a specific colour and size. 4 | #' For very thin objects such as text it may be beneficial to add some 5 | #' expansion. See the examples for this. 6 | #' 7 | #' @inheritParams with_inner_glow 8 | #' 9 | #' @return Depending on the input, either a `grob`, `Layer`, list of `Layer`s, 10 | #' `guide`, or `element` object. Assume the output can be used in the same 11 | #' context as the input. 12 | #' 13 | #' @family glow filters 14 | #' 15 | #' @export 16 | #' 17 | #' @examples 18 | #' library(ggplot2) 19 | #' 20 | #' ggplot(mtcars, aes(as.factor(gear), disp)) + 21 | #' with_outer_glow( 22 | #' geom_boxplot(), 23 | #' colour = 'red', 24 | #' sigma = 10 25 | #' ) 26 | #' 27 | #' # For thin objects (as the whiskers above) you may need to add a bit of 28 | #' # expansion to make the glow visible: 29 | #' 30 | #' ggplot(mtcars, aes(mpg, disp)) + 31 | #' geom_point() + 32 | #' with_outer_glow( 33 | #' geom_text(aes(label = rownames(mtcars))), 34 | #' colour = 'white', 35 | #' sigma = 10, 36 | #' expand = 10 37 | #' ) 38 | #' 39 | with_outer_glow <- function(x, colour = 'black', sigma = 3, expand = 0, ...) { 40 | UseMethod('with_outer_glow') 41 | } 42 | #' @importFrom grid gTree 43 | #' @export 44 | with_outer_glow.grob <- function(x, colour = 'black', sigma = 3, expand = 0, 45 | background = NULL, ..., id = NULL, 46 | include = is.null(id)) { 47 | gTree(grob = x, colour = colour, sigma = sigma, expand = expand, 48 | background = background, id = id, include = isTRUE(include), 49 | cl = c('outer_glow_grob', 'filter_grob')) 50 | } 51 | #' @export 52 | with_outer_glow.Layer <- function(x, colour = 'black', sigma = 3, expand = 0, 53 | ..., id = NULL, include = is.null(id)) { 54 | filter_layer_constructor(x, with_outer_glow, 'OuterGlowGeom', colour = colour, 55 | sigma = sigma, expand = expand, ..., 56 | include = include, ids = list(id = id)) 57 | } 58 | #' @export 59 | with_outer_glow.list <- function(x, colour = 'black', sigma = 3, expand = 0, 60 | ..., id = NULL, include = is.null(id)) { 61 | filter_list_constructor(x, with_outer_glow, 'OuterGlowGeom', colour = colour, 62 | sigma = sigma, expand = expand, ..., 63 | include = include, ids = list(id = id)) 64 | } 65 | #' @export 66 | with_outer_glow.ggplot <- function(x, colour = 'black', sigma = 3, expand = 0, 67 | ignore_background = TRUE, ...) { 68 | filter_ggplot_constructor(x, with_outer_glow, colour = colour, sigma = sigma, 69 | expand = expand, ..., 70 | ignore_background = ignore_background) 71 | } 72 | #' @export 73 | with_outer_glow.character <- function(x, colour = 'black', sigma = 3, expand = 0, 74 | ..., id = NULL, include = is.null(id)) { 75 | filter_character_constructor(x, with_outer_glow, 'OuterGlowGeom', colour = colour, 76 | sigma = sigma, expand = expand, ..., 77 | include = include, ids = list(id = id)) 78 | } 79 | #' @export 80 | with_outer_glow.function <- with_outer_glow.character 81 | #' @export 82 | with_outer_glow.formula <- with_outer_glow.character 83 | #' @export 84 | with_outer_glow.raster <- with_outer_glow.character 85 | #' @export 86 | with_outer_glow.nativeRaster <- with_outer_glow.character 87 | #' @export 88 | with_outer_glow.element <- function(x, colour = 'black', sigma = 3, expand = 0, 89 | ...) { 90 | filter_element_constructor(x, with_outer_glow, colour = colour, sigma = sigma, 91 | expand = expand, ...) 92 | } 93 | #' @export 94 | with_outer_glow.guide <- function(x, colour = 'black', sigma = 3, expand = 0, 95 | ...) { 96 | filter_guide_constructor(x, with_outer_glow, colour = colour, sigma = sigma, 97 | expand = expand, ...) 98 | } 99 | 100 | #' @rdname raster_helpers 101 | #' @importFrom magick image_read image_blur image_destroy image_composite image_separate image_colorize image_morphology 102 | #' @export 103 | #' @keywords internal 104 | outer_glow_raster <- function(x, colour = 'black', sigma = 3, expand = 0) { 105 | raster <- image_read(x) 106 | expand <- round(expand, 1) 107 | if (expand >= 0.5) { 108 | alpha <- image_separate(raster, 'alpha') 109 | alpha <- image_morphology(alpha, method = 'Dilate', kernel = paste0('Disk:', expand)) 110 | glow <- image_composite(raster, alpha, 'CopyOpacity') 111 | } else { 112 | glow <- raster 113 | } 114 | glow <- image_colorize(glow, 100, colour) 115 | glow <- image_blur(glow, radius = 0, sigma = sigma) 116 | glow <- image_composite(glow, raster, 'over') 117 | x <- as.integer(glow) 118 | image_destroy(raster) 119 | image_destroy(glow) 120 | x 121 | } 122 | 123 | #' @importFrom grid makeContent setChildren gList 124 | #' @export 125 | makeContent.outer_glow_grob <- function(x) { 126 | ras <- rasterise_grob(x$grob) 127 | raster <- outer_glow_raster(ras$raster, x$colour, to_pixels(x$sigma), to_pixels(x$expand)) 128 | raster <- groberize_raster(raster, ras$location, ras$dimension, x$id, x$include) 129 | setChildren(x, gList(x$background, raster)) 130 | } 131 | -------------------------------------------------------------------------------- /R/raster-helpers.R: -------------------------------------------------------------------------------- 1 | #' Rendering information 2 | #' 3 | #' These utility functions can help when creating custom filters (using 4 | #' [with_custom()]) as they can provide information about the current rendering 5 | #' context. 6 | #' 7 | #' @details 8 | #' - `viewport_location()`: Returns the bounding box defining the current 9 | #' viewport in pixels in the order `xmin`, `ymin`, `xmax`, `ymax` 10 | #' - `index_raster()`: Is a version of the classic `[,]` indexing that is aware 11 | #' of the row-major order of rasters 12 | #' - `get_raster_area()`: Extracts an area of a raster based on a bounding box 13 | #' - `set_raster_area()`: Sets an area of a raster to a new raster value 14 | #' - `get_viewport_area()`: A version of `get_raster_area()` that specifically 15 | #' extract the area defined by the current viewport 16 | #' - `set_viewport_area()`: A version of `set_raster_area()` that specifically 17 | #' sets the area defined by the current viewport 18 | #' - `viewport_is_clipping()`: Returns `TRUE` if the current viewport has 19 | #' clipping turned on 20 | #' - `current_resolution()`: Returns the resolution of the active device in ppi 21 | #' (pixels-per-inch) 22 | #' - `to_pixels(x)`: Converts `x` to pixels if `x` is given as a unit object. It 23 | #' is assumed that x encodes a dimension and not a location. If `x` is a 24 | #' numeric it is assumed to already be in pixels 25 | #' - `from_pixels`: Converts a numeric giving some pixel dimension to a unit 26 | #' object. 27 | #' 28 | #' @return Depends on the function - see details. 29 | #' 30 | #' @rdname render_context 31 | #' @name render_context 32 | #' 33 | #' @examples 34 | #' # These functions are intended to be used inside filter functions, e.g. 35 | #' library(ggplot2) 36 | #' 37 | #' flip_raster <- function(raster, horizontal = TRUE) { 38 | #' # Get the viewport area of the raster 39 | #' vp <- get_viewport_area(raster) 40 | #' 41 | #' # Get the columns and rows of the raster - reverse order depending on 42 | #' # the value of horizontal 43 | #' dims <- dim(vp) 44 | #' rows <- seq_len(dims[1]) 45 | #' cols <- seq_len(dims[2]) 46 | #' if (horizontal) { 47 | #' cols <- rev(cols) 48 | #' } else { 49 | #' rows <- rev(rows) 50 | #' } 51 | #' 52 | #' # change the order of columns or rows in the viewport raster 53 | #' vp <- index_raster(vp, cols, rows) 54 | #' 55 | #' # Assign the modified viewport back 56 | #' set_viewport_area(raster, vp) 57 | #' } 58 | #' 59 | #' ggplot() + 60 | #' with_custom( 61 | #' geom_text(aes(0.5, 0.75, label = 'Flippediflop!'), size = 10), 62 | #' filter = flip_raster, 63 | #' horizontal = TRUE 64 | #' ) 65 | #' 66 | NULL 67 | 68 | #' @rdname render_context 69 | #' @importFrom grid deviceLoc 70 | #' @export 71 | viewport_location <- function() { 72 | bbox <- c(unlist(deviceLoc(unit(0, 'npc'), unit(0, 'npc'), TRUE)), 73 | unlist(deviceLoc(unit(1, 'npc'), unit(1, 'npc'), TRUE))) 74 | bbox <- bbox * current_resolution() 75 | height <- dev.size('px')[2] 76 | bbox[c(2, 4)] <- height - bbox[c(4, 2)] 77 | bbox <- as.integer(round(bbox)) 78 | names(bbox) <- c('xmin', 'ymin', 'xmax', 'ymax') 79 | bbox 80 | } 81 | 82 | #' @rdname render_context 83 | #' 84 | #' @param raster A `raster` or `nativeRaster` object 85 | #' @param cols,rows Column and row indices 86 | #' 87 | #' @export 88 | index_raster <- function(raster, cols, rows) { 89 | dims <- dim(raster) 90 | cells <- expand.grid(x = cols, y = rows) 91 | index <- (cells$y - 1) * dims[2] + cells$x 92 | area <- .subset(raster, index) 93 | class(area) <- class(raster) 94 | dim(area) <- c(length(rows), length(cols)) 95 | area 96 | } 97 | 98 | #' @rdname render_context 99 | #' 100 | #' @param xmin,ymin,xmax,ymax Boundaries of the area in pixels. {0,0} is the 101 | #' top-left corner 102 | #' 103 | #' @export 104 | get_raster_area <- function(raster, xmin, ymin, xmax, ymax) { 105 | index_raster(raster, seq(xmin, xmax), seq(ymin, ymax)) 106 | } 107 | 108 | #' @rdname render_context 109 | #' 110 | #' @param value An object of the same type as `raster` 111 | #' 112 | #' @export 113 | set_raster_area <- function(raster, value, xmin, ymin) { 114 | value_dim <- dim(value) 115 | cells <- expand.grid(x = seq(xmin, xmin + value_dim[2] - 1), y = seq(ymin, ymin + value_dim[1] - 1)) 116 | dims <- dim(raster) 117 | index <- (cells$y - 1) * dims[2] + cells$x 118 | raster[index] <- as.integer(value) 119 | raster 120 | } 121 | 122 | #' @rdname render_context 123 | #' @export 124 | get_viewport_area <- function(raster) { 125 | loc <- viewport_location() 126 | get_raster_area(raster, loc[1], loc[2], loc[3], loc[4]) 127 | } 128 | 129 | #' @rdname render_context 130 | #' @export 131 | set_viewport_area <- function(raster, value) { 132 | loc <- viewport_location() 133 | set_raster_area(raster, value, loc[1], loc[2]) 134 | } 135 | 136 | #' @rdname render_context 137 | #' @importFrom grid current.viewport 138 | #' @export 139 | viewport_is_clipping <- function() { 140 | isTRUE(current.viewport()$clip) 141 | } 142 | 143 | #' @rdname render_context 144 | #' @importFrom grDevices dev.size 145 | #' @export 146 | current_resolution <- function() { 147 | dev.size('px')[1] / dev.size('in')[1] 148 | } 149 | 150 | #' @rdname render_context 151 | #' 152 | #' @param x A numeric or unit object 153 | #' @param y_axis is the unit pertaining to the y-axis? Defaults to `FALSE` (i.e. 154 | #' it is measured on the x-axis) 155 | #' @param location is the unit encoding a location? Defaults to `FALSE` (i.e. it 156 | #' is encoding a dimension). Pixel locations are encoded based on a top-left 157 | #' starting point, as opposed to grid's bottom-left coordinate system. This 158 | #' means that y-axis locations will flip around when converted to pixels. 159 | #' 160 | #' @importFrom grid is.unit convertWidth convertHeight convertX convertY 161 | #' @export 162 | to_pixels <- function(x, y_axis = FALSE, location = FALSE) { 163 | if (is.unit(x)) { 164 | mode <- y_axis + location * 2 + 1 165 | x <- switch(mode, 166 | convertWidth(x, 'inch', valueOnly = TRUE), # FALSE FALSE 167 | convertHeight(x, 'inch', valueOnly = TRUE), # TRUE FALSE 168 | deviceLoc(x, x, valueOnly = TRUE)$x, # FALSE TRUE 169 | dev.size('in')[2] - deviceLoc(x, x, valueOnly = TRUE)$y # TRUE TRUE 170 | ) 171 | x <- x * current_resolution() 172 | } 173 | as.integer(round(x)) 174 | } 175 | 176 | #' @rdname render_context 177 | #' @importFrom grid is.unit 178 | #' @export 179 | from_pixels <- function(x) { 180 | if (!is.unit(x)) { 181 | x <- x / current_resolution() 182 | x <- unit(x, 'inch') 183 | } 184 | x 185 | } 186 | -------------------------------------------------------------------------------- /R/raster.R: -------------------------------------------------------------------------------- 1 | #' Convert a layer to a raster 2 | #' 3 | #' This filter simply converts the given layer, grob, or ggplot to a raster and 4 | #' inserts it back again. It is useful for vector graphics devices such as 5 | #' svglite if a layer contains a huge amount of primitives that would make the 6 | #' file slow to render. `as_reference(x, id)` is a shorthand for 7 | #' `with_raster(x, id = id, include = FALSE)` that makes the intent of using 8 | #' this grob or layer as only a filter reference clear. 9 | #' 10 | #' @inheritParams with_blur 11 | #' 12 | #' @return Depending on the input, either a `grob`, `Layer`, list of `Layer`s, 13 | #' `guide`, or `element` object. Assume the output can be used in the same 14 | #' context as the input. 15 | #' 16 | #' @export 17 | #' 18 | #' @examples 19 | #' library(ggplot2) 20 | #' ggplot(mtcars, aes(mpg, disp)) + 21 | #' with_raster(geom_point(data = mtcars, size = 3)) 22 | #' 23 | with_raster <- function(x, ...) { 24 | UseMethod('with_raster') 25 | } 26 | #' @importFrom grid gTree 27 | #' @export 28 | with_raster.grob <- function(x, ..., id = NULL, include = is.null(id)) { 29 | gTree(grob = x, id = id, include = isTRUE(include), cl = c('raster_grob', 'filter_grob')) 30 | } 31 | #' @export 32 | with_raster.Layer <- function(x, ..., id = NULL, include = is.null(id)) { 33 | filter_layer_constructor(x, with_raster, 'RasterisedGeom', ..., 34 | include = include, ids = list(id = id)) 35 | } 36 | #' @export 37 | with_raster.list <- function(x, ..., id = NULL, include = is.null(id)) { 38 | filter_list_constructor(x, with_raster, 'RasterisedGeom', ..., 39 | include = include, ids = list(id = id)) 40 | } 41 | #' @export 42 | with_raster.ggplot <- function(x, ignore_background = TRUE, ...) { 43 | filter_ggplot_constructor(x, with_raster, ..., ignore_background = ignore_background) 44 | } 45 | #' @export 46 | with_raster.character <- function(x, ..., id = NULL, include = is.null(id)) { 47 | filter_character_constructor(x, with_raster, 'RasterisedGeom', ..., 48 | include = include, ids = list(id = id)) 49 | } 50 | #' @export 51 | with_raster.function <- with_raster.character 52 | #' @export 53 | with_raster.formula <- with_raster.character 54 | #' @export 55 | with_raster.raster <- with_raster.character 56 | #' @export 57 | with_raster.nativeRaster <- with_raster.character 58 | #' @export 59 | with_raster.element <- function(x, ...) { 60 | filter_element_constructor(x, with_raster, ...) 61 | } 62 | #' @export 63 | with_raster.guide <- function(x, ...) { 64 | filter_guide_constructor(x, with_raster, ...) 65 | } 66 | 67 | #' @importFrom grid makeContent setChildren gList 68 | #' @export 69 | makeContent.raster_grob <- function(x) { 70 | ras <- rasterise_grob(x$grob) 71 | raster <- groberize_raster(ras$raster, ras$location, ras$dimension, x$id, x$include) 72 | setChildren(x, gList(raster)) 73 | } 74 | -------------------------------------------------------------------------------- /R/raster_store.R: -------------------------------------------------------------------------------- 1 | RasterStore <- new.env(parent = emptyenv()) 2 | RasterStore[[".__timestamps"]] <- list() 3 | 4 | store_raster <- function(raster, id) { 5 | RasterStore[[id]] <- raster 6 | RasterStore[[".__timestamps"]][[id]] <- as.integer(Sys.time()) 7 | purge_store() 8 | } 9 | fetch_raster <- function(id) { 10 | raster <- RasterStore[[id]] 11 | if (is.null(raster)) { 12 | warning("No filter with reference ", id, " available", call. = FALSE) 13 | } 14 | raster 15 | } 16 | purge_store <- function(age = 600) { 17 | too_old <- as.integer(Sys.time() - age) 18 | keep <- unlist(RasterStore[[".__timestamps"]]) > too_old 19 | RasterStore[[".__timestamps"]] <- RasterStore[[".__timestamps"]][keep] 20 | } 21 | 22 | raster_id <- function(id, index) { 23 | if (length(id) == 1 && is.character(id)) { 24 | id_attr <- attributes(id) 25 | id <- paste0(id, '_<', index, '>') 26 | attributes(id) <- id_attr 27 | } 28 | id 29 | } 30 | 31 | #' @importFrom grDevices as.raster dev.size 32 | #' @importFrom magick image_read image_convert image_separate image_negate 33 | get_layer <- function(x) { 34 | includes_channel <- has_channel(x) 35 | channel <- get_channel(x) 36 | space <- get_channel_space(x) 37 | invert <- get_channel_inverted(x) 38 | if (is_formula(x)) x <- as_function(x) 39 | if (is_function(x)) { 40 | dim <- dev.size('px') 41 | x <- x(as.integer(dim[[1]]), as.integer(dim[[2]])) 42 | } else if (length(x) == 1 && is.character(x)) { 43 | x <- fetch_raster(x) 44 | } else { 45 | if (!inherits(x, 'nativeRaster')) { 46 | x <- as.raster(x) 47 | } 48 | x <- raster_on_canvas(x) 49 | } 50 | if (includes_channel) { 51 | x <- image_read(x) 52 | alpha <- image_separate(x, 'alpha') 53 | if (tolower(space) == 'srgb') { 54 | x <- image_separate(x, channel) 55 | } else { 56 | x <- image_separate(image_convert(x, colorspace = space), channel) 57 | } 58 | if (invert) { 59 | x <- image_negate(x) 60 | } 61 | x <- image_composite(x, alpha, 'CopyOpacity') 62 | as.integer(x) 63 | } else { 64 | x 65 | } 66 | } 67 | #' @importFrom magick image_separate image_read 68 | get_layer_channel <- function(x, alpha = FALSE) { 69 | channel <- if (alpha) 'alpha' else 'red' 70 | image_separate(image_read(get_layer(ch_default(x))), channel) 71 | } 72 | 73 | reference_grob <- function(id) { 74 | gTree(id = id, cl = 'reference_grob') 75 | } 76 | is_reference_grob <- function(x) inherits(x, 'reference_grob') 77 | 78 | #' @importFrom grid deviceLoc current.parent current.viewport upViewport downViewport rasterGrob unit setChildren gList 79 | #' @export 80 | makeContent.reference_grob <- function(x) { 81 | raster <- get_layer(x$id) 82 | vp_loc <- deviceLoc(unit(0, 'npc'), unit(0, 'npc')) 83 | if (!is.null(current.parent())) { 84 | vpname <- current.viewport()$name 85 | upViewport() 86 | vp_loc2 <- deviceLoc(unit(0, 'npc'), unit(0, 'npc')) 87 | downViewport(vpname) 88 | vp_loc$x <- vp_loc$x - vp_loc2$x 89 | vp_loc$y <- vp_loc$y - vp_loc2$y 90 | } 91 | dim_size <- unit(dev.size('in'), 'in') 92 | raster <- rasterGrob(raster, 93 | x = -1 * vp_loc$x, 94 | y = -1 * vp_loc$y, 95 | width = dim_size[1], 96 | height = dim_size[2], 97 | just = c('left', 'bottom')) 98 | setChildren(x, gList(raster)) 99 | } 100 | -------------------------------------------------------------------------------- /R/rasterise_grob.R: -------------------------------------------------------------------------------- 1 | #' @importFrom grid convertWidth convertHeight unit grid.draw pushViewport viewport deviceDim deviceLoc unit.c 2 | #' @importFrom ragg agg_capture 3 | #' @importFrom grDevices dev.off dev.cur dev.set dev.size 4 | rasterise_grob <- function(grob, vp = NULL) { 5 | dim_inch <- dev.size("in") 6 | dim_pix <- dev.size("px") 7 | res <- dim_pix[1] / dim_inch[1] 8 | vp_size <- deviceDim(unit(1, 'npc'), unit(1, 'npc')) 9 | vp_loc <- deviceLoc(unit(0, 'npc'), unit(0, 'npc')) 10 | raster_loc <- unit.c(-1 * vp_loc$x, -1 * vp_loc$y) 11 | if (is.null(vp) && is_reference_grob(grob)) { 12 | return(list( 13 | raster = get_layer(grob$id), 14 | location = raster_loc, 15 | dimension = unit(dim_inch, 'inch') 16 | )) 17 | } 18 | if (is.null(vp)) vp <- viewport() 19 | vp_parent <- viewport(vp_loc$x, vp_loc$y, vp_size$w, vp_size$h, 20 | just = c('left', 'bottom'), clip = 'off') 21 | cur <- dev.cur() 22 | cap <- agg_capture( 23 | width = dim_inch[1], height = dim_inch[2], units = 'in', 24 | background = NA, res = res, scaling = getOption("ggfx.scaling", 1) 25 | ) 26 | on.exit({ 27 | dev.off() 28 | dev.set(cur) 29 | }, add = TRUE) 30 | pushViewport(vp) 31 | pushViewport(vp_parent) 32 | grid.draw(grob) 33 | list( 34 | raster = cap(native = TRUE), 35 | location = raster_loc, 36 | dimension = unit(dim_inch, 'inch') 37 | ) 38 | } 39 | 40 | #' @importFrom grid rasterGrob nullGrob 41 | groberize_raster <- function(raster, loc, dim, id, include) { 42 | if (!is.null(id)) { 43 | store_raster(raster, id) 44 | } 45 | if (!include) { 46 | return(nullGrob()) 47 | } 48 | rasterGrob(raster, x = loc[1], y = loc[2], width = dim[1], height = dim[2], 49 | just = c('left', 'bottom')) 50 | } 51 | 52 | #' Raster Helpers 53 | #' 54 | #' @name raster_helpers 55 | NULL 56 | -------------------------------------------------------------------------------- /R/reference.R: -------------------------------------------------------------------------------- 1 | #' Create a reference to a layer for use in other filters 2 | #' 3 | #' This function is basically synonymous with `with_raster()` but exist to make 4 | #' the intend of marking a layer with a specific id clear. 5 | #' 6 | #' @inheritParams with_blur 7 | #' @param id A string identifying this layer for later use 8 | #' @param include Should the layer itself be included in the graphic 9 | #' 10 | #' @return Depending on the input, either a `grob`, `Layer`, list of `Layer`s, 11 | #' `guide`, or `element` object. Assume the output can be used in the same 12 | #' context as the input. 13 | #' 14 | #' @family layer references 15 | #' 16 | #' @export 17 | #' 18 | #' @examples 19 | #' library(ggplot2) 20 | #' 21 | #' ggplot() + 22 | #' as_reference( 23 | #' geom_point(aes(20, 300), size = 100, colour = 'white'), 24 | #' id = 'mask_layer' 25 | #' ) + 26 | #' with_mask( 27 | #' geom_point(aes(mpg, disp), mtcars, size = 5), 28 | #' mask = 'mask_layer' 29 | #' ) 30 | #' 31 | #' 32 | as_reference <- function(x, id = NULL, include = is.null(id)) { 33 | with_raster(x, id = id, include = FALSE) 34 | } 35 | -------------------------------------------------------------------------------- /R/shadow.R: -------------------------------------------------------------------------------- 1 | #' Apply a drop shadow to a layer 2 | #' 3 | #' This filter applies the familiar drop-shadow effect on elements in a layer. 4 | #' It takes the outline of each shape, offsets it from its origin and applies a 5 | #' blur to it. 6 | #' 7 | #' @inheritParams with_blur 8 | #' @param colour The colour of the shadow 9 | #' @param x_offset,y_offset The offset of the shadow from the origin 10 | #' as numerics 11 | #' 12 | #' @return Depending on the input, either a `grob`, `Layer`, list of `Layer`s, 13 | #' `guide`, or `element` object. Assume the output can be used in the same 14 | #' context as the input. 15 | #' 16 | #' @export 17 | #' 18 | #' @examples 19 | #' library(ggplot2) 20 | #' ggplot(mtcars, aes(mpg, disp)) + 21 | #' with_shadow(geom_point(colour = 'red', size = 3), sigma = 3) 22 | #' 23 | with_shadow <- function(x, colour = 'black', x_offset = 10, y_offset = 10, 24 | sigma = 1, stack = TRUE, ...) { 25 | UseMethod('with_shadow') 26 | } 27 | #' @importFrom grid is.unit unit gTree 28 | #' @export 29 | with_shadow.grob <- function(x, colour = 'black', x_offset = 10, y_offset = 10, 30 | sigma = 1, stack = TRUE, background = NULL, ..., 31 | id = NULL, include = is.null(id)) { 32 | gTree(grob = x, colour = colour, x_offset = x_offset, y_offset = y_offset, 33 | sigma = sigma, background = background, stack = stack, id = id, 34 | include = isTRUE(include), cl = c('shadow_grob', 'filter_grob')) 35 | } 36 | #' @export 37 | with_shadow.Layer <- function(x, colour = 'black', x_offset = 10, y_offset = 10, 38 | sigma = 1, stack = TRUE, ..., id = NULL, 39 | include = is.null(id)) { 40 | filter_layer_constructor(x, with_shadow, 'ShadowGeom', colour = colour, 41 | x_offset = x_offset, y_offset = y_offset, sigma = sigma, 42 | stack = stack, ..., include = include, 43 | ids = list(id = id)) 44 | } 45 | #' @export 46 | with_shadow.list <- function(x, colour = 'black', x_offset = 10, y_offset = 10, 47 | sigma = 1, stack = TRUE, ..., id = NULL, 48 | include = is.null(id)) { 49 | filter_list_constructor(x, with_shadow, 'ShadowGeom', colour = colour, 50 | x_offset = x_offset, y_offset = y_offset, sigma = sigma, 51 | stack = stack, ..., include = include, 52 | ids = list(id = id)) 53 | } 54 | #' @export 55 | with_shadow.ggplot <- function(x, colour = 'black', x_offset = 10, y_offset = 10, 56 | sigma = 1, stack = TRUE, ignore_background = TRUE, 57 | ...) { 58 | filter_ggplot_constructor(x, with_shadow, colour = colour, x_offset = x_offset, 59 | y_offset = y_offset, sigma = sigma, stack = stack, 60 | ..., ignore_background = ignore_background) 61 | } 62 | #' @export 63 | with_shadow.character <- function(x, colour = 'black', x_offset = 10, y_offset = 10, 64 | sigma = 1, stack = TRUE, ..., id = NULL, 65 | include = is.null(id)) { 66 | filter_character_constructor(x, with_shadow, 'ShadowGeom', colour = colour, 67 | x_offset = x_offset, y_offset = y_offset, sigma = sigma, 68 | stack = stack, ..., include = include, 69 | ids = list(id = id)) 70 | } 71 | #' @export 72 | with_shadow.function <- with_shadow.character 73 | #' @export 74 | with_shadow.formula <- with_shadow.character 75 | #' @export 76 | with_shadow.raster <- with_shadow.character 77 | #' @export 78 | with_shadow.nativeRaster <- with_shadow.character 79 | #' @export 80 | with_shadow.element <- function(x, colour = 'black', x_offset = 10, y_offset = 10, 81 | sigma = 1, stack = TRUE, ...) { 82 | filter_element_constructor(x, with_shadow, colour = colour, x_offset = x_offset, 83 | y_offset = y_offset, sigma = sigma, stack = stack, 84 | ...) 85 | } 86 | #' @export 87 | with_shadow.guide <- function(x, colour = 'black', x_offset = 10, y_offset = 10, 88 | sigma = 1, stack = TRUE, ...) { 89 | filter_guide_constructor(x, with_shadow, colour = colour, x_offset = x_offset, 90 | y_offset = y_offset, sigma = sigma, stack = stack, ...) 91 | } 92 | 93 | #' @importFrom magick image_read image_colorize image_background image_morphology image_transparent image_blur image_destroy 94 | #' @importFrom grDevices as.raster 95 | #' @importFrom grid setChildren gList rasterGrob 96 | #' @export 97 | makeContent.shadow_grob <- function(x) { 98 | ras <- rasterise_grob( 99 | x$grob, 100 | vp = viewport(x = unit(0.5, 'npc') + from_pixels(x$x_offset), 101 | y = unit(0.5, 'npc') - from_pixels(x$y_offset)) 102 | ) 103 | raster <- image_read(ras$raster) 104 | fg <- if (x$stack) x$grob else NULL 105 | if (!is.na(x$colour)) raster <- image_colorize(raster, 100, x$colour) 106 | raster <- image_blur(raster, 0, to_pixels(x$sigma)) 107 | shadow <- as.integer(raster) 108 | image_destroy(raster) 109 | shadow <- groberize_raster(shadow, ras$location, ras$dimension, x$id, x$include) 110 | setChildren(x, gList(x$background, shadow, fg)) 111 | } 112 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | ```{r, include = FALSE} 8 | knitr::opts_chunk$set( 9 | collapse = TRUE, 10 | comment = "#>", 11 | fig.path = "man/figures/README-", 12 | out.width = "100%" 13 | ) 14 | ``` 15 | 16 | # ggfx 17 | 18 | 19 | [![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) 20 | [![Codecov test coverage](https://codecov.io/gh/thomasp85/ggfx/branch/main/graph/badge.svg)](https://app.codecov.io/gh/thomasp85/ggfx?branch=main) 21 | [![R-CMD-check](https://github.com/thomasp85/ggfx/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/thomasp85/ggfx/actions/workflows/R-CMD-check.yaml) 22 | 23 | 24 | ggfx is a (currently experimantal) package that allows the use of various 25 | filters and shaders on ggplot2 layers. 26 | 27 | ## Installation 28 | You can install ggfx from CRAN in the usual manner (`install.packages('ggfx')`) 29 | or you can grab the development version directly from github using the devtools 30 | package: 31 | 32 | ``` r 33 | # install.packages('devtools') 34 | devtools::install_github('thomasp85/ggfx') 35 | ``` 36 | 37 | ## Example 38 | The basic API of ggfx is to provide a range of `with_*()` modifier functions 39 | instead of special versions of common geoms. This means that ggfx will work with 40 | any geom from ggplot2 and the extension packages (I think...). An example 41 | showing some of the different functionalities are given below. Note that the 42 | output is produced with regular geoms. 43 | 44 | ```{r example, message=FALSE, fig.asp=0.4, dev='ragg_png', dpi=300} 45 | library(ggplot2) 46 | library(ggfx) 47 | ggplot() + 48 | as_reference( 49 | geom_polygon(aes(c(0, 1, 1), c(0, 0, 1)), colour = NA, fill = 'magenta'), 50 | id = "displace_map" 51 | ) + 52 | with_displacement( 53 | geom_text(aes(0.5, 0.5, label = 'ggfx-ggfx'), size = 25, fontface = 'bold'), 54 | x_map = ch_red("displace_map"), 55 | y_map = ch_blue("displace_map"), 56 | x_scale = unit(0.025, 'npc'), 57 | id = "text" 58 | ) + 59 | with_blend( 60 | geom_density_2d_filled(aes(rnorm(1e4, 0.5, 0.2), rnorm(1e4, 0.5, 0.2)), 61 | show.legend = FALSE), 62 | bg_layer = "text", 63 | blend_type = "in", 64 | id = "blended" 65 | ) + 66 | with_shadow("blended", sigma = 3) + 67 | coord_cartesian(xlim = c(0, 1), ylim = c(0, 1), clip = 'off') + 68 | labs(x = NULL, y = NULL) 69 | ``` 70 | 71 | ## Code of Conduct 72 | Please note that the ggfx project is released with a [Contributor Code of Conduct](https://ggfx.data-imaginist.com/CODE_OF_CONDUCT.html). By contributing to this project, you agree to abide by its terms. 73 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # ggfx 5 | 6 | 7 | 8 | [![Lifecycle: 9 | experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) 10 | [![Codecov test 11 | coverage](https://codecov.io/gh/thomasp85/ggfx/branch/main/graph/badge.svg)](https://app.codecov.io/gh/thomasp85/ggfx?branch=main) 12 | [![R-CMD-check](https://github.com/thomasp85/ggfx/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/thomasp85/ggfx/actions/workflows/R-CMD-check.yaml) 13 | 14 | 15 | ggfx is a (currently experimantal) package that allows the use of 16 | various filters and shaders on ggplot2 layers. 17 | 18 | ## Installation 19 | 20 | You can install ggfx from CRAN in the usual manner 21 | (`install.packages('ggfx')`) or you can grab the development version 22 | directly from github using the devtools package: 23 | 24 | ``` r 25 | # install.packages('devtools') 26 | devtools::install_github('thomasp85/ggfx') 27 | ``` 28 | 29 | ## Example 30 | 31 | The basic API of ggfx is to provide a range of `with_*()` modifier 32 | functions instead of special versions of common geoms. This means that 33 | ggfx will work with any geom from ggplot2 and the extension packages (I 34 | think…). An example showing some of the different functionalities are 35 | given below. Note that the output is produced with regular geoms. 36 | 37 | ``` r 38 | library(ggplot2) 39 | library(ggfx) 40 | ggplot() + 41 | as_reference( 42 | geom_polygon(aes(c(0, 1, 1), c(0, 0, 1)), colour = NA, fill = 'magenta'), 43 | id = "displace_map" 44 | ) + 45 | with_displacement( 46 | geom_text(aes(0.5, 0.5, label = 'ggfx-ggfx'), size = 25, fontface = 'bold'), 47 | x_map = ch_red("displace_map"), 48 | y_map = ch_blue("displace_map"), 49 | x_scale = unit(0.025, 'npc'), 50 | id = "text" 51 | ) + 52 | with_blend( 53 | geom_density_2d_filled(aes(rnorm(1e4, 0.5, 0.2), rnorm(1e4, 0.5, 0.2)), 54 | show.legend = FALSE), 55 | bg_layer = "text", 56 | blend_type = "in", 57 | id = "blended" 58 | ) + 59 | with_shadow("blended", sigma = 3) + 60 | coord_cartesian(xlim = c(0, 1), ylim = c(0, 1), clip = 'off') + 61 | labs(x = NULL, y = NULL) 62 | ``` 63 | 64 | 65 | 66 | ## Code of Conduct 67 | 68 | Please note that the ggfx project is released with a [Contributor Code 69 | of Conduct](https://ggfx.data-imaginist.com/CODE_OF_CONDUCT.html). By 70 | contributing to this project, you agree to abide by its terms. 71 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | destination: docs 2 | url: https://ggfx.data-imaginist.com 3 | 4 | authors: 5 | Thomas Lin Pedersen: 6 | href: https://data-imaginist.com 7 | 8 | template: 9 | params: 10 | bootswatch: spacelab 11 | 12 | navbar: 13 | left: 14 | - icon: fa-home fa-lg 15 | href: index.html 16 | - text: Getting Started 17 | href: articles/ggfx.html 18 | - text: In Depth 19 | menu: 20 | - text: Custom Filters 21 | href: articles/custom_filters.html 22 | - text: Using ggfx in ggplot2 extensions 23 | href: articles/geoms.html 24 | - text: Reference 25 | href: reference/index.html 26 | - text: News 27 | menu: 28 | - text: "Release notes" 29 | - text: "Version 1.0.0" 30 | href: https://www.data-imaginist.com/2021/say-goodbye-to-good-taste/ 31 | - text: "------------------" 32 | - text: "Change log" 33 | href: news/index.html 34 | right: 35 | - icon: fa-github fa-lg 36 | href: https://github.com/thomasp85/ggfx 37 | 38 | reference: 39 | - title: Filters 40 | desc: > 41 | Filters are the bread and butter of ggfx, and thankfully it has a lot. If 42 | something is missing there is always `with_custom()` to let your creativety 43 | go wild. 44 | contents: 45 | - starts_with('with_') 46 | - title: References 47 | desc: > 48 | Filters sometimes need to work with multiple layers. This can be achieved by 49 | turning a layer into a reference, either directly through the filter, or by 50 | using one of the refefence creators. 51 | contents: 52 | - starts_with('as_') 53 | - title: Channels 54 | desc: > 55 | Some filters use layers as variable argument input - e.g. the amount of blur 56 | at each pixel in `with_variable_blur()` is determined by another layer. In 57 | these instances only a single channel is needed, which can be selected with 58 | a `ch_*()` selector. If none is given the luminance is used. 59 | contents: 60 | - starts_with('ch_') 61 | - title: Raster placement 62 | desc: > 63 | Instead of using a layer as input, one can use a raster object. Since the 64 | dimensions of the object does not necessarily fit the dimension of the 65 | rendered plot it is necessary to specify how the raster should be placed and 66 | resized. 67 | contents: 68 | - starts_with('ras_') 69 | - title: Helpers 70 | desc: > 71 | For ultimate power over the rendering you may need to create your own 72 | filters. This can be a daunting task but ggfx provides a set of helpers for 73 | removing some of the pain of working with raster objects and figuring out 74 | the dimensions and location of the drawing area. 75 | contents: 76 | - starts_with('viewport_location') 77 | - title: Object support 78 | desc: > 79 | ggfx supports a wide range of different object that can be filtered. Most 80 | are somehow related to ggplot2. The following doc lays out the different 81 | supported objects. 82 | contents: 83 | - object_support 84 | -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | comment: false 2 | 3 | coverage: 4 | status: 5 | project: 6 | default: 7 | target: auto 8 | threshold: 1% 9 | informational: true 10 | patch: 11 | default: 12 | target: auto 13 | threshold: 1% 14 | informational: true 15 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | General upkeep due to HTML5 change 2 | -------------------------------------------------------------------------------- /man/as_colourspace.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/colourspaces.R 3 | \name{as_colourspace} 4 | \alias{as_colourspace} 5 | \title{Collect channels into a single layer of a specific colourspace} 6 | \usage{ 7 | as_colourspace( 8 | ..., 9 | colourspace = "sRGB", 10 | auto_opacity = TRUE, 11 | id = NULL, 12 | include = is.null(id) 13 | ) 14 | } 15 | \arguments{ 16 | \item{...}{A range of layers to combine. If there are no channel spec set the 17 | luminosity will be used} 18 | 19 | \item{colourspace}{Which colourspace should the provided colour channels be 20 | interpreted as coming from.} 21 | 22 | \item{auto_opacity}{Should the opacity be derived from the input layers or 23 | taken from a provided alpha channel} 24 | 25 | \item{id}{A string identifying this layer for later use} 26 | 27 | \item{include}{Should the layer itself be included in the graphic} 28 | } 29 | \value{ 30 | A list of \code{Layer} objects 31 | } 32 | \description{ 33 | If you need to work on single channels one by one you can use the different 34 | \link[=ch_red]{ch_*()} selectors. If the result needs to be combined again into a 35 | colour layer you can use \code{as_colourspace} and pass in the required channels 36 | to make up the colourspace. By default the alpha channel will be created as 37 | the combination of the alpha channels from the provided channel layers. 38 | Alternatively you can set \code{auto_opacity = FALSE} and provide one additional 39 | channel which will then be used as alpha. 40 | } 41 | \examples{ 42 | library(ggplot2) 43 | 44 | segments <- data.frame( 45 | x = runif(300), 46 | y = runif(300), 47 | xend = runif(300), 48 | yend = runif(300) 49 | ) 50 | 51 | # We use 'white' as that is the maximum value in all channels 52 | ggplot(mapping = aes(x, y, xend = xend, yend = yend)) + 53 | as_colourspace( 54 | geom_segment(data = segments[1:100,], colour = 'white'), 55 | geom_segment(data = segments[101:200,], colour = 'white'), 56 | geom_segment(data = segments[201:300,], colour = 'white'), 57 | colourspace = 'CMY' 58 | ) 59 | 60 | } 61 | \seealso{ 62 | Other layer references: 63 | \code{\link{as_group}()}, 64 | \code{\link{as_reference}()} 65 | } 66 | \concept{layer references} 67 | -------------------------------------------------------------------------------- /man/as_group.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/group.R 3 | \name{as_group} 4 | \alias{as_group} 5 | \title{Collect layers into a group that can be treated as a single layer} 6 | \usage{ 7 | as_group(..., id = NULL, include = is.null(id)) 8 | } 9 | \arguments{ 10 | \item{...}{A range of layers to combine} 11 | 12 | \item{id}{A string identifying this layer for later use} 13 | 14 | \item{include}{Should the layer itself be included in the graphic} 15 | } 16 | \value{ 17 | A list of \code{Layer} objects or a \link[grid:grid.grob]{gTree} depending on the 18 | input 19 | } 20 | \description{ 21 | While you often want to apply filters to layers one by one, there are times 22 | when one filter should be applied to a collection of layers as if they were 23 | one. This can be achieved by first combining all the layers into a group with 24 | \code{as_group()} and applying the filter to the resulting group. This can only be 25 | done to ggplot2 layers and grobs as the other supported objects are not part 26 | of a graphic stack. 27 | } 28 | \examples{ 29 | library(ggplot2) 30 | 31 | # With no grouping the filters on layers are applied one by one 32 | ggplot(mtcars, aes(mpg, disp)) + 33 | with_shadow(geom_smooth(alpha = 1), sigma = 4) + 34 | with_shadow(geom_point(), sigma = 4) 35 | 36 | # Grouping the layers allows you to apply a filter on the combined result 37 | ggplot(mtcars, aes(mpg, disp)) + 38 | as_group( 39 | geom_smooth(alpha = 1), 40 | geom_point(), 41 | id = 'group_1' 42 | ) + 43 | with_shadow('group_1', sigma = 4) 44 | 45 | } 46 | \seealso{ 47 | Other layer references: 48 | \code{\link{as_colourspace}()}, 49 | \code{\link{as_reference}()} 50 | } 51 | \concept{layer references} 52 | -------------------------------------------------------------------------------- /man/as_reference.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/reference.R 3 | \name{as_reference} 4 | \alias{as_reference} 5 | \title{Create a reference to a layer for use in other filters} 6 | \usage{ 7 | as_reference(x, id = NULL, include = is.null(id)) 8 | } 9 | \arguments{ 10 | \item{x}{A ggplot2 layer object, a ggplot, a grob, or a character string 11 | naming a filter} 12 | 13 | \item{id}{A string identifying this layer for later use} 14 | 15 | \item{include}{Should the layer itself be included in the graphic} 16 | } 17 | \value{ 18 | Depending on the input, either a \code{grob}, \code{Layer}, list of \code{Layer}s, 19 | \code{guide}, or \code{element} object. Assume the output can be used in the same 20 | context as the input. 21 | } 22 | \description{ 23 | This function is basically synonymous with \code{with_raster()} but exist to make 24 | the intend of marking a layer with a specific id clear. 25 | } 26 | \examples{ 27 | library(ggplot2) 28 | 29 | ggplot() + 30 | as_reference( 31 | geom_point(aes(20, 300), size = 100, colour = 'white'), 32 | id = 'mask_layer' 33 | ) + 34 | with_mask( 35 | geom_point(aes(mpg, disp), mtcars, size = 5), 36 | mask = 'mask_layer' 37 | ) 38 | 39 | 40 | } 41 | \seealso{ 42 | Other layer references: 43 | \code{\link{as_colourspace}()}, 44 | \code{\link{as_group}()} 45 | } 46 | \concept{layer references} 47 | -------------------------------------------------------------------------------- /man/channel_spec.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/channels.R 3 | \name{Channels} 4 | \alias{Channels} 5 | \alias{ch_red} 6 | \alias{ch_green} 7 | \alias{ch_blue} 8 | \alias{ch_alpha} 9 | \alias{ch_hue} 10 | \alias{ch_chroma} 11 | \alias{ch_luminance} 12 | \alias{ch_saturation} 13 | \alias{ch_lightness} 14 | \alias{ch_cyan} 15 | \alias{ch_magenta} 16 | \alias{ch_yellow} 17 | \alias{ch_black} 18 | \alias{ch_key} 19 | \alias{ch_custom} 20 | \title{Set a channel of interest from a layer} 21 | \usage{ 22 | ch_red(x, colourspace = "sRGB", invert = FALSE) 23 | 24 | ch_green(x, colourspace = "sRGB", invert = FALSE) 25 | 26 | ch_blue(x, colourspace = "sRGB", invert = FALSE) 27 | 28 | ch_alpha(x, colourspace = "sRGB", invert = FALSE) 29 | 30 | ch_hue(x, colourspace = "HCL", invert = FALSE) 31 | 32 | ch_chroma(x, colourspace = "HCL", invert = FALSE) 33 | 34 | ch_luminance(x, colourspace = "HCL", invert = FALSE) 35 | 36 | ch_saturation(x, colourspace = "HSL", invert = FALSE) 37 | 38 | ch_lightness(x, colourspace = "HSL", invert = FALSE) 39 | 40 | ch_cyan(x, colourspace = "CMYK", invert = FALSE) 41 | 42 | ch_magenta(x, colourspace = "CMYK", invert = FALSE) 43 | 44 | ch_yellow(x, colourspace = "CMYK", invert = FALSE) 45 | 46 | ch_black(x, colourspace = "CMYK", invert = FALSE) 47 | 48 | ch_key(x, colourspace = "CMYK", invert = FALSE) 49 | 50 | ch_custom(x, channel, colourspace, invert = FALSE) 51 | } 52 | \arguments{ 53 | \item{x}{Any object interpretable as a layer} 54 | 55 | \item{colourspace}{The colourspace the channel should be extracted from.} 56 | 57 | \item{invert}{Should the channel values be inverted before use} 58 | 59 | \item{channel}{The name of a channel in the given colourspace} 60 | } 61 | \value{ 62 | \code{x} with a channel spec attached 63 | } 64 | \description{ 65 | Some effects uses a particular channel for specific parameters, such as 66 | \code{\link[=with_displacement]{with_displacement()}}, which grabs the relative x and y displacements from 67 | different channels in some other layer. To facilitate specifying which 68 | channel to use from a layer (which is always multichannel), you can wrap the 69 | specification in a channel specifier given below. If a filter requires a 70 | specific channel and none is specified it will default to \code{luminance} (based 71 | on the \code{hcl} colour space) 72 | } 73 | \examples{ 74 | library(ggplot2) 75 | volcano_long <- data.frame( 76 | x = as.vector(col(volcano)), 77 | y = as.vector(row(volcano)), 78 | z = as.vector(volcano) 79 | ) 80 | 81 | # invert the green channel 82 | ggplot(volcano_long, aes(y, x)) + 83 | as_reference( 84 | geom_contour_filled(aes(z = z, fill = after_stat(level))), 85 | id = 'contours' 86 | ) + 87 | as_colourspace( 88 | ch_red('contours'), 89 | ch_green('contours', invert = TRUE), 90 | ch_blue('contours') 91 | ) 92 | 93 | } 94 | -------------------------------------------------------------------------------- /man/figures/README-example-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/ggfx/7852449b033b0ada4604865d79e5a327f6ef2e8c/man/figures/README-example-1.png -------------------------------------------------------------------------------- /man/figures/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/ggfx/7852449b033b0ada4604865d79e5a327f6ef2e8c/man/figures/logo.png -------------------------------------------------------------------------------- /man/ggfx-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggfx-package.R 3 | \docType{package} 4 | \name{ggfx-package} 5 | \alias{ggfx} 6 | \alias{ggfx-package} 7 | \title{ggfx: Pixel Filters for 'ggplot2' and 'grid'} 8 | \description{ 9 | \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} 10 | 11 | Provides a range of filters that can be applied to layers from the 'ggplot2' package and its extensions, along with other graphic elements such as guides and theme elements. The filters are applied at render time and thus uses the exact pixel dimensions needed. 12 | } 13 | \seealso{ 14 | Useful links: 15 | \itemize{ 16 | \item \url{https://ggfx.data-imaginist.com} 17 | \item \url{https://github.com/thomasp85/ggfx} 18 | \item Report bugs at \url{https://github.com/thomasp85/ggfx/issues} 19 | } 20 | 21 | } 22 | \author{ 23 | \strong{Maintainer}: Thomas Lin Pedersen \email{thomasp85@gmail.com} (\href{https://orcid.org/0000-0002-5147-4711}{ORCID}) 24 | 25 | Other contributors: 26 | \itemize{ 27 | \item RStudio [copyright holder, funder] 28 | } 29 | 30 | } 31 | \keyword{internal} 32 | -------------------------------------------------------------------------------- /man/object_support.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/doc-object-support.R 3 | \name{object_support} 4 | \alias{object_support} 5 | \title{Supported object types} 6 | \value{ 7 | All filters will generally return a new version of the same object, 8 | the only exception being filtering of rasters, functions, and references 9 | which returns a Layer object 10 | } 11 | \description{ 12 | The different filters provided by ggfx are applicable to a wide range of 13 | object types. Rather than documenting how to use them with each type in every 14 | documentation entry, the information is collected here. While the examples 15 | will use \code{\link[=with_blur]{with_blur()}} they are general and applicable to all filters in 16 | ggfx. 17 | } 18 | \section{Method specific arguments}{ 19 | 20 | \itemize{ 21 | \item \code{id}: A string that identifies the result of this filter, to be referenced 22 | by other filters in the same graphic. 23 | \item \code{include}: A logical flag that indicates whether the filtered image should 24 | be displayed. By default, the result will not be displayed if it is given 25 | an \code{id} (as it is assumed that it is meant for later use), but this can be 26 | overewritten by setting \code{include = TRUE}. 27 | \item \code{ignore_background}: Should the background of the plot be removed before 28 | applying the filter and re-added afterwards? 29 | \item \code{background}: A grob to draw below the result of the filter. Mainly for 30 | internal use for supporting \code{ignore_background}. 31 | } 32 | } 33 | 34 | \section{Filtering layers}{ 35 | 36 | This is perhaps the most common and obvious use of ggfx, and the one 37 | show-cased in the respective docs of each filter. In order to apply a filter 38 | to a ggplot2 layer you wrap it around the layer constructor (usually a 39 | \verb{geom_*()} function) and pass in additional parameters after it: 40 | 41 | \if{html}{\out{
}}\preformatted{ggplot(mtcars) + 42 | with_blur( 43 | geom_point(aes(x = mpg, y = disp)), 44 | sigma = 4 45 | ) 46 | }\if{html}{\out{
}} 47 | 48 | Apart from the arguments specific to the filter, layer filters also take an 49 | \code{id}, and \code{include} argument. Providing an id (as a string) will make this 50 | filter be referable by other filters. By default this turns of rendering of 51 | the result, but setting \code{include = TRUE} will turn rendering back on (while 52 | still making it referable). Referable layers should \strong{always} come before 53 | whatever other layer ends up referring to them, since ggfx does not have 54 | control over the rendering order. Not following this rule will have undefined 55 | consequences (either an error or a weird plot - or maybe the correct result) 56 | } 57 | 58 | \section{Filtering layer references}{ 59 | 60 | While the first argument to a filter is mostly some sort of graphic 61 | generating object, it can also be a text string referring to another filter. 62 | This allows you to string together filters, should you so choose. The big 63 | caveat is that filtering a reference will always result in a layer - i.e. it 64 | is not compatible outside of ggplot2. 65 | 66 | \if{html}{\out{
}}\preformatted{ggplot(mtcars) + 67 | with_blur( 68 | geom_point(aes(x = mpg, y = disp)), 69 | sigma = 4, 70 | id = 'blurred_points' 71 | ) + 72 | with_shadow( 73 | 'blurred_points' 74 | ) 75 | }\if{html}{\out{
}} 76 | } 77 | 78 | \section{Filtering guides}{ 79 | 80 | ggplot2 does not only consist of layers - there are all sort of other graphic 81 | elements around them. Guides are one such type of element and these can be 82 | filtered by wrapping the filter around the guide constructor: 83 | 84 | \if{html}{\out{
}}\preformatted{ggplot(mtcars) + 85 | geom_point(aes(x = mpg, y = disp, colour = gear)) + 86 | guides(colour = with_blur(guide_colourbar(), sigma = 4)) 87 | }\if{html}{\out{
}} 88 | 89 | There is a caveat here in that it is not possible to use this with the string 90 | shorthand (i.e. \code{with_blur('colourbar')} won't work) — you have to use the 91 | functional form. 92 | } 93 | 94 | \section{Filtering theme elements}{ 95 | 96 | Theme elements, like guides, is another non-layer graphic that is amenable to 97 | filtering. It can be done by wrapping the \verb{element_*()} constructor with a 98 | filter: 99 | 100 | \if{html}{\out{
}}\preformatted{ggplot(mtcars) + 101 | geom_point(aes(x = mpg, y = disp)) + 102 | ggtitle("A blurry title") + 103 | theme(plot.title = with_blur(element_text(), sigma = 4)) 104 | }\if{html}{\out{
}} 105 | 106 | There is a caveat here as well. The filtering doesn't get carried through 107 | inheritance so you cannot set filtering at a top-level element and expect all 108 | child elements to be filtered. 109 | } 110 | 111 | \section{Filtering ggplots}{ 112 | 113 | While you normally only want to add a filter to a part of the plot, it is 114 | also possible to add it to everthing, simply by wrapping the filter function 115 | around the plot. You can elect to remove the background element while 116 | applying the filter and add it back on afterwards by setting 117 | \code{ignore_background = TRUE} on the filter 118 | 119 | \if{html}{\out{
}}\preformatted{p <- ggplot(mtcars) + 120 | geom_point(aes(x = mpg, y = disp)) 121 | 122 | with_blur(p, sigma = 4) 123 | }\if{html}{\out{
}} 124 | 125 | An alternative is to put the filter around the \code{\link[=ggplot]{ggplot()}} call, which will 126 | have the same effect and may fit better with your plot construction code 127 | 128 | \if{html}{\out{
}}\preformatted{with_blur(ggplot(mtcars), sigma = 4) + 129 | geom_point(aes(x = mpg, y = disp)) 130 | }\if{html}{\out{
}} 131 | } 132 | 133 | \section{Filtering grobs}{ 134 | 135 | At the lowest level, it is possible to apply a filter to a grob. This is what 136 | powers all of the above at some level and that power is also available to 137 | you. It is done in the same manner as all of the above, by wrapping the grob 138 | in a filter: 139 | 140 | \if{html}{\out{
}}\preformatted{blurred_circle <- with_blur(circleGrob(), sigma = 4) 141 | 142 | grid.newpage() 143 | grid.draw(blurred_circle) 144 | }\if{html}{\out{
}} 145 | 146 | As with layers, filters applied to grobs also take an \code{id} and \code{include} 147 | argument and they have the same effect. It should be noted that it can be 148 | difficult to grasp the rendering order of elements in a manually created grid 149 | graphics, so take care when using filters that refer to each other as the 150 | rule about the rendering order still applies. 151 | 152 | There are not a lot of people who use grid directly, but if you develop 153 | ggplot2 extensions the ability to apply filters to grobs means that you can 154 | create geoms with filters build right into them! 155 | } 156 | 157 | -------------------------------------------------------------------------------- /man/raster_helpers.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/blend.R, R/blend_custom.R, R/bloom.R, 3 | % R/blur.R, R/displace.R, R/dither.R, R/inner_glow.R, R/interpolate.R, 4 | % R/kernel.R, R/mask.R, R/motion_blur.R, R/ordered_dither.R, R/outer_glow.R, 5 | % R/rasterise_grob.R, R/shade.R, R/variable_blur.R 6 | \name{blend_raster} 7 | \alias{blend_raster} 8 | \alias{blend_custom_raster} 9 | \alias{bloom_raster} 10 | \alias{blur_raster} 11 | \alias{displace_raster} 12 | \alias{dither_raster} 13 | \alias{inner_glow_raster} 14 | \alias{interpolate_raster} 15 | \alias{convolve_grob} 16 | \alias{mask_raster} 17 | \alias{motion_blur_raster} 18 | \alias{ordered_dither_raster} 19 | \alias{outer_glow_raster} 20 | \alias{raster_helpers} 21 | \alias{shade_raster} 22 | \alias{variably_blur_raster} 23 | \title{Raster Helpers} 24 | \usage{ 25 | blend_raster(x, bg_layer, blend_type = "Over", flip_order = FALSE, alpha = NA) 26 | 27 | blend_custom_raster(x, bg_layer, a, b, c, d, flip_order = FALSE, alpha = NA) 28 | 29 | bloom_raster( 30 | x, 31 | threshold_lower = 80, 32 | threshold_upper = 100, 33 | sigma = 5, 34 | strength = 1, 35 | keep_alpha = TRUE 36 | ) 37 | 38 | blur_raster(x, sigma = 0.5, stack = FALSE) 39 | 40 | displace_raster(x, x_map, y_map = x_map, x_scale = 1, y_scale = x_scale) 41 | 42 | dither_raster(x, max_colours = 256, colourspace = "sRGB") 43 | 44 | inner_glow_raster(x, colour = "black", sigma = 3, expand = 0) 45 | 46 | interpolate_raster(x, bg_layer, src_percent, bg_percent) 47 | 48 | convolve_grob( 49 | x, 50 | kernel, 51 | iterations = 1, 52 | scaling = NULL, 53 | bias = NULL, 54 | stack = FALSE 55 | ) 56 | 57 | mask_raster(x, mask, invert = FALSE) 58 | 59 | motion_blur_raster(x, sigma = 0.5, angle = 0) 60 | 61 | ordered_dither_raster(x, map, colourspace = "sRGB", offset = NULL) 62 | 63 | outer_glow_raster(x, colour = "black", sigma = 3, expand = 0) 64 | 65 | shade_raster( 66 | x, 67 | height_map, 68 | azimuth = 30, 69 | elevation = 30, 70 | strength = 10, 71 | sigma = 0, 72 | blend_type = "overlay" 73 | ) 74 | 75 | variably_blur_raster( 76 | x, 77 | x_sigma, 78 | y_sigma = x_sigma, 79 | angle = NULL, 80 | x_scale = 1, 81 | y_scale = x_scale, 82 | angle_range = 0 83 | ) 84 | } 85 | \value{ 86 | A nativeRaster object 87 | } 88 | \description{ 89 | Raster Helpers 90 | } 91 | \keyword{internal} 92 | -------------------------------------------------------------------------------- /man/raster_placement.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/raster-location.R 3 | \name{raster_placement} 4 | \alias{raster_placement} 5 | \alias{ras_fill} 6 | \alias{ras_fit} 7 | \alias{ras_stretch} 8 | \alias{ras_place} 9 | \alias{ras_tile} 10 | \title{Control placements of raster in the plot} 11 | \usage{ 12 | ras_fill(raster, align_to = "canvas") 13 | 14 | ras_fit(raster, align_to = "canvas") 15 | 16 | ras_stretch(raster, align_to = "canvas") 17 | 18 | ras_place(raster, align_to = "canvas", anchor = "topleft", offset = c(0, 0)) 19 | 20 | ras_tile( 21 | raster, 22 | align_to = "canvas", 23 | anchor = "topleft", 24 | offset = c(0, 0), 25 | flip = FALSE 26 | ) 27 | } 28 | \arguments{ 29 | \item{raster}{A \code{raster} or \code{nativeRaster} object or an object coercible to 30 | a \code{raster} object} 31 | 32 | \item{align_to}{Should the raster be positioned according to the canvas or 33 | the current viewport} 34 | 35 | \item{anchor}{Where should the raster be placed relative to the alignment 36 | area} 37 | 38 | \item{offset}{A unit or numeric vector giving an additional offset relative 39 | to the anchor. Positive values moves right/down and negative values move 40 | left/up} 41 | 42 | \item{flip}{Should every other repetition be flipped} 43 | } 44 | \value{ 45 | The input with additional information attached 46 | } 47 | \description{ 48 | When using raster objects directly you need to somehow define how it should 49 | be located in resized in the plot. These function can be used to inform the 50 | filter on how it should be used. They only work on \code{raster} type object, so 51 | cannot be used around functions or layer id's. 52 | } 53 | \examples{ 54 | library(ggplot2) 55 | logo <- as.raster(magick::image_read( 56 | system.file('help', 'figures', 'logo.png', package = 'ggfx') 57 | )) 58 | 59 | # Default is to fill the viewport area, preserving the aspect ratio of the 60 | # raster 61 | ggplot(mtcars) + 62 | with_blend( 63 | geom_point(aes(mpg, disp)), 64 | logo 65 | ) 66 | 67 | # But you can change that with these functions: 68 | ggplot(mtcars) + 69 | with_blend( 70 | geom_point(aes(mpg, disp)), 71 | ras_place(logo, 'vp', 'bottomright') 72 | ) 73 | 74 | # Here we tile it with flipping, centering on the middle of the canvas 75 | ggplot(mtcars) + 76 | with_blend( 77 | geom_point(aes(mpg, disp)), 78 | ras_tile(logo, anchor = 'center', flip = TRUE) 79 | ) 80 | 81 | } 82 | -------------------------------------------------------------------------------- /man/render_context.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/raster-helpers.R 3 | \name{render_context} 4 | \alias{render_context} 5 | \alias{viewport_location} 6 | \alias{index_raster} 7 | \alias{get_raster_area} 8 | \alias{set_raster_area} 9 | \alias{get_viewport_area} 10 | \alias{set_viewport_area} 11 | \alias{viewport_is_clipping} 12 | \alias{current_resolution} 13 | \alias{to_pixels} 14 | \alias{from_pixels} 15 | \title{Rendering information} 16 | \usage{ 17 | viewport_location() 18 | 19 | index_raster(raster, cols, rows) 20 | 21 | get_raster_area(raster, xmin, ymin, xmax, ymax) 22 | 23 | set_raster_area(raster, value, xmin, ymin) 24 | 25 | get_viewport_area(raster) 26 | 27 | set_viewport_area(raster, value) 28 | 29 | viewport_is_clipping() 30 | 31 | current_resolution() 32 | 33 | to_pixels(x, y_axis = FALSE, location = FALSE) 34 | 35 | from_pixels(x) 36 | } 37 | \arguments{ 38 | \item{raster}{A \code{raster} or \code{nativeRaster} object} 39 | 40 | \item{cols, rows}{Column and row indices} 41 | 42 | \item{xmin, ymin, xmax, ymax}{Boundaries of the area in pixels. {0,0} is the 43 | top-left corner} 44 | 45 | \item{value}{An object of the same type as \code{raster}} 46 | 47 | \item{x}{A numeric or unit object} 48 | 49 | \item{y_axis}{is the unit pertaining to the y-axis? Defaults to \code{FALSE} (i.e. 50 | it is measured on the x-axis)} 51 | 52 | \item{location}{is the unit encoding a location? Defaults to \code{FALSE} (i.e. it 53 | is encoding a dimension). Pixel locations are encoded based on a top-left 54 | starting point, as opposed to grid's bottom-left coordinate system. This 55 | means that y-axis locations will flip around when converted to pixels.} 56 | } 57 | \value{ 58 | Depends on the function - see details. 59 | } 60 | \description{ 61 | These utility functions can help when creating custom filters (using 62 | \code{\link[=with_custom]{with_custom()}}) as they can provide information about the current rendering 63 | context. 64 | } 65 | \details{ 66 | \itemize{ 67 | \item \code{viewport_location()}: Returns the bounding box defining the current 68 | viewport in pixels in the order \code{xmin}, \code{ymin}, \code{xmax}, \code{ymax} 69 | \item \code{index_raster()}: Is a version of the classic \verb{[,]} indexing that is aware 70 | of the row-major order of rasters 71 | \item \code{get_raster_area()}: Extracts an area of a raster based on a bounding box 72 | \item \code{set_raster_area()}: Sets an area of a raster to a new raster value 73 | \item \code{get_viewport_area()}: A version of \code{get_raster_area()} that specifically 74 | extract the area defined by the current viewport 75 | \item \code{set_viewport_area()}: A version of \code{set_raster_area()} that specifically 76 | sets the area defined by the current viewport 77 | \item \code{viewport_is_clipping()}: Returns \code{TRUE} if the current viewport has 78 | clipping turned on 79 | \item \code{current_resolution()}: Returns the resolution of the active device in ppi 80 | (pixels-per-inch) 81 | \item \code{to_pixels(x)}: Converts \code{x} to pixels if \code{x} is given as a unit object. It 82 | is assumed that x encodes a dimension and not a location. If \code{x} is a 83 | numeric it is assumed to already be in pixels 84 | \item \code{from_pixels}: Converts a numeric giving some pixel dimension to a unit 85 | object. 86 | } 87 | } 88 | \examples{ 89 | # These functions are intended to be used inside filter functions, e.g. 90 | library(ggplot2) 91 | 92 | flip_raster <- function(raster, horizontal = TRUE) { 93 | # Get the viewport area of the raster 94 | vp <- get_viewport_area(raster) 95 | 96 | # Get the columns and rows of the raster - reverse order depending on 97 | # the value of horizontal 98 | dims <- dim(vp) 99 | rows <- seq_len(dims[1]) 100 | cols <- seq_len(dims[2]) 101 | if (horizontal) { 102 | cols <- rev(cols) 103 | } else { 104 | rows <- rev(rows) 105 | } 106 | 107 | # change the order of columns or rows in the viewport raster 108 | vp <- index_raster(vp, cols, rows) 109 | 110 | # Assign the modified viewport back 111 | set_viewport_area(raster, vp) 112 | } 113 | 114 | ggplot() + 115 | with_custom( 116 | geom_text(aes(0.5, 0.75, label = 'Flippediflop!'), size = 10), 117 | filter = flip_raster, 118 | horizontal = TRUE 119 | ) 120 | 121 | } 122 | -------------------------------------------------------------------------------- /man/with_blend_custom.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/blend_custom.R 3 | \name{with_blend_custom} 4 | \alias{with_blend_custom} 5 | \title{Create a custom blend type} 6 | \usage{ 7 | with_blend_custom( 8 | x, 9 | bg_layer, 10 | a = 0, 11 | b = 0, 12 | c = 0, 13 | d = 0, 14 | flip_order = FALSE, 15 | alpha = NA, 16 | ... 17 | ) 18 | } 19 | \arguments{ 20 | \item{x}{A ggplot2 layer object, a ggplot, a grob, or a character string 21 | naming a filter} 22 | 23 | \item{bg_layer}{The background layer to use. Can either be a string 24 | identifying a registered filter, or a raster object. The map will be resized 25 | to match the dimensions of x.} 26 | 27 | \item{a, b, c, d}{The coefficients defining the blend operation} 28 | 29 | \item{flip_order}{Should the order of the background and the overlay be 30 | flipped so that \code{bg_layer} is treated as being on top and \code{x} being below.} 31 | 32 | \item{alpha}{For non-Duff-Porter blends the alpha channel may become modified. 33 | This argument can be used to set the resulting alpha channel to that of the 34 | source (\code{"src"}) or destination (\code{"dst"})} 35 | 36 | \item{...}{Arguments to be passed on to methods. See 37 | \link[=object_support]{the documentation of supported object} for a description of 38 | object specific arguments.} 39 | } 40 | \value{ 41 | Depending on the input, either a \code{grob}, \code{Layer}, list of \code{Layer}s, 42 | \code{guide}, or \code{element} object. Assume the output can be used in the same 43 | context as the input. 44 | } 45 | \description{ 46 | Many of the blend types available in \code{\link[=with_blend]{with_blend()}} are variations over the 47 | formula: \code{a*src*dst + b*src + c*dst + d}, where \code{src} stands for the channel 48 | value in the source image and \code{dst} stands for the destination image (the 49 | background). Multiply is e.g. defined as \verb{a:1, b:0, c:0, d:0}. This filter 50 | gives you free reign over setting the coefficient of the blend calculation. 51 | } 52 | \examples{ 53 | library(ggplot2) 54 | ggplot(mpg, aes(class, hwy)) + 55 | as_reference(geom_boxplot(fill = 'green'), 'box') + 56 | with_blend_custom(geom_point(colour = 'red'), 57 | bg_layer = 'box', a = -0.5, b = 1, c = 1) 58 | 59 | } 60 | \seealso{ 61 | Other blend filters: 62 | \code{\link{with_blend}()}, 63 | \code{\link{with_interpolate}()}, 64 | \code{\link{with_mask}()} 65 | } 66 | \concept{blend filters} 67 | -------------------------------------------------------------------------------- /man/with_bloom.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/bloom.R 3 | \name{with_bloom} 4 | \alias{with_bloom} 5 | \title{Apply bloom to your layer} 6 | \usage{ 7 | with_bloom( 8 | x, 9 | threshold_lower = 80, 10 | threshold_upper = 100, 11 | sigma = 5, 12 | strength = 1, 13 | keep_alpha = TRUE, 14 | ... 15 | ) 16 | } 17 | \arguments{ 18 | \item{x}{A ggplot2 layer object, a ggplot, a grob, or a character string 19 | naming a filter} 20 | 21 | \item{threshold_lower, threshold_upper}{The lowest channel value to consider 22 | emitting light and the highest channel value that should be considered 23 | maximum light strength, given in percent} 24 | 25 | \item{sigma}{The standard deviation of the gaussian kernel used for the 26 | bloom. Will affect the size of the halo around light objects} 27 | 28 | \item{strength}{A value between 0 and 1 to use for changing the strength of 29 | the effect.} 30 | 31 | \item{keep_alpha}{Should the alpha channel of the layer be kept, effectively 32 | limiting the bloom effect to the filtered layer. Setting this to false will 33 | allow the bloom to spill out to the background, but since it is not being 34 | blended correctly with the background the effect looks off.} 35 | 36 | \item{...}{Arguments to be passed on to methods. See 37 | \link[=object_support]{the documentation of supported object} for a description of 38 | object specific arguments.} 39 | } 40 | \value{ 41 | Depending on the input, either a \code{grob}, \code{Layer}, list of \code{Layer}s, 42 | \code{guide}, or \code{element} object. Assume the output can be used in the same 43 | context as the input. 44 | } 45 | \description{ 46 | Bloom is the effect of strong light sources spilling over into neighbouring 47 | dark areas. It is used a lot in video games and movies to give the effect of 48 | strong light, even though the monitor is not itself capable of showing light 49 | at that strength. 50 | } 51 | \examples{ 52 | library(ggplot2) 53 | points <- data.frame( 54 | x = runif(1000), 55 | y = runif(1000), 56 | col = runif(1000) 57 | ) 58 | ggplot(points, aes(x, y, colour = col)) + 59 | with_bloom( 60 | geom_point(size = 10), 61 | ) + 62 | scale_colour_continuous(type = 'viridis') 63 | 64 | } 65 | -------------------------------------------------------------------------------- /man/with_blur.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/blur.R 3 | \name{with_blur} 4 | \alias{with_blur} 5 | \title{Apply a gaussian blur to your layer} 6 | \usage{ 7 | with_blur(x, sigma = 0.5, stack = FALSE, ...) 8 | } 9 | \arguments{ 10 | \item{x}{A ggplot2 layer object, a ggplot, a grob, or a character string 11 | naming a filter} 12 | 13 | \item{sigma}{The standard deviation of the gaussian kernel. Increase it to 14 | apply more blurring. If a numeric it will be interpreted as given in pixels. 15 | If a unit object it will automatically be converted to pixels at rendering 16 | time} 17 | 18 | \item{stack}{Should the original layer be placed on top?} 19 | 20 | \item{...}{Arguments to be passed on to methods. See 21 | \link[=object_support]{the documentation of supported object} for a description of 22 | object specific arguments.} 23 | } 24 | \value{ 25 | Depending on the input, either a \code{grob}, \code{Layer}, list of \code{Layer}s, 26 | \code{guide}, or \code{element} object. Assume the output can be used in the same 27 | context as the input. 28 | } 29 | \description{ 30 | This filter adds a blur to the provided ggplot layer. The amount of blur can 31 | be controlled and the result can optionally be put underneath the original 32 | layer. 33 | } 34 | \examples{ 35 | library(ggplot2) 36 | ggplot(mtcars, aes(mpg, disp)) + 37 | with_blur(geom_point(data = mtcars, size = 3), sigma = 3) 38 | 39 | } 40 | \seealso{ 41 | Other blur filters: 42 | \code{\link{with_motion_blur}()}, 43 | \code{\link{with_variable_blur}()} 44 | } 45 | \concept{blur filters} 46 | -------------------------------------------------------------------------------- /man/with_custom.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/custom.R 3 | \name{with_custom} 4 | \alias{with_custom} 5 | \title{Apply a custom filter} 6 | \usage{ 7 | with_custom(x, filter, ...) 8 | } 9 | \arguments{ 10 | \item{x}{A ggplot2 layer object, a ggplot, a grob, or a character string 11 | naming a filter} 12 | 13 | \item{filter}{A function taking a \code{nativeRaster} object as the first argument 14 | along with whatever you pass in to \code{...}} 15 | 16 | \item{...}{Additional arguments to \code{filter}} 17 | } 18 | \value{ 19 | Depending on the input, either a \code{grob}, \code{Layer}, list of \code{Layer}s, 20 | \code{guide}, or \code{element} object. Assume the output can be used in the same 21 | context as the input. 22 | } 23 | \description{ 24 | This function allows you to apply a custom filtering function to a layer. The 25 | function must take a \code{nativeRaster} object as the first argument along with 26 | any other arguments passed to \code{...}. Be aware that the raster spans the full 27 | device size and not just the viewport currently rendered to. This is because 28 | graphics may extend outside of the viewport depending on the clipping 29 | settings. You can use \code{\link[=get_viewport_area]{get_viewport_area()}} along with all the other raster 30 | helpers provided by ggfx to facilitate working with the input raster. See the 31 | example below for some inspiration. 32 | } 33 | \examples{ 34 | library(ggplot2) 35 | flip_raster <- function(raster, horizontal = TRUE) { 36 | # Get the viewport area of the raster 37 | vp <- get_viewport_area(raster) 38 | 39 | # Get the columns and rows of the raster - reverse order depending on 40 | # the value of horizontal 41 | dims <- dim(vp) 42 | rows <- seq_len(dims[1]) 43 | cols <- seq_len(dims[2]) 44 | if (horizontal) { 45 | cols <- rev(cols) 46 | } else { 47 | rows <- rev(rows) 48 | } 49 | 50 | # change the order of columns or rows in the viewport raster 51 | vp <- index_raster(vp, cols, rows) 52 | 53 | # Assign the modified viewport back 54 | set_viewport_area(raster, vp) 55 | } 56 | 57 | ggplot() + 58 | with_custom( 59 | geom_text(aes(0.5, 0.75, label = 'Flippediflop!'), size = 10), 60 | filter = flip_raster, 61 | horizontal = TRUE 62 | ) 63 | 64 | ggplot() + 65 | with_custom( 66 | geom_text(aes(0.5, 0.75, label = 'Flippediflop!'), size = 10), 67 | filter = flip_raster, 68 | horizontal = FALSE 69 | ) 70 | 71 | } 72 | -------------------------------------------------------------------------------- /man/with_displacement.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/displace.R 3 | \name{with_displacement} 4 | \alias{with_displacement} 5 | \title{Apply a displacement map to a layer} 6 | \usage{ 7 | with_displacement(x, x_map, y_map = x_map, x_scale = 1, y_scale = x_scale, ...) 8 | } 9 | \arguments{ 10 | \item{x}{A ggplot2 layer object, a ggplot, a grob, or a character string 11 | naming a filter} 12 | 13 | \item{x_map, y_map}{The displacement maps to use. Can either be a string 14 | identifying a registered filter, or a raster object. The maps will be resized 15 | to match the dimensions of x. Only one channel will be used - see 16 | \link[=Channels]{the docs on channels} for info on how to set them.} 17 | 18 | \item{x_scale, y_scale}{How much displacement should a maximal channel value 19 | correspond to? If a numeric it will be interpreted as pixel dimensions. If a 20 | unit object it will be converted to pixel dimension when rendered.} 21 | 22 | \item{...}{Arguments to be passed on to methods. See 23 | \link[=object_support]{the documentation of supported object} for a description of 24 | object specific arguments.} 25 | } 26 | \value{ 27 | Depending on the input, either a \code{grob}, \code{Layer}, list of \code{Layer}s, 28 | \code{guide}, or \code{element} object. Assume the output can be used in the same 29 | context as the input. 30 | } 31 | \description{ 32 | This filter displaces the pixels based on the colour values of another layer 33 | or raster object. As such it can be used to distort the content of the layer. 34 | } 35 | \examples{ 36 | library(ggplot2) 37 | ggplot() + 38 | as_reference( 39 | geom_polygon(aes(c(0, 1, 1), c(0, 0, 1)), colour = NA, fill = 'magenta' ), 40 | id = "displace_map" 41 | ) + 42 | with_displacement( 43 | geom_text(aes(0.5, 0.5, label = 'Displacements!'), size = 10), 44 | x_map = ch_red("displace_map"), 45 | y_map = ch_blue("displace_map"), 46 | x_scale = unit(0.025, 'npc'), 47 | y_scale = unit(0.025, 'npc') 48 | ) 49 | 50 | } 51 | -------------------------------------------------------------------------------- /man/with_dither.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/dither.R 3 | \name{with_dither} 4 | \alias{with_dither} 5 | \title{Dither image using Floyd-Steinberg error correction dithering} 6 | \usage{ 7 | with_dither(x, max_colours = 256, colourspace = "sRGB", ...) 8 | } 9 | \arguments{ 10 | \item{x}{A ggplot2 layer object, a ggplot, a grob, or a character string 11 | naming a filter} 12 | 13 | \item{max_colours}{The maximum number of colours to use. The result may 14 | contain fewer colours but never more.} 15 | 16 | \item{colourspace}{In which colourspace should the dithering be calculated} 17 | 18 | \item{...}{Arguments to be passed on to methods. See 19 | \link[=object_support]{the documentation of supported object} for a description of 20 | object specific arguments.} 21 | } 22 | \value{ 23 | Depending on the input, either a \code{grob}, \code{Layer}, list of \code{Layer}s, 24 | \code{guide}, or \code{element} object. Assume the output can be used in the same 25 | context as the input. 26 | } 27 | \description{ 28 | This filter reduces the number of colours in your layer and uses the 29 | Floyd-Steinberg algorithm to even out the error introduced by the colour 30 | reduction. 31 | } 32 | \examples{ 33 | library(ggplot2) 34 | ggplot(faithfuld, aes(waiting, eruptions)) + 35 | with_dither( 36 | geom_raster(aes(fill = density), interpolate = TRUE), 37 | max_colours = 10 38 | ) + 39 | scale_fill_continuous(type = 'viridis') 40 | 41 | } 42 | \seealso{ 43 | Other dithering filters: 44 | \code{\link{with_circle_dither}()} 45 | } 46 | \concept{dithering filters} 47 | -------------------------------------------------------------------------------- /man/with_inner_glow.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/inner_glow.R 3 | \name{with_inner_glow} 4 | \alias{with_inner_glow} 5 | \title{Apply an inner glow to your layer} 6 | \usage{ 7 | with_inner_glow(x, colour = "black", sigma = 3, expand = 0, ...) 8 | } 9 | \arguments{ 10 | \item{x}{A ggplot2 layer object, a ggplot, a grob, or a character string 11 | naming a filter} 12 | 13 | \item{colour}{The colour of the glow} 14 | 15 | \item{sigma}{The standard deviation of the gaussian kernel. Increase it to 16 | apply more blurring. If a numeric it will be interpreted as given in pixels. 17 | If a unit object it will automatically be converted to pixels at rendering 18 | time} 19 | 20 | \item{expand}{An added dilation to the glow mask before blurring it} 21 | 22 | \item{...}{Arguments to be passed on to methods. See 23 | \link[=object_support]{the documentation of supported object} for a description of 24 | object specific arguments.} 25 | } 26 | \value{ 27 | Depending on the input, either a \code{grob}, \code{Layer}, list of \code{Layer}s, 28 | \code{guide}, or \code{element} object. Assume the output can be used in the same 29 | context as the input. 30 | } 31 | \description{ 32 | This filter adds an inner glow to your layer with a specific colour and size. 33 | The best effect is often had by drawing the stroke separately so the glow is 34 | only applied to the fill. 35 | } 36 | \examples{ 37 | library(ggplot2) 38 | 39 | ggplot(mtcars, aes(as.factor(gear), disp)) + 40 | with_inner_glow( 41 | geom_boxplot(), 42 | colour = 'red', 43 | sigma = 10 44 | ) 45 | 46 | # This gives a red tone to the lines as well which may not be desirable 47 | # This can be fixed by drawing fill and stroke separately 48 | ggplot(mtcars, aes(as.factor(gear), disp)) + 49 | with_inner_glow( 50 | geom_boxplot(colour = NA), 51 | colour = 'red', 52 | sigma = 10 53 | ) + 54 | geom_boxplot(fill = NA) 55 | 56 | } 57 | \seealso{ 58 | Other glow filters: 59 | \code{\link{with_outer_glow}()} 60 | } 61 | \concept{glow filters} 62 | -------------------------------------------------------------------------------- /man/with_interpolate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/interpolate.R 3 | \name{with_interpolate} 4 | \alias{with_interpolate} 5 | \title{Blend two layerrs together by averaging them out} 6 | \usage{ 7 | with_interpolate(x, bg_layer, src_percent, bg_percent = 100 - src_percent, ...) 8 | } 9 | \arguments{ 10 | \item{x}{A ggplot2 layer object, a ggplot, a grob, or a character string 11 | naming a filter} 12 | 13 | \item{bg_layer}{The layer to blend with} 14 | 15 | \item{src_percent, bg_percent}{The contribution of this layer and the 16 | background layer to the result. Should be between 0 and 100} 17 | 18 | \item{...}{Arguments to be passed on to methods. See 19 | \link[=object_support]{the documentation of supported object} for a description of 20 | object specific arguments.} 21 | } 22 | \value{ 23 | Depending on the input, either a \code{grob}, \code{Layer}, list of \code{Layer}s, 24 | \code{guide}, or \code{element} object. Assume the output can be used in the same 25 | context as the input. 26 | } 27 | \description{ 28 | Two layers can be blended together in the literal sense (not like 29 | \code{\link[=with_blend]{with_blend()}}) so that the result is the average of the two. This is the 30 | purpose of \code{with_interpolate()}. 31 | } 32 | \examples{ 33 | library(ggplot2) 34 | ggplot(mpg, aes(class, hwy)) + 35 | as_reference(geom_boxplot(), 'box') + 36 | with_interpolate(geom_point(), bg_layer = 'box', src_percent = 70) 37 | 38 | } 39 | \seealso{ 40 | Other blend filters: 41 | \code{\link{with_blend_custom}()}, 42 | \code{\link{with_blend}()}, 43 | \code{\link{with_mask}()} 44 | } 45 | \concept{blend filters} 46 | -------------------------------------------------------------------------------- /man/with_kernel.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/kernel.R 3 | \name{with_kernel} 4 | \alias{with_kernel} 5 | \title{Apply a gaussian blur to your layer} 6 | \usage{ 7 | with_kernel( 8 | x, 9 | kernel = "Gaussian:0x2", 10 | iterations = 1, 11 | scaling = NULL, 12 | bias = NULL, 13 | stack = FALSE, 14 | ... 15 | ) 16 | } 17 | \arguments{ 18 | \item{x}{A ggplot2 layer object, a ggplot, a grob, or a character string 19 | naming a filter} 20 | 21 | \item{kernel}{either a square matrix or a string. The string can either be a 22 | parameterized \link[magick:kernel_types]{kerneltype} such as: \code{"DoG:0,0,2"} or \code{"Diamond"} 23 | or it can contain a custom matrix (see examples)} 24 | 25 | \item{iterations}{number of iterations} 26 | 27 | \item{scaling}{string with kernel scaling. The special flag \code{"!"} automatically scales to full 28 | dynamic range, for example: \code{"50\%!"}} 29 | 30 | \item{bias}{output bias string, for example \code{"50\%"}} 31 | 32 | \item{stack}{Should the original layer be placed on top?} 33 | 34 | \item{...}{Arguments to be passed on to methods. See 35 | \link[=object_support]{the documentation of supported object} for a description of 36 | object specific arguments.} 37 | } 38 | \value{ 39 | Depending on the input, either a \code{grob}, \code{Layer}, list of \code{Layer}s, 40 | \code{guide}, or \code{element} object. Assume the output can be used in the same 41 | context as the input. 42 | } 43 | \description{ 44 | This filter allows you to apply a custom kernel to your layer, thus giving 45 | you more control than e.g. \code{\link[=with_blur]{with_blur()}} which is also applying a kernel. 46 | } 47 | \examples{ 48 | library(ggplot2) 49 | # Add directional blur using the comet kernel 50 | ggplot(mtcars, aes(mpg, disp)) + 51 | with_kernel(geom_point(size = 3), 'Comet:0,10') 52 | 53 | } 54 | -------------------------------------------------------------------------------- /man/with_mask.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mask.R 3 | \name{with_mask} 4 | \alias{with_mask} 5 | \title{Apply a mask to a layer} 6 | \usage{ 7 | with_mask(x, mask, invert = FALSE, ...) 8 | } 9 | \arguments{ 10 | \item{x}{A ggplot2 layer object, a ggplot, a grob, or a character string 11 | naming a filter} 12 | 13 | \item{mask}{The layer to use as mask. Can either be a string 14 | identifying a registered filter, or a raster object. Will by default extract 15 | the luminosity of the layer and use that as mask. To pick another channel use 16 | one of the \link[=Channels]{channel specification} function.} 17 | 18 | \item{invert}{Should the mask be inverted before applying it} 19 | 20 | \item{...}{Arguments to be passed on to methods. See 21 | \link[=object_support]{the documentation of supported object} for a description of 22 | object specific arguments.} 23 | } 24 | \value{ 25 | Depending on the input, either a \code{grob}, \code{Layer}, list of \code{Layer}s, 26 | \code{guide}, or \code{element} object. Assume the output can be used in the same 27 | context as the input. 28 | } 29 | \description{ 30 | This filter applies a mask to the given layer, i.e. sets the opacity of the 31 | layer based on another layer 32 | } 33 | \examples{ 34 | library(ggplot2) 35 | volcano_raster <- as.raster((volcano - min(volcano))/diff(range(volcano))) 36 | circle <- data.frame( 37 | x = cos(seq(0, 2*pi, length.out = 360)), 38 | y = sin(seq(0, 2*pi, length.out = 360)) 39 | ) 40 | 41 | ggplot() + 42 | as_reference( 43 | geom_polygon(aes(x = x, y = y), circle), 44 | id = 'circle' 45 | ) + 46 | with_mask( 47 | annotation_raster(volcano_raster, -1, 1, -1, 1, TRUE), 48 | mask = ch_alpha('circle') 49 | ) 50 | 51 | # use invert = TRUE to flip the mask 52 | ggplot() + 53 | as_reference( 54 | geom_polygon(aes(x = x, y = y), circle), 55 | id = 'circle' 56 | ) + 57 | with_mask( 58 | annotation_raster(volcano_raster, -1, 1, -1, 1, TRUE), 59 | mask = ch_alpha('circle'), 60 | invert = TRUE 61 | ) 62 | 63 | } 64 | \seealso{ 65 | Other blend filters: 66 | \code{\link{with_blend_custom}()}, 67 | \code{\link{with_blend}()}, 68 | \code{\link{with_interpolate}()} 69 | } 70 | \concept{blend filters} 71 | -------------------------------------------------------------------------------- /man/with_motion_blur.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/motion_blur.R 3 | \name{with_motion_blur} 4 | \alias{with_motion_blur} 5 | \title{Apply a motion blur to your layer} 6 | \usage{ 7 | with_motion_blur(x, sigma = 0.5, angle = 0, ...) 8 | } 9 | \arguments{ 10 | \item{x}{A ggplot2 layer object, a ggplot, a grob, or a character string 11 | naming a filter} 12 | 13 | \item{sigma}{The standard deviation of the gaussian kernel. Increase it to 14 | apply more blurring. If a numeric it will be interpreted as given in pixels. 15 | If a unit object it will automatically be converted to pixels at rendering 16 | time} 17 | 18 | \item{angle}{Direction of the movement in degrees (0 corresponds to a 19 | left-to-right motion and the angles move in clockwise direction)} 20 | 21 | \item{...}{Arguments to be passed on to methods. See 22 | \link[=object_support]{the documentation of supported object} for a description of 23 | object specific arguments.} 24 | } 25 | \value{ 26 | Depending on the input, either a \code{grob}, \code{Layer}, list of \code{Layer}s, 27 | \code{guide}, or \code{element} object. Assume the output can be used in the same 28 | context as the input. 29 | } 30 | \description{ 31 | This filter adds a directional blur to the provided ggplot layer. The amount 32 | of blur, as well as the angle, can be controlled. 33 | } 34 | \examples{ 35 | \dontshow{if (!ggfx:::is_rcmd_check()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} 36 | library(ggplot2) 37 | ggplot(mtcars, aes(mpg, disp)) + 38 | with_motion_blur( 39 | geom_point(size = 3), 40 | sigma = 6, 41 | angle = -45 42 | ) 43 | \dontshow{\}) # examplesIf} 44 | } 45 | \seealso{ 46 | Other blur filters: 47 | \code{\link{with_blur}()}, 48 | \code{\link{with_variable_blur}()} 49 | } 50 | \concept{blur filters} 51 | -------------------------------------------------------------------------------- /man/with_ordered_dither.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/circle_dither.R, R/custom_dither.R, 3 | % R/halftone_dither.R, R/ordered_dither.R 4 | \name{with_circle_dither} 5 | \alias{with_circle_dither} 6 | \alias{with_custom_dither} 7 | \alias{with_halftone_dither} 8 | \alias{with_ordered_dither} 9 | \title{Dither image using a threshold dithering map} 10 | \usage{ 11 | with_circle_dither( 12 | x, 13 | map_size = 7, 14 | levels = NULL, 15 | black = TRUE, 16 | colourspace = "sRGB", 17 | offset = NULL, 18 | ... 19 | ) 20 | 21 | with_custom_dither( 22 | x, 23 | map = "checks", 24 | levels = NULL, 25 | colourspace = "sRGB", 26 | offset = NULL, 27 | ... 28 | ) 29 | 30 | with_halftone_dither( 31 | x, 32 | map_size = 8, 33 | levels = NULL, 34 | angled = TRUE, 35 | colourspace = "sRGB", 36 | offset = NULL, 37 | ... 38 | ) 39 | 40 | with_ordered_dither(x, map_size = 8, levels = NULL, colourspace = "sRGB", ...) 41 | } 42 | \arguments{ 43 | \item{x}{A ggplot2 layer object, a ggplot, a grob, or a character string 44 | naming a filter} 45 | 46 | \item{map_size}{One of 2, 3, 4, or 8. Sets the threshold map used for 47 | dithering. The larger, the better approximation of the input colours} 48 | 49 | \item{levels}{The number of threshold levels in each channel. Either a single 50 | integer to set the same number of levels in each channel, or 3 values to set 51 | the levels individually for each colour channel} 52 | 53 | \item{black}{Should the map consist of dark circles expanding into the light, 54 | or the reverse} 55 | 56 | \item{colourspace}{In which colourspace should the dithering be calculated} 57 | 58 | \item{offset}{The angle offset between the colour channels} 59 | 60 | \item{...}{Arguments to be passed on to methods. See 61 | \link[=object_support]{the documentation of supported object} for a description of 62 | object specific arguments.} 63 | 64 | \item{map}{The name of the threshold map to use as understood by 65 | \code{\link[magick:color]{magick::image_ordered_dither()}}} 66 | 67 | \item{angled}{Should the halftone pattern be at an angle or orthogonal} 68 | } 69 | \value{ 70 | Depending on the input, either a \code{grob}, \code{Layer}, list of \code{Layer}s, 71 | \code{guide}, or \code{element} object. Assume the output can be used in the same 72 | context as the input. 73 | } 74 | \description{ 75 | These filters reduces the number of colours in your layer and uses various 76 | threshold maps along with a dithering algorithm to disperse colour error. 77 | } 78 | \examples{ 79 | \dontshow{if (!ggfx:::is_rcmd_check()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} 80 | library(ggplot2) 81 | 82 | # Ordered dither 83 | ggplot(faithfuld, aes(waiting, eruptions)) + 84 | with_ordered_dither( 85 | geom_raster(aes(fill = density), interpolate = TRUE) 86 | ) + 87 | scale_fill_continuous(type = 'viridis') 88 | 89 | # Halftone dither 90 | ggplot(faithfuld, aes(waiting, eruptions)) + 91 | with_halftone_dither( 92 | geom_raster(aes(fill = density), interpolate = TRUE) 93 | ) + 94 | scale_fill_continuous(type = 'viridis') 95 | 96 | # Circle dither with offset 97 | ggplot(faithfuld, aes(waiting, eruptions)) + 98 | with_circle_dither( 99 | geom_raster(aes(fill = density), interpolate = TRUE), 100 | offset = 29, 101 | colourspace = 'cmyk' 102 | ) + 103 | scale_fill_continuous(type = 'viridis') 104 | \dontshow{\}) # examplesIf} 105 | } 106 | \seealso{ 107 | Other dithering filters: 108 | \code{\link{with_dither}()} 109 | } 110 | \concept{dithering filters} 111 | -------------------------------------------------------------------------------- /man/with_outer_glow.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/outer_glow.R 3 | \name{with_outer_glow} 4 | \alias{with_outer_glow} 5 | \title{Apply an outer glow to your layer} 6 | \usage{ 7 | with_outer_glow(x, colour = "black", sigma = 3, expand = 0, ...) 8 | } 9 | \arguments{ 10 | \item{x}{A ggplot2 layer object, a ggplot, a grob, or a character string 11 | naming a filter} 12 | 13 | \item{colour}{The colour of the glow} 14 | 15 | \item{sigma}{The standard deviation of the gaussian kernel. Increase it to 16 | apply more blurring. If a numeric it will be interpreted as given in pixels. 17 | If a unit object it will automatically be converted to pixels at rendering 18 | time} 19 | 20 | \item{expand}{An added dilation to the glow mask before blurring it} 21 | 22 | \item{...}{Arguments to be passed on to methods. See 23 | \link[=object_support]{the documentation of supported object} for a description of 24 | object specific arguments.} 25 | } 26 | \value{ 27 | Depending on the input, either a \code{grob}, \code{Layer}, list of \code{Layer}s, 28 | \code{guide}, or \code{element} object. Assume the output can be used in the same 29 | context as the input. 30 | } 31 | \description{ 32 | This filter adds an outer glow to your layer with a specific colour and size. 33 | For very thin objects such as text it may be beneficial to add some 34 | expansion. See the examples for this. 35 | } 36 | \examples{ 37 | library(ggplot2) 38 | 39 | ggplot(mtcars, aes(as.factor(gear), disp)) + 40 | with_outer_glow( 41 | geom_boxplot(), 42 | colour = 'red', 43 | sigma = 10 44 | ) 45 | 46 | # For thin objects (as the whiskers above) you may need to add a bit of 47 | # expansion to make the glow visible: 48 | 49 | ggplot(mtcars, aes(mpg, disp)) + 50 | geom_point() + 51 | with_outer_glow( 52 | geom_text(aes(label = rownames(mtcars))), 53 | colour = 'white', 54 | sigma = 10, 55 | expand = 10 56 | ) 57 | 58 | } 59 | \seealso{ 60 | Other glow filters: 61 | \code{\link{with_inner_glow}()} 62 | } 63 | \concept{glow filters} 64 | -------------------------------------------------------------------------------- /man/with_raster.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/raster.R 3 | \name{with_raster} 4 | \alias{with_raster} 5 | \title{Convert a layer to a raster} 6 | \usage{ 7 | with_raster(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{A ggplot2 layer object, a ggplot, a grob, or a character string 11 | naming a filter} 12 | 13 | \item{...}{Arguments to be passed on to methods. See 14 | \link[=object_support]{the documentation of supported object} for a description of 15 | object specific arguments.} 16 | } 17 | \value{ 18 | Depending on the input, either a \code{grob}, \code{Layer}, list of \code{Layer}s, 19 | \code{guide}, or \code{element} object. Assume the output can be used in the same 20 | context as the input. 21 | } 22 | \description{ 23 | This filter simply converts the given layer, grob, or ggplot to a raster and 24 | inserts it back again. It is useful for vector graphics devices such as 25 | svglite if a layer contains a huge amount of primitives that would make the 26 | file slow to render. \code{as_reference(x, id)} is a shorthand for 27 | \code{with_raster(x, id = id, include = FALSE)} that makes the intent of using 28 | this grob or layer as only a filter reference clear. 29 | } 30 | \examples{ 31 | library(ggplot2) 32 | ggplot(mtcars, aes(mpg, disp)) + 33 | with_raster(geom_point(data = mtcars, size = 3)) 34 | 35 | } 36 | -------------------------------------------------------------------------------- /man/with_shade.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/shade.R 3 | \name{with_shade} 4 | \alias{with_shade} 5 | \title{Apply a gaussian blur to your layer} 6 | \usage{ 7 | with_shade( 8 | x, 9 | height_map, 10 | azimuth = 30, 11 | elevation = 30, 12 | strength = 10, 13 | sigma = 0, 14 | blend_type = "overlay", 15 | ... 16 | ) 17 | } 18 | \arguments{ 19 | \item{x}{A ggplot2 layer object, a ggplot, a grob, or a character string 20 | naming a filter} 21 | 22 | \item{height_map}{The layer to use as a height_map. Can either be a string 23 | identifying a registered filter, or a raster object. Will by default extract 24 | the luminosity of the layer and use that as mask. To pick another channel use 25 | one of the \link[=Channels]{channel specification} function.} 26 | 27 | \item{azimuth, elevation}{The location of the light source.} 28 | 29 | \item{strength}{The strength of the shading. A numeric larger or equal to \code{1}} 30 | 31 | \item{sigma}{The sigma used for blurring the shading before applying it. 32 | Setting it to \code{0} turns off blurring. Using a high \code{strength} may reveal 33 | artefacts in the calculated shading, especially if the \code{height_map} is 34 | low-detail. Adding a slight blur may remove some of those artefacts.} 35 | 36 | \item{blend_type}{A blend type as used in \code{\link[=with_blend]{with_blend()}} for adding the 37 | calculated shading to the layer. Should generally be left as-is} 38 | 39 | \item{...}{Arguments to be passed on to methods. See 40 | \link[=object_support]{the documentation of supported object} for a description of 41 | object specific arguments.} 42 | } 43 | \value{ 44 | Depending on the input, either a \code{grob}, \code{Layer}, list of \code{Layer}s, 45 | \code{guide}, or \code{element} object. Assume the output can be used in the same 46 | context as the input. 47 | } 48 | \description{ 49 | This filter adds a blur to the provided ggplot layer. The amount of blur can 50 | be controlled and the result can optionally be put underneath the original 51 | layer. 52 | } 53 | \examples{ 54 | library(ggplot2) 55 | volcano_long <- data.frame( 56 | x = as.vector(col(volcano)), 57 | y = as.vector(row(volcano)), 58 | z = as.vector(volcano) 59 | ) 60 | ggplot(volcano_long, aes(y, x)) + 61 | as_reference( 62 | geom_raster(aes(alpha = z), fill = 'black', interpolate = TRUE, show.legend = FALSE), 63 | id = 'height_map' 64 | ) + 65 | with_shade( 66 | geom_contour_filled(aes(z = z, fill = after_stat(level))), 67 | height_map = ch_alpha('height_map'), 68 | azimuth = 150, 69 | height = 5, 70 | sigma = 10 71 | ) + 72 | coord_fixed() + 73 | guides(fill = guide_coloursteps(barheight = 10)) 74 | 75 | 76 | } 77 | -------------------------------------------------------------------------------- /man/with_shadow.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/shadow.R 3 | \name{with_shadow} 4 | \alias{with_shadow} 5 | \title{Apply a drop shadow to a layer} 6 | \usage{ 7 | with_shadow( 8 | x, 9 | colour = "black", 10 | x_offset = 10, 11 | y_offset = 10, 12 | sigma = 1, 13 | stack = TRUE, 14 | ... 15 | ) 16 | } 17 | \arguments{ 18 | \item{x}{A ggplot2 layer object, a ggplot, a grob, or a character string 19 | naming a filter} 20 | 21 | \item{colour}{The colour of the shadow} 22 | 23 | \item{x_offset, y_offset}{The offset of the shadow from the origin 24 | as numerics} 25 | 26 | \item{sigma}{The standard deviation of the gaussian kernel. Increase it to 27 | apply more blurring. If a numeric it will be interpreted as given in pixels. 28 | If a unit object it will automatically be converted to pixels at rendering 29 | time} 30 | 31 | \item{stack}{Should the original layer be placed on top?} 32 | 33 | \item{...}{Arguments to be passed on to methods. See 34 | \link[=object_support]{the documentation of supported object} for a description of 35 | object specific arguments.} 36 | } 37 | \value{ 38 | Depending on the input, either a \code{grob}, \code{Layer}, list of \code{Layer}s, 39 | \code{guide}, or \code{element} object. Assume the output can be used in the same 40 | context as the input. 41 | } 42 | \description{ 43 | This filter applies the familiar drop-shadow effect on elements in a layer. 44 | It takes the outline of each shape, offsets it from its origin and applies a 45 | blur to it. 46 | } 47 | \examples{ 48 | library(ggplot2) 49 | ggplot(mtcars, aes(mpg, disp)) + 50 | with_shadow(geom_point(colour = 'red', size = 3), sigma = 3) 51 | 52 | } 53 | -------------------------------------------------------------------------------- /man/with_variable_blur.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/variable_blur.R 3 | \name{with_variable_blur} 4 | \alias{with_variable_blur} 5 | \title{Apply a variable blur to a layer} 6 | \usage{ 7 | with_variable_blur( 8 | x, 9 | x_sigma, 10 | y_sigma = x_sigma, 11 | angle = NULL, 12 | x_scale = 1, 13 | y_scale = x_scale, 14 | angle_range = 0, 15 | ... 16 | ) 17 | } 18 | \arguments{ 19 | \item{x}{A ggplot2 layer object, a ggplot, a grob, or a character string 20 | naming a filter} 21 | 22 | \item{x_sigma, y_sigma, angle}{The layers to use for looking up the sigma 23 | values and angledefining the blur ellipse at every point. Can either be a 24 | string identifying a registered filter, or a raster object. The maps will be 25 | resized to match the dimensions of x. Only one channel will be used - see 26 | \link[=Channels]{the docs on channels} for info on how to set them.} 27 | 28 | \item{x_scale, y_scale}{Which sigma should a maximal channel value correspond 29 | to? If a numeric it will be interpreted as pixel dimensions. If a unit object 30 | it will be converted to pixel dimension when rendered.} 31 | 32 | \item{angle_range}{The minimum and maximum angle that min and max in the 33 | \code{angle} layer should correspond to. If \code{angle == NULL} or only a single value 34 | is provided to \code{angle_range} the rotation will be constant across the whole 35 | layer} 36 | 37 | \item{...}{Arguments to be passed on to methods. See 38 | \link[=object_support]{the documentation of supported object} for a description of 39 | object specific arguments.} 40 | } 41 | \value{ 42 | Depending on the input, either a \code{grob}, \code{Layer}, list of \code{Layer}s, 43 | \code{guide}, or \code{element} object. Assume the output can be used in the same 44 | context as the input. 45 | } 46 | \description{ 47 | This filter will blur a layer, but in contrast to \code{\link[=with_blur]{with_blur()}} the amount 48 | and nature of the blur need not be constant across the layer. The blurring is 49 | based on a weighted ellipsoid, with width and height based on the values in 50 | the corresponding \code{x_sigma} and \code{y_sigma} layers. The angle of the ellipsoid 51 | can also be controlled and further varied based on another layer. 52 | } 53 | \examples{ 54 | \dontshow{if (!ggfx:::is_rcmd_check()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} 55 | library(ggplot2) 56 | cos_wave <- function(width, height) { 57 | x <- matrix(0, ncol = width, nrow = height) 58 | x <- cos(col(x)/100) 59 | as.raster((x + 1) / 2) 60 | } 61 | ggplot() + 62 | as_reference( 63 | cos_wave, 64 | id = "wave" 65 | ) + 66 | with_variable_blur( 67 | geom_point(aes(disp, mpg), mtcars, size = 4), 68 | x_sigma = ch_red("wave"), 69 | y_sigma = ch_alpha("wave"), 70 | angle = ch_red("wave"), 71 | x_scale = 15, 72 | y_scale = 15, 73 | angle_range = c(-45, 45) 74 | ) 75 | \dontshow{\}) # examplesIf} 76 | } 77 | \seealso{ 78 | Other blur filters: 79 | \code{\link{with_blur}()}, 80 | \code{\link{with_motion_blur}()} 81 | } 82 | \concept{blur filters} 83 | -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-120x120.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/ggfx/7852449b033b0ada4604865d79e5a327f6ef2e8c/pkgdown/favicon/apple-touch-icon-120x120.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-152x152.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/ggfx/7852449b033b0ada4604865d79e5a327f6ef2e8c/pkgdown/favicon/apple-touch-icon-152x152.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-180x180.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/ggfx/7852449b033b0ada4604865d79e5a327f6ef2e8c/pkgdown/favicon/apple-touch-icon-180x180.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-60x60.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/ggfx/7852449b033b0ada4604865d79e5a327f6ef2e8c/pkgdown/favicon/apple-touch-icon-60x60.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-76x76.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/ggfx/7852449b033b0ada4604865d79e5a327f6ef2e8c/pkgdown/favicon/apple-touch-icon-76x76.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/ggfx/7852449b033b0ada4604865d79e5a327f6ef2e8c/pkgdown/favicon/apple-touch-icon.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon-16x16.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/ggfx/7852449b033b0ada4604865d79e5a327f6ef2e8c/pkgdown/favicon/favicon-16x16.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon-32x32.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/ggfx/7852449b033b0ada4604865d79e5a327f6ef2e8c/pkgdown/favicon/favicon-32x32.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/ggfx/7852449b033b0ada4604865d79e5a327f6ef2e8c/pkgdown/favicon/favicon.ico -------------------------------------------------------------------------------- /vignettes/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | *.R 3 | -------------------------------------------------------------------------------- /vignettes/geoms.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Using ggfx in ggplot2 extensions" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{Using ggfx in ggplot2 extensions} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>", 14 | dev = "ragg_png", 15 | fig.width = 6 16 | ) 17 | ``` 18 | 19 | ggfx is designed to work especially well with ggplot2 and its extended ecosystem of extension packages. Any type of layer should (theoretically) support being wrapped by a `with_*()` filter and *just work*. There are things that aren't possible however, such as making the filter responsive to the data in the layer, or making the filter behave differently for different groups in the layer. For this to be possible you'll need to implement your own geom which uses ggfx. This vignette will show you an example of that. 20 | 21 | > Note that this vignette assumes familiarity with the ggplot2 extension system. There will not be spend time explaining the ins-and-outs of how a new geom is coded. To read more on how the extension system works, please consult 22 | 23 | ```{r setup} 24 | library(ggfx) 25 | library(ggplot2) 26 | ``` 27 | 28 | ## Our geom 29 | 30 | To illustrate how to use ggfx inside a geom, we are going to make an alternative version of `geom_smooth()`. Instead of showing the confidence interval as a ribbon we will show it as a blur with various sigma depending on the width of the confidence interval. We'll ignore for now whether this is a sound approach to showing confidence intervals. 31 | 32 | ### How to draw a variable blur 33 | 34 | ggfx already includes a `with_variable_blur()` filter which seems perfect for our task. However, we need to make this work for each single fit, and we need the blur amount to be based on some data in the layer. The way we do this is to add the filter to the grobs created by the geom directly in the `draw_group()` method: 35 | 36 | ```{r} 37 | GeomBlurrySmooth <- ggproto('GeomBlurrySmooth', GeomSmooth, 38 | setup_params = function(data, params) { 39 | params$max_range <- max(data$ymax - data$ymin) 40 | params 41 | }, 42 | draw_group = function (data, panel_params, coord, max_range, ...) { 43 | # Create a raster object representing the width oof the ribbon 44 | sigma <- ((data$ymax - data$ymin) / max_range)^1.5 45 | sigma_raster <- as.raster(matrix(sigma, nrow = 1)) 46 | 47 | # Use the annotate_raster geom to convert it to a raster that spans the x-range 48 | # of the line 49 | sigma_grob <- GeomRasterAnn$draw_panel( 50 | data, panel_params, coord, 51 | raster = sigma_raster, 52 | xmin = min(data$x), 53 | xmax = max(data$x), 54 | ymin = -Inf, 55 | ymax = Inf 56 | ) 57 | 58 | # Convert it to a reference layer 59 | ref_name <- paste0('GeomBlurrySmooth_<', data$group[1], '>') 60 | sigma_grob <- as_reference(sigma_grob, ref_name) 61 | 62 | # Figurer out the maximum sigma relative to the y scale 63 | max_sigma <- 0.5 * max_range / diff(panel_params$y$dimension()) 64 | 65 | # Create a line grob using geom_line 66 | line_grob <- GeomLine$draw_panel(data, panel_params, coord) 67 | 68 | # Add variable blur. Turn off blur in the x-direction and use the calulated max sigma 69 | # in the y direction 70 | line_grob <- with_variable_blur(line_grob, ch_red(ref_name), x_scale = 0, y_scale = unit(max_sigma, 'npc')) 71 | 72 | # Return the two grobs combined, making sure that the reference grob comes first 73 | grid::gList( 74 | sigma_grob, 75 | line_grob 76 | ) 77 | } 78 | ) 79 | ``` 80 | 81 | I've tried to annotate the code as much as possible. Most of the code pertains to this particular case, so the main takeaways are that you simply figure out the correct parameters for your filter in the geom and then return a filtered grob using these parameters. Another point of note is that you can create reference layers *within* your geom and use these - the only thing you need to take care of is that the name is unique to the group, and that the reference grob comes before the filtered grob that uses it. 82 | 83 | Without further ado, let's see if it works - let's start with the regular smooth geom: 84 | 85 | ```{r} 86 | ggplot(mpg, aes(displ, hwy)) + 87 | geom_smooth() 88 | ``` 89 | 90 | And now for our new version (we are using `stat_smooth()` because we haven't bothered creating a constructor). We'll increase the size of the line because otherwise the blur might make it disappear completely: 91 | 92 | ```{r} 93 | ggplot(mpg, aes(displ, hwy)) + 94 | stat_smooth(geom = GeomBlurrySmooth, size = 5, alpha = 1) 95 | ``` 96 | 97 | It works! Now, there are certainly room for improvements. The obvious place to start is the part of the line that peaks out from outside the blur area. This could easily be solved by padding the raster with some repeated values from the start and end, or we could mask the layer so it only showed the part that is getting blurred. I will leave that as an exercise to the reader. 98 | 99 | ## Filtering a filtered geom 100 | 101 | You may now sit and wonder: "Can I still add a filter to a geom that incorporates a filter?". Glad you asked! The answer is yes. Let us fix the ugly issue above with a mask filter (though it really should be fixed inside the geom) 102 | 103 | ```{r} 104 | ggplot(mpg, aes(displ, hwy)) + 105 | as_reference( 106 | geom_rect( 107 | aes(xmin = min(displ), xmax = max(displ), ymin = -Inf, ymax = Inf), 108 | inherit.aes = FALSE 109 | ), 110 | id = 'draw_area' 111 | ) + 112 | with_mask( 113 | stat_smooth(geom = GeomBlurrySmooth, size = 5, alpha = 1), 114 | mask = ch_alpha('draw_area') 115 | ) 116 | ``` 117 | 118 | Voila! 119 | 120 | I hope this opens up the door for many new ingenious geoms from the creative community of ggplot2 extension developers. Have fun! 121 | -------------------------------------------------------------------------------- /vignettes/ggfx.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Getting Started with Filters" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{Getting Started with Filters} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>", 14 | dev = "ragg_png", 15 | fig.width = 6 16 | ) 17 | ``` 18 | 19 | ```{r setup} 20 | library(ggfx) 21 | library(ggplot2) 22 | ``` 23 | 24 | The ggfx package is a way to gain access to pixel-level image filters in R plotting, especially when plotting with ggplot2. This document will give a short introduction to what image filters are, and how to use them through ggfx. It is assumed that you have some familiarity with ggplot2 as the ggplot2 code will not be explained in detail. 25 | 26 | ## What are filters 27 | 28 | Filters are basically functions that take in image data and return a new image. One of the more well-known examples are those available in photo apps such as Instagram, or video apps such as FaceTime. There is basically no end to the effects you can achieve, but some are obviously more useful than other. Filters work by changing the pixel color value of the input image through various means and can incorporate other images as part of the operation. 29 | 30 | ### Filters and vector graphics 31 | 32 | Since filters work on the pixel level they are not an obvious fit for vector graphics such as the graphics engine in R. This, however, does not mean that it is impossible and e.g. the SVG specification contains a bunch of different filters. The way that they integrate into the rendering of SVG's is that vector graphics with filters applied are rendered off-screen, run through the filter, and then added to the final render. 33 | 34 | The same can be done with R graphics through the grid graphics system (sorry, base graphics users), and this is exactly what ggfx does. 35 | 36 | ## Using ggfx 37 | 38 | Since there is no concept of filters build in to either grid or ggplot2 the API of ggfx might seem a little strange at first, but it is created in this way to provide a great deal of flexibility. Creating alternative geoms and grobs for everything exposed in ggplot2, grid, and all the packages in the extended ggplot2 ecosystem is simply unfeasible so something else had to be done that was compatible with both the grid and ggplot2 API. 39 | 40 | ### The with\_ functions 41 | 42 | Almost everything you'll be exposed to in ggfx is collected in the `with_*()` functions. These functions take as their first argument something to apply the filter on, e.g. a geom, a grob, or a full ggplot, as well as a bunch of other arguments related to controlling the filter. For example, to add blur to a geom you would do this: 43 | 44 | ```{r, message=FALSE} 45 | ggplot(mtcars, aes(x = mpg, y = disp)) + 46 | with_blur( 47 | geom_point(), 48 | sigma = unit(1, 'mm') 49 | ) + 50 | geom_smooth() 51 | ``` 52 | 53 | We observe that using `with_blur()` retain the ggplot2-ness of the object as it can still be added to a ggplot, and other layers can still be added afterwards. Further, we see that the blur filter is only applied to the point layer and not to the smooth layer or any other element in the plot (which is what we want). 54 | 55 | Now, the `with_*()` functions can be used with other objects besides layers. To blur the whole plot simply wrap it around the full ggplot object: 56 | 57 | ```{r} 58 | p <- ggplot(mtcars, aes(x = mpg, y = disp)) + 59 | geom_point() + 60 | geom_smooth() 61 | 62 | with_blur(p, sigma = unit(1, 'mm')) 63 | ``` 64 | 65 | At this point I assume you've guessed how to use it with a grob: 66 | 67 | ```{r} 68 | library(grid) 69 | 70 | circle_left <- circleGrob(x = 0.25, y = 0.5, r = 0.2) 71 | circle_right <- with_blur(circleGrob(x = 0.75, y = 0.5, r = 0.2), 72 | sigma = unit(1, 'mm')) 73 | grid.newpage() 74 | grid.draw(circle_left) 75 | grid.draw(circle_right) 76 | ``` 77 | 78 | ### Combining layers 79 | 80 | While some filters are stand-alone in the sense that they purely depend on the object they are applied to along with different settings, others combine multiple objects. To use these you need to be able to reference layers somehow. All `with_*()` functions takes an `id` which identifies this particular layer. By default, if you provide an id to a layer it will not be drawn as it is assumed that the purpose is to use the layer as part of some other filter. This can be changed by setting `include = TRUE`. A special case is wanting to use an object which have not been subjected to a filter. This can be done using `as_reference()`, which will assign an id to the unaltered object an turn off rendering of it. 81 | 82 | We'll illustrate all this using `with_blend()` which provides a wide variety of ways to blend two layers together: 83 | 84 | ```{r} 85 | checker <- expand.grid(x = 1:6, y = 1:6) 86 | checker <- checker[checker$x %% 2 == checker$y %% 2, ] 87 | 88 | ggplot() + 89 | as_reference( 90 | geom_tile(aes(x = x, y = y), checker), 91 | id = 'pattern' 92 | ) + 93 | with_blend( 94 | geom_text(aes(x = 3.5, y = 3.5, label = '🚀GGFX🚀'), size = 15), 95 | bg_layer = 'pattern', 96 | blend_type = 'xor' 97 | ) 98 | ``` 99 | 100 | As we can see, simply referencing an already created reference by name allows it to be used by another filter. The `xor` filter keeps the content of both layers but only in places where the other layer is empty, creating an effect that would be quite hard to obtain without any filter effects. 101 | 102 | You don't need to reference a layer though - you can pass in an existing raster object instead: 103 | 104 | ```{r} 105 | volcano_raster <- as.raster((volcano - min(volcano)) / diff(range(volcano))) 106 | 107 | ggplot() + 108 | with_blend( 109 | geom_text(aes(x = 3.5, y = 3.5, label = '🚀GGFX🚀'), size = 15), 110 | bg_layer = volcano_raster, 111 | blend_type = 'copy_green', 112 | alpha = 'src' 113 | ) 114 | ``` 115 | 116 | You can also provide a function that takes the dimensions of the area in pixels and returns a raster. 117 | 118 | ```{r} 119 | wave <- function(width, height) { 120 | mat <- matrix(0, ncol = width, nrow = height) 121 | as.raster((sin(col(mat) / 5) + 1) / 2) 122 | } 123 | 124 | ggplot() + 125 | with_blend( 126 | geom_tile(aes(x = x, y = y), checker), 127 | bg_layer = wave, 128 | blend_type = 'copy_red', 129 | alpha = 'src' 130 | ) 131 | ``` 132 | 133 | ### Using specific channels 134 | 135 | Some filters allow parameters to vary across the image. For example `with_variable_blur()` allows you to change blur amount across the layer as opposed to the fixed `with_blur()`. The way this works is that `with_variable_blur()` takes other layers in that encode the values to use in its pixel values. One can use different channels from the layer for this, e.g. the amount of green in a layer can control the amount of vertical blur, while the overall luminosity of the layer could control the horizontal blur. Selecting a channel to use from a reference can be done using one of the provided `ch_*()` functions (e.g. `ch_green()` and `ch_luminance()` for the examples above). 136 | 137 | We can show this by using the waved checker-pattern created above as input to a variable blur: 138 | 139 | ```{r} 140 | ggplot() + 141 | with_blend( 142 | geom_tile(aes(x = x, y = y), checker), 143 | bg_layer = wave, 144 | blend_type = 'copy_red', 145 | alpha = 'src', 146 | id = 'wave-checker' 147 | ) + 148 | with_variable_blur( 149 | geom_abline(aes(intercept = -6:6, slope = 1)), 150 | x_sigma = ch_hue('wave-checker'), 151 | y_sigma = ch_luminance('wave-checker'), 152 | x_scale = unit(3, 'mm') 153 | ) 154 | ``` 155 | --------------------------------------------------------------------------------