Create magnified call-out loupe effect on image

Question

I'm trying to create a Mathematica Manipulate that generates a graphical call-out using a 'loupe'-style or magnifying glass enlarger - a possible solution is shown in this mock-up:

The idea is that you can move the focus (a point on the source image, I suppose), and see the enlarged result inside the 'loupe' or magnifying glass. Variable enlargement would be needed as well. It could be a rectangular loupe, I suppose, but circles would be cool.

This style of image is generally recommended because it allows people to see details and the context of those details.

This is what I've managed to do so far:

m = ImageResize[ExampleData[{"TestImage", "Mandrill"}], 300];
imageData = ImageData[m, DataReversed -> True];
Manipulate[
 Grid[
  {{
    Graphics[{
      Raster[imageData, {{0, 0}, ImageDimensions[m]}], Point[pt]}, 
     ImageSize -> ImageDimensions[m]],
    Graphics[{Raster[imageData, {{0, 0}, ImageDimensions[m]}], 
      Disk[pt, 5]}, ImageSize -> ImageDimensions[m]]
    }}],
 {{pt, {200, 200}}, Locator}]

The dot in the right image follows the left image.

I can't see how to make the circular shape or to make it track the point or to add a magnifying option.

Help or clues appreciated!

Edit

I thought all these answers were great and it's a pity I can't accept them all... :( I noticed that with some of the solutions (@szabolcs, @simon) the image seems to be transformed and looks better/smoother than it really is, whereas the other solutions show the pixels themselves. Both approaches are useful in their own way, depending on whether you're trying to point out the pixel structure or the image content.

Answer 1

A slight modification of Heike's answer, uses the Locator as the lens itself:

With[{m=ImageResize[ExampleData[{"TestImage","Mandrill"}],300],rad=50},
 Manipulate[Image[m,ImageSize->300],{{pt,{200,200}},Locator,
  Appearance->SetAlphaChannel[ImageResize[
   ImageTrim[ImagePad[m,50],{{50,50}+Round[pt]-rad/mag,{50,50}+Round[pt]+rad/mag}],
   {{2 rad},{2 rad}}],Image[DiskMatrix[rad-1,2 rad]]]},{{mag,5,"Magnification"},1,15}]]

Answer 2

Here's my implementation. It is based on textures, so it is very responsive.

loupe[img_?ImageQ, r_:0.2] :=
 With[
  {circle = N@Table[{Cos[x], Sin[x]}, {x, 2 Pi/20, 2 Pi, 2 Pi/20}],
   s = 1/Divide @@ ImageDimensions[img]
   },
  Deploy@DynamicModule[{pos = {0.5, 0.5}, mag = 3},
    Column[{
      Row[{Slider[Dynamic[mag], {1, 10}], Spacer[10], Dynamic[mag]}],
      Graphics[
       {{FaceForm[None], EdgeForm@Directive[Thick, Black], 
         Rectangle[{0, 0}, {1, s}]}, 
        Raster[ImageData[img, DataReversed -> True], {{0, 0}, {1, s}}],

        Thick, Dynamic@Line[{pos, pos + {0, -r}}], 
        Dynamic@Line[{pos, pos + {r, 0}}],

        Dynamic[
          {Texture[img], 
           Polygon[# + pos + {r, -r} & /@ (r circle), 
             VertexTextureCoordinates -> ((#/{1, s}) & /@ (# + pos &) /@ (r circle/mag))]}],

        Dynamic@Circle[pos + {r, -r}, r],

        Dynamic@Locator@Dynamic[pos]},
       ImageSize -> 450, PlotRangePadding -> {{0, 2 r}, {2 r, 0}}
       ]
      }]
    ]
  ]

Just pass any image to the loupe function:

loupe[ExampleData[{"TestImage","Mandrill"}]]

Answer 3

Here's one way. Note that it does rely heavily on functions that are new in version 8, so it won't work on older versions of Mathematica.

With[{m = ImageResize[ExampleData[{"TestImage", "Mandrill"}], 300], rad = 50},
 Manipulate[Grid[{{Image[m, ImageSize -> 300],
     SetAlphaChannel[
      ImageResize[
       ImageTrim[
        ImagePad[m, 50], {{50, 50} + Round[pt] - rad/mag, {50, 50} + Round[pt] + rad/mag}], 
       {{2 rad}, {2 rad}}], 
      Image[DiskMatrix[rad - 1, 2 rad]]]}}],
  {{pt, {200, 200}}, Locator},
  {{mag, 1, "Magnification"}, 1, 15}]]

Answer 4

I'd like to share a code which controls the magnification by mouse:

m = ImageResize[ExampleData[{"TestImage", "Mandrill"}], 300];
imageData = ImageData[m, DataReversed -> True];

Module[{magnifMin = 1, magnifMax = 30, rMin = 5, rMax = 50, arrowpos = {400, 150}},
       DynamicModule[{pt = {100, 100}, r = 10, magnif = 10,
                      ptInt, ptOld, ptNew},
            ptInt = Round[pt];
            EventHandler[

              (* the main part *)
               Grid[{{

                    Graphics[{
                        Raster[imageData, {{0, 0}, ImageDimensions[m]}],
                        EdgeForm[Black], FaceForm[],
                        Dynamic@Circle[pt, r],
                        Black, Thick,
                        Dynamic@Line[{arrowpos, pt + r Normalize[arrowpos - pt]}]
                             },
                       ImageSize -> 300, PlotRangePadding -> None],

                    Overlay[{Graphics[{
                                    Raster[
                                        Dynamic@imageData[[
                                            ptInt[[2]] - r ;; ptInt[[2]] + r,
                                            ptInt[[1]] - r ;; ptInt[[1]] + r]],
                                          {{0, 0}, ImageDimensions[m]}]
                                      }, ImageSize -> Dynamic[2 r magnif]],
                             Graphics[{
                                    Black, Thickness[.06], Circle[{0, 0}, 1],
                                    White, Thickness[1], Circle[{0, 0}, 2]},
                                    PlotRange -> {{-1, 1}, {-1, 1}},
                                    ImageSize -> Dynamic[2 r magnif]]
                            }]
                  }}, Spacings -> 0],
              (* control variables for EventHandler *)
               {
                "MouseDown" :> If[CurrentValue["ModifierKeys"],
                                  ptNew = MousePosition[ ],
                                  pt = Round@MousePosition["Graphics"]
                                 ],

                "MouseDragged" :> If[CurrentValue["ControlKey"],
                                     ptOld = ptNew;
                                     ptNew = MousePosition[ ];
                                     Piecewise[{
                                         {magnif = Min[1.1 magnif, magnifMax],
                                          (ptNew - ptOld)[[2]] < 0},
                                         {magnif = Max[0.9 magnif, magnifMin],
                                          (ptNew - ptOld)[[2]] > 0}
                                        }, None],

                                     If[CurrentValue["ShiftKey"],
                                        ptOld = ptNew;
                                        ptNew = MousePosition[ ];
                                        Piecewise[{
                                            {r = Min[r + 1, rMax],
                                             (ptNew - ptOld)[[1]] > 0},
                                            {r = Max[r - 1, rMin],
                                             (ptNew - ptOld)[[1]] < 0}
                                           }, None],

                                        pt = MousePosition["Graphics"];
                                        pt = {Min[300 - r, Max[r + 1, pt[[1]]]], 
                                              Min[300 - r, Max[r + 1, pt[[2]]]]};
                                        ptInt = Round[pt]]
                                   ]
               }
         ]]
     ]

You can use left-click/drag to select the magnifying region, or while the Ctrl key is pressed, dragging the mouse up/down to adjust magnification, or while the Shift key is pressed, dragging the mouse left/right to adjust the size of the magnifying region.

Wish this a useful supplement for the above answers.

Edit:

Add the circle frame (implemented by Overlay) and the point line.

Answer 5

Here's an in-place magnifier, using ImageTransformation which allows for quite compact code:

With[{m = ImageResize[ExampleData[{"TestImage", "Mandrill"}], 300]}, 
 Manipulate[
  ImageTransformation[m, 
   p + (# - p)/(1 + (mag - 1) UnitStep[radius - Norm[# - p]]) &, DataRange -> Full]
, {mag, 1, 5}, {radius, 20, 100}, {{p, {150, 150}}, Locator}]]