Interactive Mandelbrot Zoomer?

Quick&Dirty:

pt = {0, 0};    
full = MandelbrotSetPlot[];
r = 0.2;

Column[{
  Row[{"Zoom: ", Slider[Dynamic[r], {0.01, 1}]}],
  Row[
   {
    LocatorPane[Dynamic[pt], 
     Dynamic[Show[full, 
       Graphics[{EdgeForm[Red], Transparent, 
         Rectangle[pt + r, pt - r]}], ImageSize -> Scaled[.45]]]],
    Dynamic[
     MandelbrotSetPlot[{pt + r, pt - r}.{1, I}, 
      ImageSize -> Scaled[.45]], TrackedSymbols :> {pt, r}]
    }]
  }]

enter image description here


Here is a less quick and dirty version that includes a few more features. To zoom in, you simply click and drag to select a rectangle. Generally, you've got to hit the Generate button to produce the next picture. If you just click on the image, then a picture of the corresponding Julia set will be printed to the notebook, together with the command to generate it.

enter image description here

The code is as follows:

(* Adjust as desired *)
imageSize = 800;
defaultBailout = 100;
bailoutOptions = {50, 100, 200, 500, 1000, 2000, 5000};
defaultResolution = 400;
resolutionOptions = {400, 800, 1600};
defaultColorScheme = "StarryNightColors"
colorSchemes = ColorData["Gradients"];

(* Initial settings *)
pt = {0, 0}; pt1 = {-2, -1.3}; pt2 = {0.6, 1.3};
plotRange = {{-2, 0.6}, {-1.3, 1.3}};

Manipulate[
 DynamicModule[{},
  toShow = Show[{mandelbrotPic, Graphics[{
       Thickness[0.005], Opacity[0.5], Gray,
       Dynamic@Line[{pt1, {pt1[[1]], pt2[[2]]}, pt2,
          {pt2[[1]], pt1[[2]]}, pt1}]
       }]}, FrameTicks -> False, PlotRange -> Dynamic@plotRange];
  Deploy[If[showBounds === True,
    Labeled[
     EventHandler[toShow,
      {"MouseClicked" :> With[{cmd = 
       Hold[JuliaSetPlot[#]]&[{1, I}.MousePosition["Graphics"]]},
       CellPrint[{ExpressionCell[Defer @@ cmd, "Input"], 
                  ExpressionCell[ReleaseHold[cmd], "Output"]}]],
       "MouseDown" :> (pt2 = pt1 = pt = MousePosition["Graphics"]),
       "MouseDragged" :> (pt2 = pt = MousePosition["Graphics"]),
       "MouseUp" :> (pt2 = pt = MousePosition["Graphics"])}],
     {pt1, pt2}],
    EventHandler[toShow,
     {"MouseClicked" :> With[{cmd = 
       Hold[JuliaSetPlot[#]]&[{1, I}.MousePosition["Graphics"]]},
       CellPrint[{ExpressionCell[Defer @@ cmd, "Input"], 
                  ExpressionCell[ReleaseHold[cmd], "Output"]}]],
      "MouseDown" :> (pt2 = pt1 = pt = MousePosition["Graphics"]),
      "MouseDragged" :> (pt2 = pt = MousePosition["Graphics"]),
      "MouseUp" :> (pt2 = pt = MousePosition["Graphics"])}]]]],
 Row[{
   Button["Generate",
    plotRange = {{pt1[[1]], pt2[[1]]}, {pt1[[2]], pt2[[2]]}};
    mandelbrotPic = 
     MandelbrotSetPlot[{pt1[[1]] + pt1[[2]]*I, 
       pt2[[1]] + pt2[[2]]*I},
      MaxIterations -> bail, ImageResolution -> resolution, 
      ImageSize -> imageSize,
      ColorFunction -> colorScheme],
    Method -> "Queued"
    ],
   Button["Reset",
    bail = defaultBailout; 
    resolution = defaultResolution;
    colorScheme = defaultColorScheme;
    plotRange = {{-2, 0.6}, {-1.3, 1.3}};
    mandelbrotPic = MandelbrotSetPlot[{-2.0 - 1.3 I, 0.6 + 1.3 I},
      MaxIterations -> bail, ImageResolution -> resolution, 
      ImageSize -> imageSize,
      ColorFunction -> colorScheme];
    pt = {0, 0}; pt1 = {-2, -1.3}; pt2 = {0.6, 1.3};]}],
 {{bail, defaultBailout, "Bailout"}, bailoutOptions, 
  ControlType -> SetterBar}, 
 {{resolution, defaultResolution, "Resolution"}, resolutionOptions},
 {{colorScheme, defaultColorScheme, "Color Scheme"}, colorSchemes},
 {{showBounds, False, "Show PlotRange"}, {True, False}},
 Initialization :> (
   pt = {0, 0}; pt1 = {-2, -1.3}; pt2 = {0.6, 1.3};
   plotRange = {{-2, 0.6}, {-1.3, 1.3}};
   mandelbrotPic = MandelbrotSetPlot[{-2.0 - 1.3 I, 0.6 + 1.3 I},
     MaxIterations -> bail, ImageResolution -> resolution, 
     ImageSize -> imageSize,
     ColorFunction -> colorScheme];)
 ]

Another way to zoom around is using Manipulate. Here we use a 2D slider to set the position and a regular slider to set the zoom. It scrolls more evenly if you hold down the option key as you move the sliders.

Manipulate[b = -Log[a]; 
 MandelbrotSetPlot[{u[[1]] + u[[2]] I - b - b I, u[[1]] + u[[2]] I + b + b I}, 
  MaxIterations -> 200], {{a, 0.50, "zoom"}, 0, 0.999}, {u, {-2, -1.3}, {0.6, 1.3}}]

enter image description here