Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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: loupe

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}]

loupe first attempt

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.

share|improve this question
    
The pasted code does not scan (backslashes)... –  Yves Klett Jul 24 '12 at 15:05
    
can your loupe be rectangular? –  Vitaliy Kaurov Jul 24 '12 at 15:13
    
@YvesKlett didn't notice those when i pasted. Sorry! –  cormullion Jul 24 '12 at 15:35
    
@VitaliyKaurov rectangular would work but not quite as cool :) –  cormullion Jul 24 '12 at 15:35
2  
Related: demonstrations.wolfram.com/PictureInspector –  rm -rf Jul 24 '12 at 17:31

5 Answers 5

up vote 16 down vote accepted

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}]]

Mathematica graphicsMathematica graphics

share|improve this answer

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}]]

Mathematica graphics

share|improve this answer

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"}]]

Mathematica graphics

share|improve this answer
    
Very nice! +1 Interesting effect when the locator crosses the right edge of the image. –  Eli Lansey Jul 24 '12 at 17:33
1  
@Eli that effect could be removed, but I was lazy ... maybe later. –  Szabolcs Jul 24 '12 at 17:34

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]]
                                   ]
               }
         ]]
     ]

enter image description here

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.

share|improve this answer
    
Looks promising, but the code you have up there doesn't execute by itself. Can you add the extra bits? –  Eli Lansey Jul 24 '12 at 18:04
    
@EliLansey Sorry for being lazy :) The two lines which initialize the imageData have been added. –  Silvia Jul 24 '12 at 18:17
    
Nifty! I find if I zoom in too much I start getting Part::partd: "Part specification 0[[1]] is longer than depth of object." errors. –  Eli Lansey Jul 24 '12 at 18:31
    
@EliLansey It seems like because the MousePosition["Graphics"] returns unexpected value when the mouse is outside of the graphics. I have corrected it just now. –  Silvia Jul 24 '12 at 18:44

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}]]

enter image description here

share|improve this answer
    
This is very nice! +1 –  Eli Lansey Jul 25 '12 at 14:01

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.