Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2007

[Date Index] [Thread Index] [Author Index]

Search the Archive

Version 4: Zoom2D and GetGraphicsCoordinates palettes combined

  • To: mathgroup at smc.vnet.net
  • Subject: [mg83274] Version 4: [mg83125] Zoom2D and GetGraphicsCoordinates palettes combined
  • From: "Ingolf Dahl" <ingolf.dahl at telia.com>
  • Date: Fri, 16 Nov 2007 05:40:02 -0500 (EST)
  • References: <33308850.1194871140131.JavaMail.root@m35> <op.t1qqbkw8qu6oor@monster.gateway.2wire.net> <6922997.1195078252153.JavaMail.root@m35> <op.t1s2ovsfqu6oor@monster.gateway.2wire.net>

Thanks DrMajorBob,
Then I know that this Button issue was a bug in in version 6.0.0, corrected
later. Then it is better to change the code according to your suggestion,
and live with the quotes on the buttons in version 6.0.0. 

The idea by Daniel to eliminate "AspectRatio->Full" warning I do not agree
on. This option "Full" specifies that a graphic should be stretched so as to
fill out its enclosing region in a Grid or related construct. If we try to
break the graphics out of the enclosing region, I think it is appropriate
with a warning message, so that the we obtain a hint where to look if the
graphics changes its appearance drastically. The palette works anyway.
"AspectRatio->Automatic" gives unwanted result if the scales on the axes are
very different, so I prefer "AspectRatio->1" as substitute.

Thus version 4 of my code, with quotes, is included at the end of this
letter.

Ingolf Dahl 

> -----Original Message-----
> From: DrMajorBob [mailto:drmajorbob at bigfoot.com] 
> Sent: den 15 november 2007 00:40
> To: Ingolf Dahl; mathgroup at smc.vnet.net
> Subject: Re: [mg83186] RE: [mg83125] Zoom2D and 
> GetGraphicsCoordinates palettes combined
> 
> > Theoretically you are correct about the quotes, but what to do when 
> > the quotes then also appear on the buttons? (Windows XP SP2, 
> > Mathematica
> > 6.0.0)
> 
> Leaving them out has other strange effects. For instance, evaluating
> 
> Copy = 0;
> 
> before using your palette results in two of the buttons being 
> labeled 0.  
> Ditto if graphics = 0, etc.
> 
> Even without that, you tried to label one of the buttons 
> "Copy zoomed graphics", yet it comes out "Copy graphics 
> zoomed" -- with the multiplied symbols in canonical order.
> 
> Anyway, when I add the quotes to your code, they do NOT 
> appear on buttons at my machine (WinXP SP2, Mathematica 6.0.1.)
> 
> Bobby
> 
> On Wed, 14 Nov 2007 03:47:46 -0600, Ingolf Dahl 
> <ingolf.dahl at telia.com>
> wrote:
> 
> > Theoretically you are correct about the quotes, but what to do when 
> > the quotes then also appear on the buttons? (Windows XP SP2, 
> > Mathematica
> > 6.0.0)
> > The extra = in the first published version of the code was probably 
> > introduced at a line break by the menu item "Copy As Input 
> Text". Is 
> > was never in my code. There has also been some problems with extra 
> > line breaks in the text strings, introduced somewhere in 
> the copying 
> > chain. Please use now my version 3 (or later), without quotes and 
> > extra "=", but with some new features.
> >
> > Best regards
> >
> > Ingolf Dahl
> > http://web.telia.com/~u31815170/Mathematica/
> >
> >> -----Original Message-----
> >> From: DrMajorBob [mailto:drmajorbob at bigfoot.com]
> >> Sent: den 13 november 2007 18:18
> >> To: Ingolf Dahl; mathgroup at smc.vnet.net
> >> Subject: Re: [mg83125] Zoom2D and GetGraphicsCoordinates palettes 
> >> combined
> >>
> >> Nice, but there were some typos: Button titles lacking quotes, and 
> >> "$LocatorPositions = =b" should be "$LocatorPositions=b".
> >>
> >> Bobby
> >>
> >> On Mon, 12 Nov 2007 04:12:33 -0600, Ingolf Dahl 
> >> <ingolf.dahl at telia.com>
> >> wrote:
> >>
> >> > To MathGroup,
> >> >
> >> > Daniel [dh at metrohm.ch] recently posted a really nice Zoom2D
> >> palette. I
> >> > have earlier posted a GetGraphicsCoordinates palette. I
> >> have now tried
> >> > to combine these palettes, in such a way that it is
> >> possible to zoom
> >> > 2D-graphics, and then select points inside the zoomed 
> picture (with 
> >> > better accuracy).
> > (snipped)
> >
> 
> --
> DrMajorBob at bigfoot.com
> 
Version 4 code:
*******************************************************************
CreatePalette[
  Button["Zoom", 
   Module[{g, g0, g1, pp1, pp2, arorg}, 
    g0 = NotebookRead[SelectedNotebook[]];
    g = Position[
      g0, (Graphics[__] | GraphicsBox[__]), {0, Infinity}];
    If[g == {}, g0 === {}, g0 = {g0[[Sequence @@ Sort[g][[1]]]]}];
    g1 = Catch[
      If[g0 === {}, Throw[{}]];
      g = 
       If[Head[g0[[1]]] === GraphicsBox, ToExpression[g0[[1]]], 
        g0[[1]]];
      If[Length[Cases[g0, Dynamic[__], {0, Infinity}, 1]] > 0, 
       Throw[{}]];
      arorg = (AspectRatio /. AbsoluteOptions[g]);
      If[arorg === Full, arorg = 1.; g = Show[g, AspectRatio -> 1]];
      If[Not[NumberQ[arorg]], Throw[{}]];
      {pp1, pp2} = (PlotRange /. AbsoluteOptions[g]);
      If[And[MatchQ[pp1, {_?NumberQ, _?NumberQ}], 
        MatchQ[pp2, {_?NumberQ, _?NumberQ}]], {pp1, pp2} = 
        Transpose[{pp1, pp2}], Throw[{}]];
      {pp1, pp2} = {0.75 pp1 + 0.25 pp2, 0.25 pp1 + 0.75 pp2};
      DynamicModule[{p1 = pp1, p2 = pp2, lp = {0, 0}, 
        aspectswitch = 0, pts = {{0, 0}}, aspectslider = 1, 
        arorgdyn = arorg*(pp2[[1]] - pp1[[1]])/(pp2[[2]] - pp1[[2]])},
        Column[{LocatorPane[Dynamic[{p1, p2}], 
          Show[{g, 
            Graphics[{Opacity[0.1], 
              Rectangle[Dynamic[p1], Dynamic[p2]]}]}, 
           ImageSize -> Small]],
         TextCell["Zoom corners:"],
         InputField[Dynamic[p1], FieldSize -> 14],
         InputField[Dynamic[p2], FieldSize -> 14],
         Row[{TextCell["AspectRatio set by slider:"], 
           Checkbox[Dynamic[aspectswitch], {0, 1}]}], 
         Dynamic[If[aspectswitch == 1, 
           Row[{Slider[Dynamic[aspectslider], {0.2, 5., 0.1}, 
              ImageSize -> 150], 
             InputField[Dynamic[aspectslider], FieldSize -> 3]}], 
           TextCell["AspectRatio is kept as zoomed area."]]], 
         LocatorPane[Dynamic[pts], 
          Show[g, PlotRange :> Dynamic[Transpose[{p1, p2}]], 
           Frame -> True, ImageSize -> Full, 
           AspectRatio -> 
            Dynamic[
             Which[aspectswitch == 
               0, (aspectslider = Round[#, 0.001]; #) &@
               Abs[arorgdyn*(p2[[2]] - p1[[2]])/(p2[[1]] - p1[[1]])], 
              aspectswitch == 1, aspectslider]]], 
          LocatorAutoCreate -> True], 
         TextCell["Use Alt+Click to add or delete locators!"], 
         TextCell["Locator positions:"],
         InputField[Dynamic[pts], FieldSize -> 14],
         Button[
          "Copy locator positions", (SelectionMove[ButtonNotebook[], 
            All, ButtonCell]; 
           SelectionMove[ButtonNotebook[], All, CellContents]; 
           SelectionMove[ButtonNotebook[], All, CellContents];
           FrontEndExecute[FrontEndToken[ButtonNotebook[], "Copy"]];
           Module[{b}, b = NotebookRead[ButtonNotebook[]];
            If[Length[b] >= 2, b = b[[1, 5]];
             $LocatorPositions = b;
             SelectionMove[ClipboardNotebook[], All, Notebook];
             NotebookWrite[ClipboardNotebook[], ToBoxes[b], All];
             SelectionMove[ClipboardNotebook[], All, Notebook];
             SelectionMove[ButtonNotebook[], Before, Cell]]])], 
         Button["Copy zoomed graphics", (SelectionMove[ButtonNotebook[],
             All, ButtonCell]; 
           SelectionMove[ButtonNotebook[], All, CellContents];
           FrontEndExecute[FrontEndToken[ButtonNotebook[], "Copy"]];
           Module[{b}, b = NotebookRead[ButtonNotebook[]];
            
            If[Length[b] >= 2, 
             b = Cell[BoxData[#1], 
                 "Output"] &@(b[[2, 1, 1, 7, 1, 
                  2]] /. {(PlotRange :> _) -> (PlotRange -> 
                    Transpose[
                    b[[1, {1, 
                    2}]]]), (AspectRatio -> _) -> (AspectRatio -> 
                    Which[b[[1, 4]] == 0, 
                    Abs[b[[1, 
                    7]]*(b[[1, 2]][[2]] - 
                    b[[1, 1]][[2]])/(b[[1, 2]][[1]] - 
                    b[[1, 1]][[1]])], b[[1, 4]] == 1, 
                    b[[1, 6]]]), (ImageSize -> Full) -> Sequence[]});
             SelectionMove[ClipboardNotebook[], All, Notebook];
             NotebookWrite[ClipboardNotebook[], b, All];
             SelectionMove[ClipboardNotebook[], All, Notebook];
             SelectionMove[ButtonNotebook[], Before, Cell]]])], 
         Dynamic[MousePosition["Graphics"]]}, Center]]];
    If[g1 === {}, CreateDialog[{TextCell["Zoom: 
        
        No proper input available. Select some 2D, Mathematica-6 type \
grahics and \npress the Zoom button again! Please avoid dynamic \
content!"], DefaultButton[]}],
     CreateDocument[g1, WindowSize -> {290, All}, 
      WindowTitle -> "Zoom-DHID", 
      WindowElements -> {"VerticalScrollBar"}, 
      WindowFrame -> "Palette", Background -> GrayLevel[0.96]]]]],
  WindowTitle -> "Zoom2D"];




  • Prev by Date: Re: Multiple Constants
  • Next by Date: Re: Message: "Numerical interation converging too slowly"
  • Previous by thread: Re: BinaryWrite and Position in Mathematica 6
  • Next by thread: What is a good way of returning a function from a Module[]?