# Is it possible to produce “tilt-shift” effect in Mathematica?

I attempted to produce a kind of miniature faking look from a street scene photo. I tried to shift the perspective lines close to parallel to each other to obtain such effect. However, the result looks ugly. Is there a better way to do it?

This is the original photo.

This is the result from the code below.

im = Import["http://i.stack.imgur.com/AkqJW.jpg"]

pts = {{0, 0}, {0, 1}, {0.25, 0},  {0.25, 1}, {0.5, 0}, {0.5,1}, {1, 0}, {1, 1} };
imgcol = BSplineFunction[ImageData[im ], SplineDegree -> 1];
Manipulate[
Module[{f},
f = BSplineFunction[Partition[pts, 2], SplineDegree -> 1,
Method -> {"Extrapolation" -> "Clamp"}];

ParametricPlot[
f[u, v], {u, 0, 1}, {v, 0, 1},
ColorFunction -> (imgcol[1 - #4, #3] &),
MaxRecursion -> 0,
PlotPoints -> ControlActive[20, 100],
Mesh -> None,
Epilog -> { Gray, Opacity[.7], Line[Partition[pts, 2]]},
ImageSize -> {300, 300},
PlotRange -> {{0, 1}, {0, 1}},
FrameTicks -> None
]
],
{{pts, {{0, 0}, {0, 1}, {0.25, 0},  {0.25, 1}, {0.5, 0},  {0.5, 1},
{1, 0}, {1, 1} }}, {0, 0}, {1, 1}, Locator },
TrackedSymbols :> {pts}
]
-