Panning by moving Origin (0,0) with Mouse

Question

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

Ending View

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

Answer 1

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

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

Answer 2

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

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

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

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

Answer 3

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