Torn edge paper effect for images

A bit lengthy, but here's my attempt. The parameters in torn are the base image img and an array describing which edges should be torn. This array is of the form {{left, right}, {bottom, top}}, where a 0 corresponds to a straight edge and any non-zero value to a torn edge, so {{0, 0}, {1, 0}} would correspond to an image where only the bottom edge is torn.

Options[torn] = {"amplitude" -> .04, "frequency" -> 50, "offset" -> {10, 10}, 
   "opacity" -> .7, "gaussianBlur" -> 4};

torn[img_, {{l_, r_}, {b_, t_}}, OptionsPattern[]] := 
 Module[{ratio, left, right, bottom, top, poly, img1, shadow, amp, dx, offset},
  ratio = #2/#1 & @@ ImageDimensions[img];
  amp = OptionValue["amplitude"] {Min[1/ratio, 1], Min[ratio, 1]};
  dx = 1/(OptionValue["frequency"] {Min[1/ratio, 1], Min[ratio, 1]});
  offset = Abs[{##}] UnitStep[{#1 {-1, 1}, #2 {1, -1}}] & @@ OptionValue["offset"];

  left = If[l == 0, {{0, 1}, {0, 0}}, 
   Table[{RandomReal[{0, 1} amp[[2]]], i}, {i, 1 - amp[[2]], dx[[2]], -dx[[2]]}]];
  right = If[r == 0, {{1, 0}, {1, 1}}, 
   Table[{1 + RandomReal[{-1, 0} amp[[2]]], i}, {i, dx[[2]], 1 - amp[[2]], dx[[2]]}]];
  bottom = If[b == 0, {{0, 0}, {1, 0}}, 
   Table[{i, RandomReal[{0, 1} amp[[1]]]}, {i, dx[[1]], 1 - amp[[1]], dx[[1]]}]];
  top = If[t == 0, {{1, 1}, {0, 1}}, 
   Table[{i, 1 + RandomReal[{-1, 0} amp[[1]]]}, {i, 1 - amp[[1]], dx[[1]], -dx[[1]]}]];
  poly = Join[left, bottom, right, top];

  {img1, shadow} = 
    Image@Graphics[#, ImagePadding -> OptionValue["gaussianBlur"], 
        PlotRangePadding -> None, AspectRatio -> ratio, Background -> None, 
        ImageSize -> ImageDimensions[img] + 2 OptionValue["gaussianBlur"]] & /@
     {{Texture[img], EdgeForm[Black], Polygon[poly, VertexTextureCoordinates -> poly]}, 
      {Polygon[poly]}};
  img1 = ImagePad[img1, offset, {1, 1, 1, 0}];
  shadow = ImagePad[GaussianFilter[shadow, OptionValue["gaussianBlur"]],
      Reverse /@ offset, {1, 1, 1, 0}];
  ImageCompose[img1, {shadow, OptionValue["opacity"]}, Center, Center, {1, 1, -1}]]

There are a number of options which control various image parameters. These are the amplitude of the tears "amplitude", the frequency of the jags, "frequency", the opacity of the shadow, "opacity", and the blurriness of the shadow "gaussianBlur". The offset of the shadow towards the lower right corner is controlled by the option "offset" which is off the form {right, bottom} where right and bottom are in points. Negative values for right and bottom indicate a shadow pointing towards the left and/or top of the image.

Example

img = ExampleData[{"TestImage", "Mandrill"}];
torn[img, {{0, 1}, {1, 0}}, "offset" -> {20, 20}, "gaussianBlur" -> 10]

Mathematica graphics

Edit

Apparently, under certain circumstances Mathematica doesn't render a transparent background for img1 which results in a white region between the image and the shadow. I managed to reproduce this behaviour in version 8.0.1 for OS X with img = Image@Plot[Sin[x], {x, 0, 2 Pi}], but not in 8.0.4. It seems that setting the ImageSize in Graphics is the culprit. To resolve this issue I replaced {img1, shadow} = Image@Graphics... in torn with

{img1, shadow} = 
  Rasterize[
     Graphics[#, ImagePadding -> OptionValue["gaussianBlur"], 
      PlotRangePadding -> None, AspectRatio -> ratio, 
      Background -> None], 
     ImageSize -> ImageDimensions[img] + 2 OptionValue["gaussianBlur"], 
     Background -> None] & /@ 
   {{Texture[img], EdgeForm[Black], Polygon[poly, VertexTextureCoordinates -> poly]}, 
    {Polygon[poly]}};

With the release of M11.2 I finally can add an answer via a built-in function. Let's get the test image:

i = ExampleData[{"TestImage", "Mandrill"}];

Now it becomes as easy as this:

torn = ImageEffect[i, {"TornFrame", Scaled[1/15], {Right, Bottom}, .05}]

enter image description here

Note there is no shadow to dramatize the effect. It can be achieved by various methods, for instance (we are making this mask slightly larger than original image):

shadow = ImageResize[
            Blur[ColorNegate[Binarize[ColorQuantize[torn, 1]]], 20], 
         Scaled[1.02]]

enter image description here

ImageCompose[shadow, torn, {Left, Top}, {Left, Top}]

enter image description here

I still like @Heike answer very much ;-)


Update

Here is a non-hackish way to reproduce the Heike's style of torn edges using ImageEffect of version 10.2 with even higher irregularity (irregular steps):

i = ExampleData[{"TestImage", "Mandrill"}];

t = Module[{step = 10, if, n = 2 Total[ImageDimensions[i]], k = 0}, 
 if = Interpolation[
   Transpose[{Accumulate[Prepend[RandomInteger[{step, 2 step}, n], 0]], 
     RandomReal[1, n + 1]}], InterpolationOrder -> 1]; 
 ImageEffect[i, {"Frame", if[++k] &, 15, {Right, Bottom}}]]

image


Original answer

An extension of the answer by Vitaliy. We can reproduce the Heike's style of torn edges with ImageEffect of version 10.2 by Blocking the Accumulate function:

i = ExampleData[{"TestImage", "Mandrill"}];

t = Block[{Accumulate = RandomReal[1, Length[#]] &}, 
  ImageEffect[i, {"TornFrame", Scaled[1/15], {Right, Bottom}, .08}]]

image

(the hack is found by tracing the evaluation of ImageEffect).

Here is how to add a semi-transparent shadow:

offset = 10;
blur = 5;
shadowTone = .5;
ImageCompose[SetAlphaChannel[ColorNegate@#, #] &@Blur[
   ImageMultiply[ImagePad[AlphaChannel[t], {{offset, blur/2}, {blur/2, offset}}],
    shadowTone], blur],
 ImagePad[t, {{0, offset + blur/2}, {offset + blur/2, 0}}]]

image

Sometimes it is desirable to highlight the boundary:

boundaryLigntness = .4;
ImageCompose[
 SetAlphaChannel[ColorNegate@#, #] &@Blur[
   ImageMultiply[ImagePad[AlphaChannel[t], {{offset, blur/2}, {blur/2, offset}}], 
    shadowTone], blur],
 ImagePad[ImageMultiply[t, 
   ColorNegate@ImageMultiply[MorphologicalPerimeter@AlphaChannel[t], boundaryLigntness]],
  {{0, offset + blur/2}, {offset + blur/2, 0}}]]

enter image description here