Drexel dragonThe Math ForumDonate to the Math Forum



Search All of the Math Forum:

Views expressed in these public forums are not endorsed by Drexel University or The Math Forum.


Math Forum » Discussions » Software » comp.soft-sys.math.mathematica

Topic: Cursor position on images
Replies: 2   Last Post: Jan 10, 2013 9:38 PM

Advanced Search

Back to Topic List Back to Topic List Jump to Tree View Jump to Tree View   Messages: [ Previous | Next ]
Murray Eisenberg

Posts: 2,097
Registered: 12/6/04
Re: Cursor position on images
Posted: Jan 8, 2013 11:39 PM
  Click to see the message monospaced in plain text Plain Text   Click to reply to this topic Reply

Either I'm not understanding the instructions for copyCurve or else
something is not working right for Mathematica 9.0.0 on Mac OS X.
Example:

pic = ExampleData[{"TestImage", "Lena"}]
copyCurve[pic]

I now type into the x1, y1, x2, y2 input fields the values 0, 0, 200,
200 respectively and press Enter.

When I use Alt+Click, nothing happens -- I don't see any Locator.

I also tried Shift+Alt+Click in case that's required for Mac, but still
no action.

On Jan 7, 2013, at 11:07 PM, Alexei Boulbitch <Alexei.Boulbitch@iee.lu>
wrote:

> I am sure this is straightforward but I cannot quite see how to do
this. I have an image (jpg file, but could be any format if that
matters). I want to be able to left click on the image and mark the
point with a dot of some sort and collect the coordinates of the point
(the coordinate system is fairly arbitrary). I then want to be able to
repeat this as many times as required and end up with a list of the
coordinates of the points clicked on for further manipulation. Clickpane
should do the trick but I can't work out how.
>
> Any suggestions, thanks.
>
> Peter
>
> Hi, Peter,
>
> It is not exactly but very close to what you ask about. Below you will

find a function along with its description. I use it to digitalize
functions only available as curves on graphics, like taken from images.
This might be what you have in mind. To try it just copy-paste any image
into Mathematica, give it a name and apply the copyCurve function to it.
Then act as it is described below. As the result you will get a list of
points coordinates.
>
> Have fun, Alexei
>
>
>
> Description
>
> The function copyCurve enables one to get the coordinates of curve

points from a plot found on an image and memorises them in a list
entitled ?listOfPoints?
> Parameters:
>
> image is any image. It should have Head=Image, but may be also a

Graphics object, since no specific functions of image have been used. I
typically wrap it in Image[] statement.
>
> Controls:
>
> The Checkbox ?whiteLocatorRing? defines, if the locators are shown by

a single color ring (unchecked), or with two rings, the outer having a
color defined by the ColorSlider (see below), the innder being white.
This may be helpful, if working with a too dark image.
>
> size controls the size of the image. The default value is 450. This

slider is used to adjust the size to the one to enable the most
comfortable work with the image plot.
>
> opacity controls the opacity of the line connecting the locators
>
> thickness controls the thickness of the double ring that forms each

locator.
>
> lineThickness controls the thickness of the line connecting the

locators
>
> color is the color slider that controls the color of the outer ring

forming the locator and the line connecting them. The inned locator ring
is always white.
>
> radius controls the radius of the locators.
>
> InputFields: should be supplied by the reference points x1 and x2 at

the axis x, as well as y1 and y2 at the axis y.
>
> Buttons: The buttons ?Memorize scale X? and ?Memorize scale Y? should

be pressed after the first two locators are placed on the corresponding
reference points (presumably, located at the x or y axes). Upon pressing
the reference points are memorized. The button ?Make list of the curve
points? should be pressed at the end of the session. Upon its pressing
the actual list of points representing the points of the curve is
assigned to the global variable ?listOfPoints?
>
>
> Operation:
> Step 1: Execute the function with the name of the image containing the

curve to be digitalized.
>
> Step 2: Enter the reference points at the plot axes into the input

fields. Press Enter.
>
> Step3: Alt+Click on the point with x-coordinate x1. This brings up the

first locator visible as a circle. Alt+Click on that with x2 which gives
rise to the second locator. Adjust the locators, if necessary. Press the
button ?Memorize scale X?.
>
> Step 4: Move the two already existing locators to the points with the

coordinates y1 and y2. Press the button ?Memorize scale Y?. Now the both
scales are captured.
>
> Step 5: Move the two already existing locators to the first two points

of the curve to be captured. Alt+Click on other points of the curve.
Each Alt+Click will generate an additional locator. Adjust locators, if
necessary. To remove, Alt+Click on unnecessary locators.
>
> Step 6: Press the button ?Make the list...?. This assigns the captured

list to the variable ?listOfPoints?. Done.
>
> The ?listOfPoints? is a global variable. It can be addressed

everywhere in the notebook.
>
> The function copyCurve
>
> Clear[copyCurve];
>
> copyCurve[image_] :=
>
> Manipulate[
> DynamicModule[{pts = {}, x1 = Null, x2 = Null, y1 = Null,
> y2 = Null, X1, X2, Y1, Y2, \[CapitalDelta]X, \[CapitalDelta]Y, g,
> myRound},
>
> myRound[x_] := Round[1000.*x]/1000. // N;
>
> (* Begins the column with all the content of the manipulate *)
> Column[{
> (* Begin LocatorPane*)
> Dynamic@LocatorPane[Union[Dynamic[pts]],
> Dynamic@
> Show[{ReplacePart[image, {4, 2} -> size],
> Graphics[{color, AbsoluteThickness[lineThickness],
> Opacity[opacity], Line[Union[pts]]}]
> }], LocatorAutoCreate -> True,
> (* Begin Locator appearance *)
> Appearance -> If[whiteLocatorRing,
>
> Graphics[{{color, AbsoluteThickness[thickness],
> Circle[{0, 0}, radius + thickness/2]}, {White,
> AbsoluteThickness[thickness], Circle[{0, 0}, radius]}},
> ImageSize -> 10]
> ,
> Graphics[{{color, AbsoluteThickness[thickness],
> Circle[{0, 0}, radius + thickness/2]}},
> ImageSize -> 10]](* End Locator appearance *)
> ],(* End LocatorPane*)
>
> (* Begin of the block of InputFields *)
> , Row[{ Style["\!\(\*SubscriptBox[\(x\), \(1\)]\):"],
> InputField[Dynamic[x1],
> FieldHint -> "Type \!\(\*SubscriptBox[\(x\), \(1\)]\)",
> FieldSize -> 7, FieldHintStyle -> {Red}],
> Spacer[20], Style[" \!\(\*SubscriptBox[\(y\), \(1\)]\):"],
> InputField[Dynamic[y1],
> FieldHint -> "Type \!\(\*SubscriptBox[\(y\), \(1\)]\)",
> FieldSize -> 7, FieldHintStyle -> {Red}]
> }],
> Row[{ Style["\!\(\*SubscriptBox[\(x\), \(2\)]\):"],
> InputField[Dynamic[x2],
> FieldHint -> "Type \!\(\*SubscriptBox[\(x\), \(2\)]\)",
> FieldSize -> 7, FieldHintStyle -> {Red}],
> Spacer[20], Style[" \!\(\*SubscriptBox[\(y\), \(2\)]\):"],
> InputField[Dynamic[y2],
> FieldHint ->
> "Type \!\(\*SubscriptBox[\(y\), \(2\)]\)+Enter",
> FieldSize -> 7, FieldHintStyle -> {Red}]
> }],
> (* End of the block of InputFields *)
> (* Begin the buttons row *)
> Row[{Spacer[15],
> (* Begin button "Memorize scale X" *)
> Button["Memorize scale X",
> X1 = Min[Transpose[myRound /@ Union[pts]][[1]]];
> X2 = Max[Transpose[myRound /@ Union[pts]][[1]]];
> \[CapitalDelta]X = X2 - X1;
> ],(* End of button "Memorize scale X" *)
> Spacer[70],
> (* Begin button "Memorize scale Y" *)
> Button["Memorize scale Y",
> Y1 = Min[Transpose[myRound /@ Union[pts]][[2]]];
> Y2 = Max[Transpose[myRound /@ Union[pts]][[2]]];
> \[CapitalDelta]Y = Y2 - Y1;
> ](* End of button "Memorize scale Y" *)
>
>
> }],(* End the buttons row *)
> Spacer[0],
>
> (* Begin button "Make the list of the curve's points" *)
> Button[Style["Make the list of the curve's points" , Bold],
> g[{a_, b_}] := {(x1*X2 - x2*X1)/\[CapitalDelta]X +
> a/\[CapitalDelta]X*Abs[x2 - x1], (
> y1*Y2 - y2*Y1)/\[CapitalDelta]Y +
> b/\[CapitalDelta]Y*Abs[y2 - y1]};
> Clear[listOfPoints];
> listOfPoints = Map[myRound, Map[g, pts]]
> ](* End of button "Make the list..." *)
>
> }, Alignment -> Center](*
> End of column with all the content of the manipulate *)
> ],(* End of the DynamicModule *)
>
> (* The massive of sliders begins *)
> Column[{Row[{Control[{whiteLocatorRing, {True, False}}],
> Spacer[50]}],
> Row[{Spacer[32.35], Control[{{size, 450}, 300, 800}],
> Spacer[38.5`], Control[{{opacity, 0.5}, 0, 1}]}],
> Row[{Spacer[10.], Control[{{thickness, 1}, 0.5, 5}],
> Spacer[13.65], Control[{{lineThickness, 1}, 0, 10}] }],
> Row[{Spacer[22.8], Control[{color, Red}], Spacer[59.3],
> Control[{{radius, 0.5}, 0, 3}]}]
> }, Alignment -> Center],(* The massive of sliders ends *)
>
> (* Definitions of sliders *)
> ControlType -> {Checkbox, Slider, Slider, Slider, Slider,
> ColorSlider, Slider},
> ControlPlacement -> Top, SaveDefinitions -> True
> ];
> (* End of the function *)
>
>
> Alexei BOULBITCH, Dr., habil.
> IEE S.A.
> ZAE Weiergewan,
> 11, rue Edmond Reuter,
> L-5326 Contern, LUXEMBOURG
>
> Office phone : +352-2454-2566
> Office fax: +352-2454-3566
> mobile phone: +49 151 52 40 66 44
>
> e-mail: alexei.boulbitch@iee.lu


---
Murray Eisenberg
murray@math.umass.edu
Mathematics & Statistics Dept.
Lederle Graduate Research Tower phone 413 549-1020 (H)
University of Massachusetts 413 545-2838 (W)
710 North Pleasant Street fax 413 545-1801
Amherst, MA 01003-9305









Point your RSS reader here for a feed of the latest messages in this topic.

[Privacy Policy] [Terms of Use]

© Drexel University 1994-2014. All Rights Reserved.
The Math Forum is a research and educational enterprise of the Drexel University School of Education.