working/fire02.R

library(minisvg)

fire_w <- 400
fire_h <- 400
scale  <- fire_h/2
dx     <- 0.5 * scale



#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Define filter with turbulence driving the displacmenet
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
my_filter <- stag$filter(
  id = "displacementFilter",
  x = "-30%", y = "-30%", width="160%", height="160%",
  stag$feTurbulence(
    type          = "turbulence",
    baseFrequency = 0.05,
    numOctaves    = 5,
    seed          = 2,
    stag$animate(attributeName = 'seed', values=1:20, dur="2s", keyTimes = seq(0, 1, length.out = 20), repeatCount = "indefinite"),
    result        = "turbulence"),
  stag$feDisplacementMap(
    in_   = "SourceGraphic",
    in2   = "turbulence",
    scale = scale,
    xChannelSelector = 'R',
    yChannelSelector = 'G',
    # stag$animate(attributeName = 'scale', values="0;200;0", dur="10s", repeatCount = "indefinite"),
    NULL
  )
)

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Red to gold vertical linear gradient
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
fire_grad <- stag$linearGradient(
  id = "myGradient",
  gradientTransform = "rotate(90)",
  stag$stop(offset =  "5%", stop_color = "gold"),
  stag$stop(offset = "95%", stop_color = "red" )
)


fire_rect <- stag$rect(
  x      = dx - dx,
  y      = dx,
  width  = fire_w + 2 * dx,
  height = fire_h,
  fill   = fire_grad,
  filter = my_filter,
  NULL
)


debug_rect <- stag$rect(
  x      = dx,
  y      = dx,
  width  = fire_w,
  height = fire_h - dx,
  stroke = 'black',
  fill_opacity = 0,
  NULL
)


extent_rect <- stag$rect(
  x = 0, y = 0,
  width = "100%",
  height = "100%",
  fill_opacity = 0,
  stroke = 'red'
)

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Apply this displacement filter to a small rect with a red gradient fill
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
doc <- svg_doc(
  width = fire_w + 2*dx, height = fire_h + 2*dx,
  stag$defs(
    my_filter,
    fire_grad
  ),
  fire_rect,
  debug_rect,
  extent_rect
)

doc$show()
coolbutuseless/svgfilter documentation built on Feb. 9, 2020, 12:20 a.m.