From 14fcec06cfba391f025668ed101ef940ce24c0f1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Souchet=20C=C3=A9line?= Date: Tue, 12 Sep 2023 16:45:44 +0200 Subject: [PATCH 1/9] add fun functions to create style for edges and shapes --- R/funs.R | 299 +++++++++++++++++++++++- tests/testthat/test-funs.R | 454 ++++++++++++++++++++++++++++++++++++- 2 files changed, 735 insertions(+), 18 deletions(-) diff --git a/R/funs.R b/R/funs.R index da2904c..c7d54f2 100644 --- a/R/funs.R +++ b/R/funs.R @@ -162,6 +162,249 @@ create_overlay_style <- function(font_color = NULL, ) } +#' @title Create the style for BPMN element +#' +#' @name create_element_style +#' +#' @description Internal function to create the correct style structure for the 'BPMN' element. +#' +#' @param elementIds The IDs of the BPMN elements to style. +#' @param stroke_color The stroke color for the element. +#' It can be any HTML color name or HEX code, or special keywords. +#' @param stroke_width The stroke width for the element, in pixels (1 to 50). +#' * If the set value is less than 1, the used value is 1. +#' * If the set value is greater than 50, the used value is 50. +#' * To hide the stroke, set the `stroke_color` property to `none`. +#' @param stroke_opacity The stroke opacity for the element, ranging from 0 to 100. +#' @param font_color The font color for the element. +#' It can be any HTML color name or HEX code, or special keywords. +#' @param font_family The font family for the element. +#' @param font_size The font size for the element, in pixels. +#' @param font_bold Should the font be bold? (default: `FALSE`) +#' @param font_italic Should the font be italic? (default: `FALSE`) +#' @param font_strike_through Should the font have a strike-through style? (default: `FALSE`) +#' @param font_underline Should the font be underlined? (default: `FALSE`) +#' @param font_opacity The font opacity for the element, ranging from 0 to 100. +#' @param opacity The opacity for the element, ranging from 0 to 100. +#' +#' @return A list representing the style for the specified BPMN elements. +#' +#' @details +#' # Special keywords +#' \describe{ +#' \item{`default`}{ +#' \itemize{ +#' \item This keyword allows you to reset a style property of the BPMN element to its initial value. +#' \item When applied to color properties, it bypasses the color specified in the 'BPMN' source if 'BPMN in Color' support is enabled. Instead, it uses the color defined in the default style of the 'BPMN' element.. +#' } +#' } +#' \item{`inherit`}{Applies the value from the immediate parent element.} +#' \item{`none`}{No color (used to hide strokes). Not available for `font_color`.} +#' \item{`swimlane`}{Applies the value from the nearest parent element with type `ShapeBpmnElementKind.LANE` or `ShapeBpmnElementKind.POOL`.} +#' } +#' +#' # Note +#' ## Opacity properties +#' * If the set value is less than 0, the used value is 0. +#' * If the set value is greater than 100, the used value is 100. +#' +#' ## ⚠️⚠️⚠️ `stroke_width` property ⚠️⚠️⚠️ +#' Changing the stroke width of Activities may be misleading, as the default stroke widths have a meaning according to the 'BPMN' Specification.\cr +#' For example, updating the stroke width of a task using the same value as the default stroke width of a Call Activity can be confusing.\cr +#' In this case, you should also change another property, such as the stroke color, to allow the user to differentiate between them. +#' +#' @keywords internal +create_element_style <- function(elementIds, + stroke_color = NULL, + stroke_width = NULL, + stroke_opacity = NULL, + font_color = NULL, + font_family = NULL, + font_size = NULL, + font_bold = NULL, + font_italic = NULL, + font_strike_through = NULL, + font_underline = NULL, + font_opacity = NULL, + opacity = NULL) { + if(!is.list(elementIds)) { + stop("elementIds must be a list!!") + } + + style <- .not_null_list( + stroke = create_stroke( + color = stroke_color, + width = stroke_width, + opacity = stroke_opacity + ), + font = create_font( + color = font_color, + family = font_family, + size = font_size, + isBold = font_bold, + isItalic = font_italic, + isStrikeThrough = font_strike_through, + isUnderline = font_underline, + opacity = font_opacity + ), + opacity = opacity + ) + ret <- list(elementIds = elementIds, style = style) +} + + +#' @title Create the style for BPMN edge +#' +#' @name create_edge_style +#' +#' @description +#' Use this function to create the correct style structure for the edge. +#' +#' @inherit create_element_style params sections +#' @return A list representing the style for the BPMN edge. +#' @examples +#' # Create a style with a blue stroke and a bold, red font. +#' edge_style <- create_edge_style( +#' elementIds = list('id_1', 'id_2'), +#' stroke_color = "blue", +#' stroke_width = 2, +#' font_color = "red", +#' font_bold = TRUE +#' ) +#' @export +create_edge_style <- function(elementIds, + stroke_color = NULL, + stroke_width = NULL, + stroke_opacity = NULL, + font_color = NULL, + font_family = NULL, + font_size = NULL, + font_bold = NULL, + font_italic = NULL, + font_strike_through = NULL, + font_underline = NULL, + font_opacity = NULL, + opacity = NULL) { + if (all(is.null( + c( + stroke_color, + stroke_width, + stroke_opacity, + font_color, + font_family, + font_size, + font_bold, + font_italic, + font_strike_through, + font_underline, + font_opacity, + opacity + ) + ))) { + stop( + "At least one style property (e.g., stroke_color, font_color, opacity, ...) must be provided!!" + ) + } + + ret <- create_element_style( + elementIds = elementIds, + stroke_color = stroke_color, + stroke_width = stroke_width, + stroke_opacity = stroke_opacity, + font_color = font_color, + font_family = font_family, + font_size = font_size, + font_bold = font_bold, + font_italic = font_italic, + font_strike_through = font_strike_through, + font_underline = font_underline, + font_opacity = font_opacity, + opacity = opacity + ) + return(ret) +} + + +#' @title Create the style for BPMN shape +#' +#' @name create_shape_style +#' +#' @description +#' Use this function to create the correct style structure for the shape. +#' +#' @inherit create_element_style params sections +#' @param fill_color The fill color for the shape +#' It can be any HTML color name or HEX code, special keywords, or a gradient create with [`create_gradient_fill`]. +#' @param fill_opacity The fill opacity for the shape, ranging from 0 to 100. +#' +#' @return A list representing the style for the BPMN shape. +#' @seealso \code{\link{create_gradient_fill}} +#' +#' @examples +#' # Create a style with a blue stroke, red font, and green fill color. +#' shape_style <- create_shape_style( +#' elementIds = list('id_1', 'id_2'), +#' stroke_color = "blue", +#' stroke_width = 2, +#' font_color = "red", +#' fill_color = "green" +#' ) +#' @export +create_shape_style <- function(elementIds, + stroke_color = NULL, + stroke_width = NULL, + stroke_opacity = NULL, + font_color = NULL, + font_family = NULL, + font_size = NULL, + font_bold = NULL, + font_italic = NULL, + font_strike_through = NULL, + font_underline = NULL, + font_opacity = NULL, + opacity = NULL, + fill_color = NULL, + fill_opacity = NULL) { + if (is.null(stroke_color) && + is.null(stroke_width) && + is.null(stroke_opacity) && + is.null(font_color) && + is.null(font_family) && + is.null(font_size) && + is.null(font_bold) && + is.null(font_italic) && + is.null(font_strike_through) && + is.null(font_underline) && + is.null(font_opacity) && + is.null(opacity) && + is.null(fill_color) && is.null(fill_opacity)) { + stop( + "At least one style property (e.g., stroke_color, font_color, fill_opacity, opacity, ...) must be provided!!" + ) + } + + res <- create_element_style( + elementIds = elementIds, + stroke_color = stroke_color, + stroke_width = stroke_width, + stroke_opacity = stroke_opacity, + font_color = font_color, + font_family = font_family, + font_size = font_size, + font_bold = font_bold, + font_italic = font_italic, + font_strike_through = font_strike_through, + font_underline = font_underline, + font_opacity = font_opacity, + opacity = opacity + ) + + if (!is.null(fill_color) || !is.null(fill_opacity) ) { + res$style$fill <- create_fill(color = fill_color, opacity = fill_opacity) + } + return(res) +} + #' @title Internal function to create the font style of an overlay or a 'BPMN' element #' #' @name create_font @@ -177,11 +420,17 @@ create_overlay_style <- function(font_color = NULL, #' @returns The font style object of the overlay #' #' @noRd -create_font <- function(color = NULL, size = NULL) { +create_font <- function(color = NULL, size = NULL, family = NULL, isBold = NULL, isItalic = NULL, isStrikeThrough = NULL, isUnderline = NULL, opacity = NULL) { ret <- .not_null_list( color = color, - size = size + size = size, + family = family, + opacity = opacity, + isBold = isBold, + isItalic = isItalic, + isStrikeThrough = isStrikeThrough, + isUnderline = isUnderline ) } @@ -199,13 +448,36 @@ create_font <- function(color = NULL, size = NULL) { #' @returns The fill style object of the overlay #' #' @noRd -create_fill <- function(color) { +create_fill <- function(color = NULL, opacity = NULL) { ret <- .not_null_list( - color = color + color = color, + opacity = opacity ) } +#' @title Create a gradient fill style for an element +#' +#' @name create_gradient_fill +#' +#' @description Create a gradient fill style for an element. +#' +#' @param direction The direction of the gradient (e.g., \code{left-to-right}, \code{right-to-left}, \code{bottom-to-top}, \code{top-to-bottom}). +#' Taking the example of bottom-to-top, this means that the start color is at the bottom of the paint pattern and the end color is at the top, with a gradient between them. +#' @param start_color The starting color of the gradient. It can be any HTML color name or HEX code, as well as special keywords such as `inherit`, `none`, `swimlane`. +#' @param end_color The ending color of the gradient. It can be any HTML color name or HEX code, as well as special keywords such as `inherit`, `none`, `swimlane`. +#' +#' @return A gradient fill style object. +#' +#' @export +create_gradient_fill <- function(direction, start_color, end_color) { + ret <- .not_null_list( + direction = direction, + startColor = start_color, + endColor = end_color + ) +} + #' @title Internal function to create the stroke style of an overlay or a 'BPMN' element #' #' @name create_stroke @@ -220,10 +492,12 @@ create_fill <- function(color) { #' @returns The stroke style object of the overlay #' #' @noRd -create_stroke <- function(color) { +create_stroke <- function(color = NULL, width = NULL, opacity = NULL) { ret <- .not_null_list( - color = color + color = color, + width = width, + opacity = opacity ) } @@ -236,7 +510,8 @@ create_stroke <- function(color) { build_bpmnContent <- function( bpmnXML, overlays = NULL, - enableDefaultOverlayStyle + enableDefaultOverlayStyle, + bpmnElementStyles = NULL ) { # load bpmn content if (inherits( @@ -269,7 +544,7 @@ build_bpmnContent <- function( bpmnContent = bpmnContent, enableDefaultOverlayStyle = enableDefaultOverlayStyle ) - + if (length(overlays)) { # In case the user passes a single parameter as overlays (instead of a list), we wrap it into a list so the js can work x$overlays <- if (is.list(overlays[[1]])) { @@ -278,6 +553,14 @@ build_bpmnContent <- function( list(overlays) } } + + if (length(bpmnElementStyles)) { + if(is.list(bpmnElementStyles[[1]]) && !is.null(bpmnElementStyles[[1]]$elementIds) && !is.null(bpmnElementStyles[[1]]$style)) { + x$bpmnElementStyles <- bpmnElementStyles + } else { + stop("bpmnElementStyles must be a list of !!") + } + } return(x) } diff --git a/tests/testthat/test-funs.R b/tests/testthat/test-funs.R index ec51e75..fed3bec 100644 --- a/tests/testthat/test-funs.R +++ b/tests/testthat/test-funs.R @@ -155,13 +155,414 @@ describe("create_overlay_style works", { expect_type(res, "list") expect_length(res, 0) }) +}) +describe("create_edge_style works", { + test_that("with invalid elementIds argument", { + expect_error(create_edge_style(elementIds = "invalid_element_id", stroke_color = "blue"), regexp = "elementIds must be a list!!", fixed = TRUE) + }) + + test_that("with no optional arguments", { + expect_error(create_edge_style(elementIds = list("edge-1")), regexp = "At least one style property (e.g., stroke_color, font_color, opacity, ...) must be provided!!", fixed = TRUE) + }) + + test_that("with opacity, font, stroke", { + res <- create_edge_style( + elementIds = list("edge-1"), + stroke_color = "red", + stroke_width = 2, + stroke_opacity = 80, + font_color = "blue", + font_family = "Arial", + font_size = 14, + font_bold = TRUE, + font_italic = FALSE, + font_strike_through = TRUE, + font_underline = FALSE, + font_opacity = 60, + opacity = 70 + ) + + expect_type(res, "list") + expect_length(res, 2) + expect_named(res, c("elementIds", "style")) + + expect_equal(res$elementIds, list("edge-1")) + + style <- res$style + expect_type(style, "list") + expect_length(style, 3) + expect_named(style, c("stroke", "font", "opacity")) + + expect_equal(style$opacity, 70) + expect_equal(style$stroke, list( + color = "red", + width = 2, + opacity = 80 + )) + expect_equal( + style$font, + list( + color = "blue", + size = 14, + family = "Arial", + opacity = 60, + isBold = TRUE, + isItalic = FALSE, + isStrikeThrough = TRUE, + isUnderline = FALSE + ) + ) + }) + + test_that("with only opacity", { + res <- create_edge_style(elementIds = list("edge-1"), opacity = 60) + + expect_type(res, "list") + expect_length(res, 2) + expect_named(res, c("elementIds", "style")) + + expect_equal(res$elementIds, list("edge-1")) + + style <- res$style + expect_type(style, "list") + expect_length(style, 1) + expect_named(style, c("opacity")) + expect_equal(style$opacity, 60) + }) + + test_that("with only font", { + res <- + create_edge_style( + elementIds = list("edge-1"), + font_color = "blue", + font_family = "Open Sans", + font_size = 14, + font_opacity = 80, + font_bold = TRUE, + font_italic = FALSE, + font_strike_through = FALSE, + font_underline = TRUE + ) + + expect_type(res, "list") + expect_length(res, 2) + expect_named(res, c("elementIds", "style")) + + expect_equal(res$elementIds, list("edge-1")) + + style <- res$style + expect_type(style, "list") + expect_type(style, "list") + expect_length(style, 1) + expect_named(style, c("font")) + expect_equal( + style$font, + list( + color = "blue", + size = 14, + family = "Open Sans", + opacity = 80, + isBold = TRUE, + isItalic = FALSE, + isStrikeThrough = FALSE, + isUnderline = TRUE + ) + ) + }) + + test_that("with only stroke", { + res <- + create_edge_style( + elementIds = list("edge-1"), + stroke_color = "red", + stroke_width = 2, + stroke_opacity = 45 + ) + + expect_type(res, "list") + expect_length(res, 2) + expect_named(res, c("elementIds", "style")) + + expect_equal(res$elementIds, list("edge-1")) + + style <- res$style + expect_type(style, "list") + expect_length(style, 1) + expect_named(style, c("stroke")) + expect_equal(style$stroke, list( + color = "red", + width = 2, + opacity = 45 + )) + }) + + test_that("with font color with 'inherit'", { + res <- create_edge_style(elementIds = list("edge-1"), font_color = "inherit") + + expect_type(res, "list") + expect_length(res, 2) + expect_named(res, c("elementIds", "style")) + + expect_equal(res$elementIds, list("edge-1")) + expect_equal(res$style$font$color, "inherit") + }) + + test_that("with stroke color with 'default'", { + res <- create_edge_style(elementIds = list("edge-1"), stroke_color = "default") + + expect_type(res, "list") + expect_length(res, 2) + expect_named(res, c("elementIds", "style")) + + expect_equal(res$elementIds, list("edge-1")) + expect_equal(res$style$stroke$color, "default") + }) + + test_that("with stroke width with 'default'", { + res <- create_edge_style(elementIds = list("edge-1"), stroke_width = "default") + + expect_type(res, "list") + expect_length(res, 2) + expect_named(res, c("elementIds", "style")) + + expect_equal(res$elementIds, list("edge-1")) + expect_equal(res$style$stroke$width, "default") + }) +}) + +describe("create_shape_style works", { + test_that("with invalid elementIds argument", { + expect_error(create_shape_style(elementIds = "invalid_element_id", stroke_color = "blue"), regexp = "elementIds must be a list!!", fixed = TRUE) + }) + + test_that("with no optional arguments", { + expect_error(create_shape_style(elementIds = list("shape-1")), regexp = "At least one style property (e.g., stroke_color, font_color, fill_opacity, opacity, ...) must be provided!!", fixed = TRUE) + }) + + test_that("with opacity, font, stroke, fill", { + res <- create_shape_style( + elementIds = list("shape-1"), + stroke_color = "red", + stroke_width = 2, + stroke_opacity = 80, + font_color = "blue", + font_family = "Arial", + font_size = 14, + font_bold = TRUE, + font_italic = FALSE, + font_strike_through = TRUE, + font_underline = FALSE, + font_opacity = 60, + opacity = 70, + fill_color = "green", + fill_opacity = 40 + ) + + expect_type(res, "list") + expect_length(res, 2) + expect_named(res, c("elementIds", "style")) + + expect_equal(res$elementIds, list("shape-1")) + + style <- res$style + expect_type(style, "list") + expect_length(style, 4) + expect_named(style, c("stroke", "font", "opacity", "fill")) + + expect_equal(style$opacity, 70) + expect_equal(style$stroke, list( + color = "red", + width = 2, + opacity = 80 + )) + expect_equal( + style$font, + list( + color = "blue", + size = 14, + family = "Arial", + opacity = 60, + isBold = TRUE, + isItalic = FALSE, + isStrikeThrough = TRUE, + isUnderline = FALSE + ) + ) + expect_equal(style$fill, list(color = "green", opacity = 40)) + }) + + test_that("with only opacity", { + res <- create_shape_style(elementIds = list("shape-1"), opacity = 60) + + expect_type(res, "list") + expect_length(res, 2) + expect_named(res, c("elementIds", "style")) + + expect_equal(res$elementIds, list("shape-1")) + + style <- res$style + expect_type(style, "list") + expect_length(style, 1) + expect_named(style, c("opacity")) + expect_equal(style$opacity, 60) + }) + + test_that("with only font", { + res <- + create_shape_style( + elementIds = list("shape-1"), + font_color = "blue", + font_family = "Open Sans", + font_size = 14, + font_opacity = 80, + font_bold = TRUE, + font_italic = FALSE, + font_strike_through = FALSE, + font_underline = TRUE + ) + + expect_type(res, "list") + expect_length(res, 2) + expect_named(res, c("elementIds", "style")) + + expect_equal(res$elementIds, list("shape-1")) + + style <- res$style + expect_type(style, "list") + expect_length(style, 1) + expect_named(style, c("font")) + expect_equal( + style$font, + list( + color = "blue", + size = 14, + family = "Open Sans", + opacity = 80, + isBold = TRUE, + isItalic = FALSE, + isStrikeThrough = FALSE, + isUnderline = TRUE + ) + ) + }) + + test_that("with only stroke", { + res <- + create_shape_style( + elementIds = list("shape-1"), + stroke_color = "red", + stroke_width = 2, + stroke_opacity = 45 + ) + + expect_type(res, "list") + expect_length(res, 2) + expect_named(res, c("elementIds", "style")) + + expect_equal(res$elementIds, list("shape-1")) + + style <- res$style + expect_type(style, "list") + expect_length(style, 1) + expect_named(style, c("stroke")) + expect_equal(style$stroke, list( + color = "red", + width = 2, + opacity = 45 + )) + }) + + test_that("with only fill", { + res <- create_shape_style(elementIds = list("shape-1"), fill_color = "green", fill_opacity = 50) + + expect_type(res, "list") + expect_length(res, 2) + expect_named(res, c("elementIds", "style")) + + expect_equal(res$elementIds, list("shape-1")) + + style <- res$style + expect_type(style, "list") + expect_length(style, 1) + expect_named(style, c("fill")) + expect_equal(style$fill, list(color = "green", opacity = 50)) + }) + + test_that("with fill color with gradient", { + gradient <- create_gradient_fill("left-to-right", "red", "blue") + + res <- create_shape_style(elementIds = list("shape-1"), fill_color = gradient) + + expect_type(res, "list") + expect_length(res, 2) + expect_named(res, c("elementIds", "style")) + + expect_equal(res$elementIds, list("shape-1")) + + style <- res$style + expect_type(style, "list") + expect_length(style, 1) + expect_named(style, c("fill")) + expect_equal( + style$fill$color, + list( + direction = "left-to-right", + startColor = "red", + endColor = "blue" + ) + ) + }) + + test_that("with fill color with 'swimlane'", { + res <- create_shape_style(elementIds = list("shape-1"), fill_color = "swimlane") + + expect_type(res, "list") + expect_length(res, 2) + expect_named(res, c("elementIds", "style")) + + expect_equal(res$elementIds, list("shape-1")) + expect_equal(res$style$fill$color, "swimlane") + }) + + test_that("with font color with 'inherit'", { + res <- create_shape_style(elementIds = list("shape-1"), font_color = "inherit") + + expect_type(res, "list") + expect_length(res, 2) + expect_named(res, c("elementIds", "style")) + + expect_equal(res$elementIds, list("shape-1")) + expect_equal(res$style$font$color, "inherit") + }) + + test_that("with stroke color with 'default'", { + res <- create_shape_style(elementIds = list("shape-1"), stroke_color = "default") + + expect_type(res, "list") + expect_length(res, 2) + expect_named(res, c("elementIds", "style")) + + expect_equal(res$elementIds, list("shape-1")) + expect_equal(res$style$stroke$color, "default") + }) + + test_that("with stroke width with 'default'", { + res <- create_shape_style(elementIds = list("shape-1"), stroke_width = "default") + + expect_type(res, "list") + expect_length(res, 2) + expect_named(res, c("elementIds", "style")) + + expect_equal(res$elementIds, list("shape-1")) + expect_equal(res$style$stroke$width, "default") + }) }) describe("build_bpmnContent works", { - test_that("with xml_doc and no overlays", { + test_that("with xml_doc, no overlays and no bpmnElementStyles", { res <- build_bpmnContent( - xml2::read_xml( + bpmnXML = xml2::read_xml( system.file("examples/Email_Voting.bpmn", package = "bpmnVisualizationR") ), enableDefaultOverlayStyle = TRUE @@ -171,9 +572,9 @@ describe("build_bpmnContent works", { expect_named(res, c("bpmnContent", "enableDefaultOverlayStyle")) }) - test_that("with xml_doc and overlays", { + test_that("with xml_doc, overlays and no bpmnElementStyles", { res <- build_bpmnContent( - xml2::read_xml( + bpmnXML = xml2::read_xml( system.file("examples/Email_Voting.bpmn", package = "bpmnVisualizationR") ), enableDefaultOverlayStyle = FALSE, @@ -186,9 +587,9 @@ describe("build_bpmnContent works", { expect_equal(res$overlays, list("this")) }) - test_that("with xml_doc and overlays is list", { + test_that("with xml_doc, overlays is list and no bpmnElementStyles", { res <- build_bpmnContent( - xml2::read_xml( + bpmnXML = xml2::read_xml( system.file("examples/Email_Voting.bpmn", package = "bpmnVisualizationR") ), enableDefaultOverlayStyle = FALSE, @@ -202,9 +603,42 @@ describe("build_bpmnContent works", { expect_named(res, c("bpmnContent", "enableDefaultOverlayStyle", "overlays")) }) - test_that("with character and no overlays", { + test_that("with xml_doc, no overlays and bpmnElementStyles is list", { + res <- build_bpmnContent( + bpmnXML = xml2::read_xml( + system.file("examples/Email_Voting.bpmn", package = "bpmnVisualizationR") + ), + enableDefaultOverlayStyle = TRUE, + bpmnElementStyles = list(list(elementIds=list(1, 2), style = "style")) + ) + + expect_true(length(res) == 3) + expect_named(res, c("bpmnContent", "enableDefaultOverlayStyle", "bpmnElementStyles")) + + expect_equal(res$bpmnElementStyles, list(list(elementIds=list(1, 2), style = "style"))) + }) + + test_that("with xml_doc, no overlays and bpmnElementStyles is bad list", { + expect_error(build_bpmnContent( + bpmnXML = xml2::read_xml( + system.file("examples/Email_Voting.bpmn", package = "bpmnVisualizationR") + ), + bpmnElementStyles = list("this") + )) + }) + + test_that("with xml_doc, no overlays and bpmnElementStyles is not list", { + expect_error(build_bpmnContent( + bpmnXML = xml2::read_xml( + system.file("examples/Email_Voting.bpmn", package = "bpmnVisualizationR") + ), + bpmnElementStyles = "this" + )) + }) + + test_that("with character, no overlays and no bpmnElementStyles", { res <- build_bpmnContent( - paste( + bpmnXML = paste( readLines( system.file("examples/Email_Voting.bpmn", package = "bpmnVisualizationR") ), @@ -217,9 +651,9 @@ describe("build_bpmnContent works", { expect_named(res, c("bpmnContent", "enableDefaultOverlayStyle")) }) - test_that("with character and no overlays", { + test_that("with character, no overlays and no bpmnElementStyles", { res <- build_bpmnContent( - system.file("examples/Email_Voting.bpmn", package = "bpmnVisualizationR"), + bpmnXML = system.file("examples/Email_Voting.bpmn", package = "bpmnVisualizationR"), enableDefaultOverlayStyle = TRUE ) From 1e1e2132f017b7bf40bb40be4d970d0ea7655035 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Souchet=20C=C3=A9line?= Date: Tue, 12 Sep 2023 16:46:50 +0200 Subject: [PATCH 2/9] add bpmnElementStyles parameter to display function --- R/bpmnVisualizationR.R | 51 +++++++++++++++++++++++++- inst/htmlwidgets/bpmnVisualizationR.js | 12 ++++-- 2 files changed, 58 insertions(+), 5 deletions(-) diff --git a/R/bpmnVisualizationR.R b/R/bpmnVisualizationR.R index 12e86fb..f0500af 100644 --- a/R/bpmnVisualizationR.R +++ b/R/bpmnVisualizationR.R @@ -22,6 +22,8 @@ #' Use the [`create_overlay`] function to create an overlay object with content and a relative position. #' @param enableDefaultOverlayStyle If no style is set on an overlay, and this parameter is set to `TRUE`, the default style will be applied to the overlay. #' By default, `enableDefaultOverlayStyle` is set to `TRUE`. +#' @param bpmnElementStyles a list of existing elements with their style to apply. +#' Use the [`create_shape_style`] or [`create_edge_style`] functions to create the style of 'BPMN' elements. #' @param width A fixed width for the widget (in CSS units). #' The default value is `NULL`, which results in intelligent automatic sizing based on the widget's container. #' @param height A fixed height for the widget (in CSS units). @@ -98,7 +100,50 @@ #' height='auto' #' ) #' -#' @seealso [`create_overlay`] to create an overlay +#' # Example 5: Display the BPMN diagram featuring bpmnElementStyles +#' bpmnElementStyles <- list( +#' bpmnVisualizationR::create_shape_style( +#' elementIds = list("call_activity_1_1"), +#' stroke_color = 'RoyalBlue', +#' font_color = 'DarkOrange', +#' font_family = 'Arial', +#' font_size = 12, +#' font_bold = TRUE, +#' font_italic = TRUE, +#' font_strike_through = TRUE, +#' font_underline = TRUE, +#' opacity = 75, +#' fill_color = 'Yellow', +#' fill_opacity = 50 +#' ), +#' bpmnVisualizationR::create_edge_style( +#' elementIds = list("sequence_flow_1_4"), +#' stroke_color = 'DeepPink', +#' stroke_width = 3, +#' stroke_opacity = 70, +#' font_color = 'ForestGreen', +#' font_family = 'Courier New', +#' font_size = 14, +#' font_bold = TRUE, +#' font_italic = TRUE, +#' font_strike_through = FALSE, +#' font_underline = FALSE, +#' font_opacity = 80, +#' opacity = 80 +#' ) +#' ) +#' +#' bpmnVisualizationR::display( +#' bpmn_file, +#' bpmnElementStyles = bpmnElementStyles, +#' width='auto', +#' height='auto' +#' ) +#' +#' @seealso +#' * [`create_overlay`] to create an overlay +#' * [`create_shape_style`] to create the structure style for the shape +#' * [`create_edge_style`] to create the structure style for the edge #' #' @import htmlwidgets #' @import xml2 @@ -108,6 +153,7 @@ display <- function( bpmnXML, overlays = NULL, enableDefaultOverlayStyle = TRUE, + bpmnElementStyles = NULL, width = NULL, height = NULL, elementId = NULL @@ -115,7 +161,8 @@ display <- function( x <- build_bpmnContent( bpmnXML, overlays = overlays, - enableDefaultOverlayStyle = enableDefaultOverlayStyle + enableDefaultOverlayStyle = enableDefaultOverlayStyle, + bpmnElementStyles = bpmnElementStyles ) # create widget htmlwidgets::createWidget( diff --git a/inst/htmlwidgets/bpmnVisualizationR.js b/inst/htmlwidgets/bpmnVisualizationR.js index ff0d1e3..0ddf3ae 100644 --- a/inst/htmlwidgets/bpmnVisualizationR.js +++ b/inst/htmlwidgets/bpmnVisualizationR.js @@ -50,19 +50,25 @@ HTMLWidgets.widget({ } }; } - + function buildDefaultOverlayPosition(isShape) { return isShape ? 'top-center' : 'middle'; } return { - renderValue: function({bpmnContent, overlays, enableDefaultOverlayStyle}) { + renderValue: function({bpmnContent, overlays, enableDefaultOverlayStyle, bpmnElementStyles}) { bpmnVisualization.load(bpmnContent, { fit: {type: bpmnvisu.FitType.Center, margin: 30} }); + if(bpmnElementStyles) { + for(const { elementIds, style } of bpmnElementStyles) { + bpmnVisualization.bpmnElementsRegistry.updateStyle(elementIds, style); + } + } + // Add overlays overlays?.map(({elementId, ...rest}) => { const overlayConfig = {...rest}; - + if(enableDefaultOverlayStyle && !(overlayConfig.style && overlayConfig.position)) { const elementsByIds = bpmnVisualization.bpmnElementsRegistry.getElementsByIds(elementId); if (elementsByIds.length) { From 344aa597d742b4f32e72c1392396889540847b3c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Souchet=20C=C3=A9line?= Date: Tue, 12 Sep 2023 16:47:01 +0200 Subject: [PATCH 3/9] genarate doc --- NAMESPACE | 3 + man/create_edge_style.Rd | 102 ++++++++++++++++++++++++++++++++ man/create_element_style.Rd | 93 ++++++++++++++++++++++++++++++ man/create_gradient_fill.Rd | 22 +++++++ man/create_shape_style.Rd | 112 ++++++++++++++++++++++++++++++++++++ man/display.Rd | 50 +++++++++++++++- 6 files changed, 381 insertions(+), 1 deletion(-) create mode 100644 man/create_edge_style.Rd create mode 100644 man/create_element_style.Rd create mode 100644 man/create_gradient_fill.Rd create mode 100644 man/create_shape_style.Rd diff --git a/NAMESPACE b/NAMESPACE index 1a2ffa4..292c6b6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,8 +1,11 @@ # Generated by roxygen2: do not edit by hand export(bpmnVisualizationROutput) +export(create_edge_style) +export(create_gradient_fill) export(create_overlay) export(create_overlay_style) +export(create_shape_style) export(display) export(overlay_edge_position) export(overlay_shape_position) diff --git a/man/create_edge_style.Rd b/man/create_edge_style.Rd new file mode 100644 index 0000000..1f21d95 --- /dev/null +++ b/man/create_edge_style.Rd @@ -0,0 +1,102 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/funs.R +\name{create_edge_style} +\alias{create_edge_style} +\title{Create the style for BPMN edge} +\usage{ +create_edge_style( + elementIds, + stroke_color = NULL, + stroke_width = NULL, + stroke_opacity = NULL, + font_color = NULL, + font_family = NULL, + font_size = NULL, + font_bold = NULL, + font_italic = NULL, + font_strike_through = NULL, + font_underline = NULL, + font_opacity = NULL, + opacity = NULL +) +} +\arguments{ +\item{elementIds}{The IDs of the BPMN elements to style.} + +\item{stroke_color}{The stroke color for the element. +It can be any HTML color name or HEX code, or special keywords.} + +\item{stroke_width}{The stroke width for the element, in pixels (1 to 50). +\itemize{ +\item If the set value is less than 1, the used value is 1. +\item If the set value is greater than 50, the used value is 50. +\item To hide the stroke, set the \code{stroke_color} property to \code{none}. +}} + +\item{stroke_opacity}{The stroke opacity for the element, ranging from 0 to 100.} + +\item{font_color}{The font color for the element. +It can be any HTML color name or HEX code, or special keywords.} + +\item{font_family}{The font family for the element.} + +\item{font_size}{The font size for the element, in pixels.} + +\item{font_bold}{Should the font be bold? (default: \code{FALSE})} + +\item{font_italic}{Should the font be italic? (default: \code{FALSE})} + +\item{font_strike_through}{Should the font have a strike-through style? (default: \code{FALSE})} + +\item{font_underline}{Should the font be underlined? (default: \code{FALSE})} + +\item{font_opacity}{The font opacity for the element, ranging from 0 to 100.} + +\item{opacity}{The opacity for the element, ranging from 0 to 100.} +} +\value{ +A list representing the style for the BPMN edge. +} +\description{ +Use this function to create the correct style structure for the edge. +} +\section{Special keywords}{ +\describe{ +\item{\code{default}}{ +\itemize{ +\item This keyword allows you to reset a style property of the BPMN element to its initial value. +\item When applied to color properties, it bypasses the color specified in the 'BPMN' source if 'BPMN in Color' support is enabled. Instead, it uses the color defined in the default style of the 'BPMN' element.. +} +} +\item{\code{inherit}}{Applies the value from the immediate parent element.} +\item{\code{none}}{No color (used to hide strokes). Not available for \code{font_color}.} +\item{\code{swimlane}}{Applies the value from the nearest parent element with type \code{ShapeBpmnElementKind.LANE} or \code{ShapeBpmnElementKind.POOL}.} +} +} + +\section{Note}{ +\subsection{Opacity properties}{ +\itemize{ +\item If the set value is less than 0, the used value is 0. +\item If the set value is greater than 100, the used value is 100. +} +} + +\subsection{⚠️⚠️⚠️ \code{stroke_width} property ⚠️⚠️⚠️}{ + +Changing the stroke width of Activities may be misleading, as the default stroke widths have a meaning according to the 'BPMN' Specification.\cr +For example, updating the stroke width of a task using the same value as the default stroke width of a Call Activity can be confusing.\cr +In this case, you should also change another property, such as the stroke color, to allow the user to differentiate between them. +} +} + +\examples{ +# Create a style with a blue stroke and a bold, red font. +edge_style <- create_edge_style( + elementIds = list('id_1', 'id_2'), + stroke_color = "blue", + stroke_width = 2, + font_color = "red", + font_bold = TRUE +) +} diff --git a/man/create_element_style.Rd b/man/create_element_style.Rd new file mode 100644 index 0000000..f2aa08a --- /dev/null +++ b/man/create_element_style.Rd @@ -0,0 +1,93 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/funs.R +\name{create_element_style} +\alias{create_element_style} +\title{Create the style for BPMN element} +\usage{ +create_element_style( + elementIds, + stroke_color = NULL, + stroke_width = NULL, + stroke_opacity = NULL, + font_color = NULL, + font_family = NULL, + font_size = NULL, + font_bold = NULL, + font_italic = NULL, + font_strike_through = NULL, + font_underline = NULL, + font_opacity = NULL, + opacity = NULL +) +} +\arguments{ +\item{elementIds}{The IDs of the BPMN elements to style.} + +\item{stroke_color}{The stroke color for the element. +It can be any HTML color name or HEX code, or special keywords.} + +\item{stroke_width}{The stroke width for the element, in pixels (1 to 50). +\itemize{ +\item If the set value is less than 1, the used value is 1. +\item If the set value is greater than 50, the used value is 50. +\item To hide the stroke, set the \code{stroke_color} property to \code{none}. +}} + +\item{stroke_opacity}{The stroke opacity for the element, ranging from 0 to 100.} + +\item{font_color}{The font color for the element. +It can be any HTML color name or HEX code, or special keywords.} + +\item{font_family}{The font family for the element.} + +\item{font_size}{The font size for the element, in pixels.} + +\item{font_bold}{Should the font be bold? (default: \code{FALSE})} + +\item{font_italic}{Should the font be italic? (default: \code{FALSE})} + +\item{font_strike_through}{Should the font have a strike-through style? (default: \code{FALSE})} + +\item{font_underline}{Should the font be underlined? (default: \code{FALSE})} + +\item{font_opacity}{The font opacity for the element, ranging from 0 to 100.} + +\item{opacity}{The opacity for the element, ranging from 0 to 100.} +} +\value{ +A list representing the style for the specified BPMN elements. +} +\description{ +Internal function to create the correct style structure for the 'BPMN' element. +} +\section{Special keywords}{ +\describe{ +\item{\code{default}}{ +\itemize{ +\item This keyword allows you to reset a style property of the BPMN element to its initial value. +\item When applied to color properties, it bypasses the color specified in the 'BPMN' source if 'BPMN in Color' support is enabled. Instead, it uses the color defined in the default style of the 'BPMN' element.. +} +} +\item{\code{inherit}}{Applies the value from the immediate parent element.} +\item{\code{none}}{No color (used to hide strokes). Not available for \code{font_color}.} +\item{\code{swimlane}}{Applies the value from the nearest parent element with type \code{ShapeBpmnElementKind.LANE} or \code{ShapeBpmnElementKind.POOL}.} +} +} + +\section{Note}{ +\subsection{Opacity properties}{ +\itemize{ +\item If the set value is less than 0, the used value is 0. +\item If the set value is greater than 100, the used value is 100. +} +} + +\subsection{⚠️⚠️⚠️ \code{stroke_width} property ⚠️⚠️⚠️}{ + +Changing the stroke width of Activities may be misleading, as the default stroke widths have a meaning according to the 'BPMN' Specification.\cr +For example, updating the stroke width of a task using the same value as the default stroke width of a Call Activity can be confusing.\cr +In this case, you should also change another property, such as the stroke color, to allow the user to differentiate between them. +} +} + +\keyword{internal} diff --git a/man/create_gradient_fill.Rd b/man/create_gradient_fill.Rd new file mode 100644 index 0000000..ce98dcd --- /dev/null +++ b/man/create_gradient_fill.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/funs.R +\name{create_gradient_fill} +\alias{create_gradient_fill} +\title{Create a gradient fill style for an element} +\usage{ +create_gradient_fill(direction, start_color, end_color) +} +\arguments{ +\item{direction}{The direction of the gradient (e.g., \code{left-to-right}, \code{right-to-left}, \code{bottom-to-top}, \code{top-to-bottom}). +Taking the example of bottom-to-top, this means that the start color is at the bottom of the paint pattern and the end color is at the top, with a gradient between them.} + +\item{start_color}{The starting color of the gradient. It can be any HTML color name or HEX code, as well as special keywords such as \code{inherit}, \code{none}, \code{swimlane}.} + +\item{end_color}{The ending color of the gradient. It can be any HTML color name or HEX code, as well as special keywords such as \code{inherit}, \code{none}, \code{swimlane}.} +} +\value{ +A gradient fill style object. +} +\description{ +Create a gradient fill style for an element. +} diff --git a/man/create_shape_style.Rd b/man/create_shape_style.Rd new file mode 100644 index 0000000..1a75299 --- /dev/null +++ b/man/create_shape_style.Rd @@ -0,0 +1,112 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/funs.R +\name{create_shape_style} +\alias{create_shape_style} +\title{Create the style for BPMN shape} +\usage{ +create_shape_style( + elementIds, + stroke_color = NULL, + stroke_width = NULL, + stroke_opacity = NULL, + font_color = NULL, + font_family = NULL, + font_size = NULL, + font_bold = NULL, + font_italic = NULL, + font_strike_through = NULL, + font_underline = NULL, + font_opacity = NULL, + opacity = NULL, + fill_color = NULL, + fill_opacity = NULL +) +} +\arguments{ +\item{elementIds}{The IDs of the BPMN elements to style.} + +\item{stroke_color}{The stroke color for the element. +It can be any HTML color name or HEX code, or special keywords.} + +\item{stroke_width}{The stroke width for the element, in pixels (1 to 50). +\itemize{ +\item If the set value is less than 1, the used value is 1. +\item If the set value is greater than 50, the used value is 50. +\item To hide the stroke, set the \code{stroke_color} property to \code{none}. +}} + +\item{stroke_opacity}{The stroke opacity for the element, ranging from 0 to 100.} + +\item{font_color}{The font color for the element. +It can be any HTML color name or HEX code, or special keywords.} + +\item{font_family}{The font family for the element.} + +\item{font_size}{The font size for the element, in pixels.} + +\item{font_bold}{Should the font be bold? (default: \code{FALSE})} + +\item{font_italic}{Should the font be italic? (default: \code{FALSE})} + +\item{font_strike_through}{Should the font have a strike-through style? (default: \code{FALSE})} + +\item{font_underline}{Should the font be underlined? (default: \code{FALSE})} + +\item{font_opacity}{The font opacity for the element, ranging from 0 to 100.} + +\item{opacity}{The opacity for the element, ranging from 0 to 100.} + +\item{fill_color}{The fill color for the shape +It can be any HTML color name or HEX code, special keywords, or a gradient create with \code{\link{create_gradient_fill}}.} + +\item{fill_opacity}{The fill opacity for the shape, ranging from 0 to 100.} +} +\value{ +A list representing the style for the BPMN shape. +} +\description{ +Use this function to create the correct style structure for the shape. +} +\section{Special keywords}{ +\describe{ +\item{\code{default}}{ +\itemize{ +\item This keyword allows you to reset a style property of the BPMN element to its initial value. +\item When applied to color properties, it bypasses the color specified in the 'BPMN' source if 'BPMN in Color' support is enabled. Instead, it uses the color defined in the default style of the 'BPMN' element.. +} +} +\item{\code{inherit}}{Applies the value from the immediate parent element.} +\item{\code{none}}{No color (used to hide strokes). Not available for \code{font_color}.} +\item{\code{swimlane}}{Applies the value from the nearest parent element with type \code{ShapeBpmnElementKind.LANE} or \code{ShapeBpmnElementKind.POOL}.} +} +} + +\section{Note}{ +\subsection{Opacity properties}{ +\itemize{ +\item If the set value is less than 0, the used value is 0. +\item If the set value is greater than 100, the used value is 100. +} +} + +\subsection{⚠️⚠️⚠️ \code{stroke_width} property ⚠️⚠️⚠️}{ + +Changing the stroke width of Activities may be misleading, as the default stroke widths have a meaning according to the 'BPMN' Specification.\cr +For example, updating the stroke width of a task using the same value as the default stroke width of a Call Activity can be confusing.\cr +In this case, you should also change another property, such as the stroke color, to allow the user to differentiate between them. +} +} + +\examples{ +# Create a style with a blue stroke, red font, and green fill color. +shape_style <- create_shape_style( + elementIds = list('id_1', 'id_2'), + stroke_color = "blue", + stroke_width = 2, + font_color = "red", + fill_color = "green" +) +} +\seealso{ +\code{\link{create_gradient_fill}} +} diff --git a/man/display.Rd b/man/display.Rd index 17a2f01..6fbd18e 100644 --- a/man/display.Rd +++ b/man/display.Rd @@ -8,6 +8,7 @@ display( bpmnXML, overlays = NULL, enableDefaultOverlayStyle = TRUE, + bpmnElementStyles = NULL, width = NULL, height = NULL, elementId = NULL @@ -22,6 +23,9 @@ Use the \code{\link{create_overlay}} function to create an overlay object with c \item{enableDefaultOverlayStyle}{If no style is set on an overlay, and this parameter is set to \code{TRUE}, the default style will be applied to the overlay. By default, \code{enableDefaultOverlayStyle} is set to \code{TRUE}.} +\item{bpmnElementStyles}{a list of existing elements with their style to apply. +Use the \code{\link{create_shape_style}} or \code{\link{create_edge_style}} functions to create the style of 'BPMN' elements.} + \item{width}{A fixed width for the widget (in CSS units). The default value is \code{NULL}, which results in intelligent automatic sizing based on the widget's container.} @@ -104,7 +108,51 @@ bpmnVisualizationR::display( height='auto' ) +# Example 5: Display the BPMN diagram featuring bpmnElementStyles +bpmnElementStyles <- list( + bpmnVisualizationR::create_shape_style( + elementIds = list("call_activity_1_1"), + stroke_color = 'RoyalBlue', + font_color = 'DarkOrange', + font_family = 'Arial', + font_size = 12, + font_bold = TRUE, + font_italic = TRUE, + font_strike_through = TRUE, + font_underline = TRUE, + opacity = 75, + fill_color = 'Yellow', + fill_opacity = 50 + ), + bpmnVisualizationR::create_edge_style( + elementIds = list("sequence_flow_1_4"), + stroke_color = 'DeepPink', + stroke_width = 3, + stroke_opacity = 70, + font_color = 'ForestGreen', + font_family = 'Courier New', + font_size = 14, + font_bold = TRUE, + font_italic = TRUE, + font_strike_through = FALSE, + font_underline = FALSE, + font_opacity = 80, + opacity = 80 + ) +) + +bpmnVisualizationR::display( + bpmn_file, + bpmnElementStyles = bpmnElementStyles, + width='auto', + height='auto' +) + } \seealso{ -\code{\link{create_overlay}} to create an overlay +\itemize{ +\item \code{\link{create_overlay}} to create an overlay +\item \code{\link{create_shape_style}} to create the structure style for the shape +\item \code{\link{create_edge_style}} to create the structure style for the edge +} } From 43bf0f8d18f2f2cc25d83a18f24d6ae2620bcf99 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Souchet=20C=C3=A9line?= Date: Tue, 12 Sep 2023 16:59:38 +0200 Subject: [PATCH 4/9] Update doc: create_overlay_style --- R/funs.R | 2 +- man/create_overlay_style.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/funs.R b/R/funs.R index c7d54f2..08672a8 100644 --- a/R/funs.R +++ b/R/funs.R @@ -140,7 +140,7 @@ create_overlay <- function(elementId, label, style = NULL, position = NULL) { #' Use this function to create the correct style structure for an overlay. #' #' @param font_color The font color of the overlay. It can be any HTML color name or HEX code. -#' @param font_size The font size of the overlay. Specify a number in px. +#' @param font_size The font size of the overlay. Specify a number in pixels. #' @param fill_color The color of the background of the overlay. It can be any HTML color name or HEX code. #' @param stroke_color The color of the stroke of the overlay. It can be any HTML color name or HEX code.\cr #' If you don't want to display a stroke, you can set the color to: diff --git a/man/create_overlay_style.Rd b/man/create_overlay_style.Rd index 9404ec4..0a67e26 100644 --- a/man/create_overlay_style.Rd +++ b/man/create_overlay_style.Rd @@ -14,7 +14,7 @@ create_overlay_style( \arguments{ \item{font_color}{The font color of the overlay. It can be any HTML color name or HEX code.} -\item{font_size}{The font size of the overlay. Specify a number in px.} +\item{font_size}{The font size of the overlay. Specify a number in pixels.} \item{fill_color}{The color of the background of the overlay. It can be any HTML color name or HEX code.} From 1b0ece4393978b0e8a1623a4cfa31a91d4da13c3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Souchet=20C=C3=A9line?= Date: Tue, 12 Sep 2023 17:16:57 +0200 Subject: [PATCH 5/9] =?UTF-8?q?Fix:=20*=20checking=20PDF=20version=20of=20?= =?UTF-8?q?manual=20...=20WARNING=20Warning:=20LaTeX=20errors=20when=20cre?= =?UTF-8?q?ating=20PDF=20version.=20This=20typically=20indicates=20Rd=20pr?= =?UTF-8?q?oblems.=20LaTeX=20errors=20found:=20!=20LaTeX=20Error:=20Unicod?= =?UTF-8?q?e=20character=20=E2=9A=A0=20(U+26A0)=20=20=20=20=20=20=20=20=20?= =?UTF-8?q?=20=20=20=20=20=20=20not=20set=20up=20for=20use=20with=20LaTeX.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- R/funs.R | 2 +- man/create_edge_style.Rd | 2 +- man/create_element_style.Rd | 2 +- man/create_shape_style.Rd | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/funs.R b/R/funs.R index 08672a8..33e9c12 100644 --- a/R/funs.R +++ b/R/funs.R @@ -208,7 +208,7 @@ create_overlay_style <- function(font_color = NULL, #' * If the set value is less than 0, the used value is 0. #' * If the set value is greater than 100, the used value is 100. #' -#' ## ⚠️⚠️⚠️ `stroke_width` property ⚠️⚠️⚠️ +#' ## Warning: `stroke_width` property #' Changing the stroke width of Activities may be misleading, as the default stroke widths have a meaning according to the 'BPMN' Specification.\cr #' For example, updating the stroke width of a task using the same value as the default stroke width of a Call Activity can be confusing.\cr #' In this case, you should also change another property, such as the stroke color, to allow the user to differentiate between them. diff --git a/man/create_edge_style.Rd b/man/create_edge_style.Rd index 1f21d95..678f802 100644 --- a/man/create_edge_style.Rd +++ b/man/create_edge_style.Rd @@ -82,7 +82,7 @@ Use this function to create the correct style structure for the edge. } } -\subsection{⚠️⚠️⚠️ \code{stroke_width} property ⚠️⚠️⚠️}{ +\subsection{Warning: \code{stroke_width} property}{ Changing the stroke width of Activities may be misleading, as the default stroke widths have a meaning according to the 'BPMN' Specification.\cr For example, updating the stroke width of a task using the same value as the default stroke width of a Call Activity can be confusing.\cr diff --git a/man/create_element_style.Rd b/man/create_element_style.Rd index f2aa08a..beaac63 100644 --- a/man/create_element_style.Rd +++ b/man/create_element_style.Rd @@ -82,7 +82,7 @@ Internal function to create the correct style structure for the 'BPMN' element. } } -\subsection{⚠️⚠️⚠️ \code{stroke_width} property ⚠️⚠️⚠️}{ +\subsection{Warning: \code{stroke_width} property}{ Changing the stroke width of Activities may be misleading, as the default stroke widths have a meaning according to the 'BPMN' Specification.\cr For example, updating the stroke width of a task using the same value as the default stroke width of a Call Activity can be confusing.\cr diff --git a/man/create_shape_style.Rd b/man/create_shape_style.Rd index 1a75299..d880185 100644 --- a/man/create_shape_style.Rd +++ b/man/create_shape_style.Rd @@ -89,7 +89,7 @@ Use this function to create the correct style structure for the shape. } } -\subsection{⚠️⚠️⚠️ \code{stroke_width} property ⚠️⚠️⚠️}{ +\subsection{Warning: \code{stroke_width} property}{ Changing the stroke width of Activities may be misleading, as the default stroke widths have a meaning according to the 'BPMN' Specification.\cr For example, updating the stroke width of a task using the same value as the default stroke width of a Call Activity can be confusing.\cr From be77a8dc61ae0152401d90d82a6043907e2af925 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Souchet=20C=C3=A9line?= Date: Tue, 12 Sep 2023 17:26:38 +0200 Subject: [PATCH 6/9] update comment doc --- R/bpmnVisualizationR.R | 2 +- man/display.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/bpmnVisualizationR.R b/R/bpmnVisualizationR.R index f0500af..ff4cdc0 100644 --- a/R/bpmnVisualizationR.R +++ b/R/bpmnVisualizationR.R @@ -100,7 +100,7 @@ #' height='auto' #' ) #' -#' # Example 5: Display the BPMN diagram featuring bpmnElementStyles +#' # Example 5: Display the BPMN diagram featuring styling for BPMN elements #' bpmnElementStyles <- list( #' bpmnVisualizationR::create_shape_style( #' elementIds = list("call_activity_1_1"), diff --git a/man/display.Rd b/man/display.Rd index 6fbd18e..ab89d4f 100644 --- a/man/display.Rd +++ b/man/display.Rd @@ -108,7 +108,7 @@ bpmnVisualizationR::display( height='auto' ) -# Example 5: Display the BPMN diagram featuring bpmnElementStyles +# Example 5: Display the BPMN diagram featuring styling for BPMN elements bpmnElementStyles <- list( bpmnVisualizationR::create_shape_style( elementIds = list("call_activity_1_1"), From 45ab163097103610ac20c1adf1143a9809f7c757 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Souchet=20C=C3=A9line?= Date: Wed, 13 Sep 2023 14:35:23 +0200 Subject: [PATCH 7/9] Update the readme --- README.md | 92 ++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 91 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index 734aa84..f5b692b 100644 --- a/README.md +++ b/README.md @@ -91,7 +91,7 @@ bpmn_file <- " ...xml_content" ``` 💡 The package provides some [BPMN examples](./inst/examples). \ -They are taken from the [BPMN 2.0 examples non-normative machine readable files](https://www.omg.org/spec/BPMN/2.0). +They are taken from the [BPMN 2.0 examples non-normative machine-readable files](https://www.omg.org/spec/BPMN/2.0). - Email_Voting.bpmn - Nobel_Prize_Process.bpmn - Order_Management.bpmn @@ -133,6 +133,96 @@ overlay <- bpmnVisualizationR::create_overlay("bpmn_element_id_1", "42", style, bpmnVisualizationR::display(bpmn_file, overlays, enableDefaultOverlayStyle=FALSE) ``` +### Style BPMN shapes + +```r +bpmnElementStyles <- list( + bpmnVisualizationR::create_shape_style( + elementIds = list("call_activity_1_1"), + stroke_color = 'RoyalBlue', + font_color = 'DarkOrange', + font_family = 'Arial', + font_size = 12, + font_bold = TRUE, + font_italic = TRUE, + font_strike_through = TRUE, + font_underline = TRUE, + opacity = 75, + fill_color = 'Yellow', + fill_opacity = 50 + ), + bpmnVisualizationR::create_edge_style( + elementIds = list("start_event_1_1"), + stroke_color = 'DeepPink', + stroke_width = 3, + stroke_opacity = 70, + font_color = 'ForestGreen', + font_family = 'Courier New', + font_size = 14, + font_bold = TRUE, + font_italic = TRUE, + font_strike_through = FALSE, + font_underline = FALSE, + font_opacity = 80, + opacity = 80 + ) +) + +bpmnVisualizationR::display( + bpmn_file, + bpmnElementStyles = bpmnElementStyles, + width='auto', + height='auto' +) +``` + +ℹ️ It is possible to apply styles to both BPMN edges and shapes simultaneously by adding them to the shared `bpmnElementStyles` list. + +### Style BPMN edges + +```r +bpmnElementStyles <- list( + bpmnVisualizationR::create_shape_style( + elementIds = list("message_flow_1_1"), + stroke_color = 'RoyalBlue', + font_color = 'DarkOrange', + font_family = 'Arial', + font_size = 12, + font_bold = TRUE, + font_italic = TRUE, + font_strike_through = TRUE, + font_underline = TRUE, + opacity = 75, + fill_color = 'Yellow', + fill_opacity = 50 + ), + bpmnVisualizationR::create_edge_style( + elementIds = list("sequence_flow_1_4"), + stroke_color = 'DeepPink', + stroke_width = 3, + stroke_opacity = 70, + font_color = 'ForestGreen', + font_family = 'Courier New', + font_size = 14, + font_bold = TRUE, + font_italic = TRUE, + font_strike_through = FALSE, + font_underline = FALSE, + font_opacity = 80, + opacity = 80 + ) +) + +bpmnVisualizationR::display( + bpmn_file, + bpmnElementStyles = bpmnElementStyles, + width='auto', + height='auto' +) +``` + +ℹ️ It is possible to apply styles to both BPMN edges and shapes simultaneously by adding them to the shared `bpmnElementStyles` list. + ### Integrate in Shiny Applications The following displays a BPMN diagram provided as an example by the package with an overlay on top of a BPMN element. From e2e6ae4f24440fc763b6cc89b41fe8a39ba9b92a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Souchet=20C=C3=A9line?= <4921914+csouchet@users.noreply.github.com> Date: Wed, 13 Sep 2023 14:36:55 +0200 Subject: [PATCH 8/9] Update R/funs.R --- R/funs.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/funs.R b/R/funs.R index 33e9c12..95839cf 100644 --- a/R/funs.R +++ b/R/funs.R @@ -544,7 +544,6 @@ build_bpmnContent <- function( bpmnContent = bpmnContent, enableDefaultOverlayStyle = enableDefaultOverlayStyle ) - if (length(overlays)) { # In case the user passes a single parameter as overlays (instead of a list), we wrap it into a list so the js can work x$overlays <- if (is.list(overlays[[1]])) { From 3cffa24c82894c2d07a694fd0a8f11d647fb86ae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Souchet=20C=C3=A9line?= Date: Fri, 15 Sep 2023 14:48:33 +0200 Subject: [PATCH 9/9] update svg --- doc/example_email_voting_with_overlays.svg | 204 ++++++++++----------- 1 file changed, 94 insertions(+), 110 deletions(-) diff --git a/doc/example_email_voting_with_overlays.svg b/doc/example_email_voting_with_overlays.svg index bdd78a1..399f113 100644 --- a/doc/example_email_voting_with_overlays.svg +++ b/doc/example_email_voting_with_overlays.svg @@ -7,24 +7,22 @@ - Discussion Cycle + Discussion Cycle - - Announce - Issues for - Discussion + + Announce + Issues for + Discussion - - + + Check Calendar for Conference Call @@ -32,64 +30,50 @@ - - - Moderate - E-mail - Discussion + + + Moderate + E-mail + Discussion - - - - 7 Days - + + + + 7 Days - - + + Conference Call in Discussion Week? - - - - + + + + Wait until Thursday, 9 am - - - - + + + + Delay 6 days from Announcement - - + + Moderate Conference Call Discussion @@ -99,8 +83,7 @@ - + E-mail discussion Deadline @@ -109,8 +92,7 @@ - + @@ -118,8 +100,7 @@ - + Evaluate Discussion Progress @@ -133,8 +114,7 @@ - + The Process will loop if there is no discussion of the @@ -150,25 +130,23 @@ - + - + - + - + - Yes - + Yes - No - + No @@ -182,9 +160,9 @@ - + - + @@ -206,40 +184,33 @@ - + Announce Issues for Vote - + Friday - - - Review - Issue List + + + Review + Issue List - Are - issues ready? - + Are issues ready? - + @@ -248,8 +219,7 @@ - + @@ -257,14 +227,12 @@ - Yes - + Yes - No - + No @@ -291,61 +259,77 @@ 26 + + + 95 + + + + 95 + 69 - + - 69 - - - - 69 + 4 - - - 69 + + + 65 - + 69 - + - 69 + 12 30 + + + 12 + + + + 4 + + + + 4 + + + + 36 + + + + 34 + 39 - + 69 - - - 69 - - - - 69 - - + 69 - - - 69 + + + 4 - + - 69 + 36