Here is a "dirty programming" version of a zooming tool. It is not nice, could be
better designed, but it works. It is a modification of the very nice tool from Ingolf
Dahl (thanks!!!) that introduces locators whose coordinates can be copied and which
shows some programming possibilities that are very interesting (BTW, where do we find
the documentation for DynamicModuleBox and LocatorPaneBox? These look useful!). I
modified it to automatically put two locators at the corners of the graphic, to zoom
within locators and introduce two new locators on the new graphic, and to unzoom to the
original graphic. I left the copy locator part because it can be useful (at least, I
need it...).
Many things are not nice:
-I had to introduce a Global variable called uNZOOM to store the original graphics.
-I redraw the zoomed graphics twice, once without locators and then with locators (I
had no time to find out how to do it in one shot).
-I don't draw a rectangle to show the region to be zoomed.
-Robustness is not tested (wrote it this morning and played with it only a little).
All these could be improved, but I needed a working version quickly. Maybe somebody
have ideas for a more efficient and robust version.
CreatePalette[Column[{
Button["Add LocatorPane",
SelectionMove[InputNotebook[], All, CellContents];
Global`uNZOOM = NotebookRead[InputNotebook[]];
NotebookWrite[InputNotebook[],
(DynamicModuleBox[
{$CellContext`pts$$ = (PlotRange /.
AbsoluteOptions[ToExpression[#]])\[Transpose]},
LocatorPaneBox[Dynamic[$CellContext`pts$$], #,
LocatorAutoCreate -> False],
DynamicModuleValues :> {}]) &@NotebookRead[InputNotebook[]]
]
],
Button["Zoom within Locators",
SelectionMove[InputNotebook[], All, CellContents];
Module[{b},
b = NotebookRead[InputNotebook[]];
If[And[Length[b] >= 3, MatchQ[b[[2]], _LocatorPaneBox]],
NotebookWrite[InputNotebook[],
ToBoxes[
Show[ToExpression[b[[2, 2]]],
PlotRange ->
Sort /@ (ToExpression[b[[1, 1]]]\[Transpose])]]
];
NotebookWrite[InputNotebook[], (DynamicModuleBox[
{$CellContext`pts$$ = (PlotRange /.
AbsoluteOptions[ToExpression[#]])\[Transpose]},
LocatorPaneBox[Dynamic[$CellContext`pts$$], #,
LocatorAutoCreate -> False],
DynamicModuleValues :> {}]) &@
NotebookRead[InputNotebook[]]]
]
]
],
Button["Copy locator positions",
SelectionMove[InputNotebook[], All, Cell];
FrontEndExecute[FrontEndToken["Copy"]];
SelectionMove[InputNotebook[], All, CellContents];
Module[{b},
b = NotebookRead[InputNotebook[]];
If[And[Length[b] >= 3, MatchQ[b[[2]], _LocatorPaneBox]],
b = b[[1, 1]];
$LocatorPositions = b;
SelectionMove[ClipboardNotebook[], All, Notebook];
NotebookWrite[ClipboardNotebook[], ToBoxes[b], All];
SelectionMove[ClipboardNotebook[], All, Notebook]]
]
],
Button["UnZoom",
SelectionMove[InputNotebook[], All, Cell];
NotebookWrite[InputNotebook[], Global`uNZOOM]
],
Dynamic[MousePosition["Graphics"]]
}],
WindowTitle -> "Zooming Tool"];
Cordially.
Guy Lamouche