7
$\begingroup$

Given a 10 by 10 grid like the one below and the axis origin somewhere on the grid, I would like to be able to place the mouse pointer at the axes origin (0,0), then press and hold the mouse button and drag the axes origin to a new location. Once the mouse button is released i would like this new position to be the new axis origin (0,0).

Manipulate[
 Graphics[Point[p], Axes -> True, AxesOrigin -> {0, 0}, 
  PlotRange -> {{-5, 5}, {-5, 5}}, 
  GridLines -> {Range[-5, 5, 1], Range[-5, 5, 1]}], {{p, {0, 0}}, 
  Locator}]

Staring View enter image description here

Ending View

enter image description here

Edit: The code below almost works. See animation. But as you can see that as soon as the origin is moved the distance is scaled further and further away from the current mouse position. I would like it at the same position so i don't loose the locator off the screen or have to search for it. Also once its off... it only gets worse once the mouse is unchecked and rechecked again. this could all be fixed if i could get rid of the scaling somehow.

Manipulate[
 Graphics[Point[p], Axes -> True, AxesOrigin -> {0, 0}, 
  PlotRange -> {{-5 - p[[1]], 5 - p[[1]]}, {-5 - p[[2]], 5 - p[[2]]}},
   GridLines -> {Range[-5, 5, 1], Range[-5, 5, 1]}], {{p, {0, 0}}, 
  Locator}]

enter image description here

$\endgroup$
6
$\begingroup$

I think this is easier to do with a dynamic module than with a manipulate expression. Here is my implementation using DynamicModule. Note that the locator is constrained to snap to the nearest grid point.

With[{span = 10.},
  DynamicModule[{origin, xmin, xmax, ymin, ymax},
    origin = {0, 0};
    {xmin, xmax} = {ymin, ymax} = span {-1., 1.}/2.;
    Dynamic @
      Graphics[
         Locator[
           Dynamic[
             origin, 
             {Automatic, 
              Module[{x, y},
                {x, y} = #;
                xmin -= Round[x]; xmax -= Round[x]; 
                ymin -= Round[y]; ymax -= Round[y]; 
                origin = {0, 0}] &}]],
         Axes -> True,
         AxesOrigin -> {0, 0},
         PlotRange -> {{xmin, xmax}, {ymin, ymax}},
         GridLines -> {Range[xmin, xmax], Range[ymin, ymax]}]]]

Here is the initial view

initial

and the view after the locator has been moved to {2, 1} and released.

moved

$\endgroup$
  • $\begingroup$ very nice! I tried a similar system but didn't know how to trigger the evaluation only on mouse release. By the way, going through the examples of Dynamic in the documentation I found a strange behaviour. Mathematica consistently freezes when reaching the page in the section "Applications" with the example beginning with "Construct a dynamic calculating interface". Do you replicate this or is it just me? $\endgroup$ – glS Dec 27 '15 at 19:35
  • $\begingroup$ @glS I cannot replicate your issue on my machine. I have no problems. I'm running M10.3 on OSX10.11.1. $\endgroup$ – Michael McCain Dec 27 '15 at 19:51
6
$\begingroup$

An illustrative example that demonstrates how the changing coordinate system can be handled.

Manipulate[
 Graphics[{Point[p], Locator[{0, 0}, Appearance -> Large], Red, AbsolutePointSize[5], 
   Point[shift]}, Axes -> True, AxesOrigin -> {0, 0}, 
  PlotRange -> {{-5, 5}, {-5, 5}} - shift - p, 
  GridLines -> {Range[-5, 5, 1], Range[-5, 5, 1]}], {{p, {0, 0}}, 
  Locator, TrackingFunction -> {None, p = #; &, (shift = shift + #; p = {0, 0}); &}},
 {{shift, {0, 0}}, None}]

ScreenGIF1

The coordinate system of MousePosition is static.

Manipulate[
 Graphics[{AbsolutePointSize[5], Point[p], 
   Locator[MousePosition["Graphics", {0, 0}], Appearance -> Large, 
    Enabled -> $ControlActiveSetting], Red, Point[shift]}, 
  Axes -> True, AxesOrigin -> {0, 0}, 
  PlotRange -> {{-5, 5}, {-5, 5}} - shift - p, 
  GridLines -> {Range[-5, 5, 1], Range[-5, 5, 1]}], {{p, {0, 0}}, 
  Locator, TrackingFunction -> {None, 
    p = #; &, (shift = shift + #; p = {0, 0}); &}, 
  Appearance -> None}, {{shift, {0, 0}}, None}]

ScreenGIF2

Using the static MousePosition coordinate system to drag the axis origin.

Manipulate[
 Graphics[{Point[p]}, Axes -> True, AxesOrigin -> {0, 0}, PlotRange -> pr, 
  GridLines -> {Range[-5, 5, 1], Range[-5, 5, 1]}], 
 {{p, {0, 0}}, Locator, 
  TrackingFunction -> (pr = pr - MousePosition["Graphics", {0, 0}]; &)}, 
 {{pr, {{-5, 5}, {-5, 5}}}, None}]

ScreenGIF3

Getting rid of the extra Manipulate variable.

Manipulate[
 Graphics[{Point[p], Locator[{0, 0}]}, Axes -> True, 
  AxesOrigin -> {0, 0}, PlotRange -> {{-5, 5}, {-5, 5}} - p, 
  GridLines -> {Range[-5, 5, 1], Range[-5, 5, 1]}, 
  ImageSize -> Medium], 
 {{p, {0, 0}}, Locator, TrackingFunction -> (p = p + MousePosition["Graphics", {0, 0}]; &), 
  Appearance -> None}]

An alteration using scaled coordinates, a changing MouseAppearance at the position of the Locator, and a limitation of the dragging area to the area of the Graphics object.

Manipulate[
 Graphics[{MouseAppearance[Locator[Scaled[p]], "DragGraphics"], 
   Transparent, AbsolutePointSize[7], MouseAppearance[Point[Scaled[p]], "DragGraphics"]}, 
  Axes -> True, AxesOrigin -> {0, 0}, 
  PlotRange -> {{-5, 5}, {-5, 5}} - 10*(p - 0.5), 
  GridLines -> {Range[-5, 5, 1], Range[-5, 5, 1]}, 
  ImageSize -> Medium], 
 {{p, {0.50, 0.50}}, Locator, 
  TrackingFunction -> (If[MousePosition["GraphicsScaled", {0, 0}] ∈ Rectangle[],
        p = MousePosition["GraphicsScaled", {0, 0}]]; &), 
  Appearance -> None}]
$\endgroup$
  • 2
    $\begingroup$ +1 - The third/last solution is my favorite. (1) To get the grid lines as in the OP, one can set GridLines -> {Range[-10,10], Range[-10, 10]}. (2) A slight glitch or "feature" is that tracking continues outside the Manipulate, which I find undesirable (others may disagree). I suppose the default {0, 0} was intended to take care of it, but it doesn't (V10.3.0, Mac). FWIW, TrackingFunction -> (pr = pr - MapThread[Clip, {MousePosition["Graphics"], pr}]; &) seems to do what I have in mind. [This comment is just to extend your solution for those who would rather have this behavior.] $\endgroup$ – Michael E2 Dec 27 '15 at 19:19
1
$\begingroup$

A little bit late, but so far this is the best way that i've found to dynamically update range and zoom with the mouse. To pane, place cursor on the plot, and while holding the shift key, move the mouse (do not click). To zoom in.out, do the same, but press alt (option in mac) key. In my case, macbook pro, it runs really smoothly.

plot[]:=DynamicModule[
  {
    shiftLast,scPos,grPos,x1l,x2l,y1l,y2l,x1,x2,y1,y2,xr,yr,optLast,xr1,yr1,xr2,yr2,xc,yc,xdif,ydif,xsc,ysc
  },
  x1=0;
  y1=0;
  x2=1;
  y2=1;
  Graphics[
    {
      Dynamic[
        If[shiftLast =!= CurrentValue["ShiftKey"],
          shiftLast = CurrentValue["ShiftKey"];

          scPos = MousePosition["GraphicsScaled"];
          grPos = MousePosition["Graphics"];
          {{x1l, x2l}, {y1l, y2l}} = {{x1, x2}, {y1, y2}};
          xr = x2 - x1;
          yr = y2 - y1;
        ];
        If[CurrentValue["ShiftKey"] == True &&

            MousePosition["Graphics"] =!= None,
          {{x1, x2}, {y1,
            y2}} = {{x1l, x2l}, {y1l,
            y2l}} + (scPos - MousePosition["GraphicsScaled"]) {xr, yr}
        ];
        If[optLast =!= CurrentValue["OptionKey"],
          optLast = CurrentValue["OptionKey"];

          scPos = MousePosition["GraphicsScaled"];
          grPos = MousePosition["Graphics"];
          {{x1l, x2l}, {y1l, y2l}} = {{x1, x2}, {y1, y2}};
          xr = x2 - x1;
          yr = y2 - y1;
          {xr1, yr1} = -{x1, y1} + grPos ;
          {xr2, yr2} = {x2, y2} - grPos;
          {xc, yc} = grPos;
        ];
        If[CurrentValue["OptionKey"] == True &&

            MousePosition["Graphics"] =!= None,
          {xdif, ydif} = (scPos - MousePosition["GraphicsScaled"]);
          {xsc, ysc} = {2^(-10 * xdif), 2^(-10 ydif)};
          x1 = xc - xsc * xr1;
          y1 = yc - ysc * yr1;
          x2 = xc + xsc * xr2;
          y2 = yc + ysc * yr2;
        ];
        InfiniteLine[{0, 0}, {1, 1}]
      ]
      , Dynamic[InfiniteLine[{0, 0}, {1, -1}]]
    }
    , Frame -> True
    , GridLines -> Automatic
    , PlotRange -> {{Dynamic[x1], Dynamic[x2]}, {Dynamic[y1], Dynamic[y2]}}
    , AspectRatio -> 1
    , ImagePadding -> 40
  ]
];
plot[]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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