# Panning by moving Origin (0,0) with Mouse

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


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[], 5 - p[]}, {-5 - p[], 5 - p[]}},
GridLines -> {Range[-5, 5, 1], Range[-5, 5, 1]}], {{p, {0, 0}},
Locator}] 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. • 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? – glS Dec 27 '15 at 19:35
• @glS I cannot replicate your issue on my machine. I have no problems. I'm running M10.3 on OSX10.11.1. – Michael McCain Dec 27 '15 at 19:51

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

Manipulate[
Graphics[{Point[p], Locator[{0, 0}, Appearance -> Large], Red, AbsolutePointSize,
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, 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, 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}]

• +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.] – Michael E2 Dec 27 '15 at 19:19

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 