Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

Consider the following snippet from the documentation on LocatorPane

  DynamicModule[{pt = {0, 0}}, 
   LocatorPane[Dynamic[pt], Framed@Graphics[{}, PlotRange -> 10]]]

I would like to use a different shape for the LocatorPane, i.e. parallelogram, hexagon, rectangle ). ( In further processing they are 'translated' to a nice tiling. )

Question: How can I limit the LocatorPane to a shape other than a square?

EDIT:

From kguler's Answer 'Locator in a Diamond' I made this so that it works with multiple locators.

   pts = RandomReal[1, {3, 2}];
   g = Graphics[{Blue, Polygon[Dynamic[pts]], Opacity[.1], Disk[]}, 
    PlotRange -> 1.25];
    LocatorPane[
    Dynamic[pts, (If[Apply[And, Map[Norm[#] < 1 &, pts]], pts = #, 
        pts = pts1]) &], g]

The limiting region is a circle here, but can be changed to any function that returns a Boolean.

There is one remaining problem and I think that it is related to the problem I found here: LocatorPane, Dynamic and deleting locators

share|improve this question
add comment

3 Answers

up vote 9 down vote accepted

This approach uses the second argument of Dynamic similar to kguler's answer. In this solution you can add and remove locators using Alt-click (or Cmd-click if you're using a mac). The points are in this case restricted to hexagons, but this can easily be adapted to other shapes by changing hexagon. The list centers0 is the list of centers of the tiles in the tessellation.

If the point at coordinates pt lie outside the tile with center center, getcrd will return new coordinates at the intersection point of the border of the tile and the line through center and pt. Note that this function isn't restricted to hexagons, so it should work for more general polygons as well (including non-convex ones).

DynamicModule[{hexagon, centers0, clst, getcrd, locators, translate, pts0}, 
 hexagon = N@Transpose[Through[{Re, Im}[Exp[2 Pi I Range[6]/6]]]];
 clst = centers0 = {{-3/2, -Sqrt[3]/2}, {3/2, -Sqrt[3]/2}, 
   {0, -Sqrt[3]}, {0, 0}, {0, Sqrt[3]}, {-3/2, Sqrt[3]/2}, {3/2, Sqrt[3]/2}} // N;
 pts0 = locators = clst;

 getcrd[center_, pt_] := 
  Module[{edges, lambdas}, 
   edges = Partition[center + # & /@ hexagon, 2, 1, {1, 1}];
   lambdas = If[Cross[center - pt].(#1 - #2) =!= 0., 
      {Cross[center - pt].(pt - #2)/Cross[center - pt].(#1 - #2), 
        Cross[#1 - #2].(#2 - pt)/Cross[#1 - #2].(center - pt)}, 
      {Infinity, Infinity}] & @@@ edges;
   lambdas = Cases[lambdas, {a_, b_} /; 0 <= a <= 1 && 0 <= b <= 1 :> b];
   If[Length[lambdas] > 0, pt + Max[lambdas] (center - pt), pt]];

 Panel@LocatorPane[
   Dynamic[locators, (If[Length[#] > Length[clst], 
       AppendTo[clst, Nearest[centers0, #[[-1]]][[1]]]];
      locators = MapThread[getcrd, {clst, #}];
      pts0 = locators) &],
   Dynamic[If[Length[clst] > Length[locators],
     clst = clst[[Evaluate[Nearest[pts0 -> Automatic]][#][[1]] & /@ locators]];
     pts0 = locators];
    Graphics[{EdgeForm[{Dashed, Red}], FaceForm[], 
      Translate[Polygon[hexagon], centers0]}, 
     PlotRange -> {{-3, 3}, {-3, 3}}, Background -> White]], 
   LocatorAutoCreate -> True, 
   Appearance -> Graphics[{Blue, Disk[]}, ImageSize -> 10]]
 ]

Mathematica graphics

share|improve this answer
add comment

Here are several variations using the second argument of Dynamic as in Istvan's first approach:

Locator on a diamond:

DynamicModule[{pt = {0, 1}}, 
LocatorPane[Dynamic[pt, (pt = Normalize[#, Norm[#, 1] &]) &], 
Graphics[{Red, Line[{{-1, 0}, {0, 1}, {1, 0}, {0, -1}, {-1, 0}}], 
Green, PointSize[.05], Dynamic[Point[pt]]}, 
PlotLabel -> Style["Locator on a Diamond", "Section", 14]], 
Appearance -> None]]

enter image description here

Locator inside a diamond:

DynamicModule[{pt = {0, 1}}, 
LocatorPane[ Dynamic[pt, (pt =  If[Norm[#, 1] < 1, #, Normalize[#, Norm[#, 1] &]]) &], 
Graphics[{Red, Line[{{-1, 0}, {0, 1}, {1, 0}, {0, -1}, {-1, 0}}], 
Green, PointSize[.05], Dynamic[Point[pt]]}, 
PlotLabel -> Style["Locator inside a Diamond", "Section", 14]], 
Appearance -> None]]

enter image description here

Locator inside a 3-Norm disk

DynamicModule[{pt = {0, 1}}, 
LocatorPane[Dynamic[pt, (pt = If[Norm[#, 3] < 1, #, Normalize[#, Norm[#, 1] &]]) &], 
RegionPlot[Norm[{x, y}, 3] <= 1, {x, -1.5, 1.5}, {y, -1.5, 1.5}, 
FrameTicks -> None, Epilog -> {PointSize[.05], Point[Dynamic[pt]]},
PlotLabel -> Style["Locator inside a 3-Norm Disk", "Section", 14]], 
Appearance -> None]]

enter image description here

Locator below a curve:

DynamicModule[{pt = {0, 1}}, 
LocatorPane[Dynamic[pt], 
Plot[Sin[x], {x, 0, 10}, Filling -> Bottom, Frame -> True, 
Epilog -> {Green, PointSize[.05], 
Point[Dynamic[{First[pt], Min[Last@pt, Sin[First[pt]]]}]]}, 
PlotLabel -> Style["Locator Below Curve", "Section", 14]], 
Appearance -> None]]

enter image description here

EDIT: Multiple locators with LocatorAutoCreate:

DynamicModule[{pts = {{0, 1}, {0, 0}, {1, 0}}}, 
LocatorPane[
Dynamic[pts, (pts = #; pts = Function[{pnt}, 
       If[Norm[pnt, 1] < 1, pnt, Normalize[pnt, (Norm[#, 1] &)]]] /@ pts )&], 
Graphics[{Red, Line[{{-1, 0}, {0, 1}, {1, 0}, {0, -1}, {-1, 0}}], 
Green, PointSize[.05], Dynamic[Point[pts]]}, 
PlotLabel -> Style["Locators inside a Diamond", "Section", 14]], 
LocatorAutoCreate -> True, Appearance -> None]]

enter image description here

share|improve this answer
    
I have tried to add LocatorAutoCreate to the Locator inside Diamond solution but that doesn't work. - The inside Diamond solution would be ideal because it would fit in nicely with existing code but I add all all sorts of shapes onto the diamond using locators. –  ndroock1 May 25 '12 at 11:46
    
@ndroock1, for multiple locators the second argument of Dynamic needs to be modified. I will post an edit when I get a version that works with LocatorAutoCreate. –  kguler May 25 '12 at 11:57
    
Is there a solution that works with more locators? I.e. ke ep the LocatorPane features intact just restrict the region? –  ndroock1 May 25 '12 at 11:57
    
I think the change needed is to Map the normalization function inside the second argument of Dynamic to each element of #; but i need to verify that it will work. –  kguler May 25 '12 at 12:03
    
please see my edit in the original question. I implemented what you proposed but it's not perfect yet. –  ndroock1 May 25 '12 at 12:40
add comment

I see two ways to achieve this:

1. Restrict movement via Dynamic

You can restrict the movement of the Locator object by specifying a suitable function as a second argument for the Dynamic expression.

pt = {0, 0};
LocatorPane[Dynamic[pt, (pt = If[Total[#^2] > 1, Normalize@#, #]) &], 
     Graphics[{Dashed, Circle[]}, ImageSize -> 200]]

Mathematica graphics

This is easy to do with circular objects (and rectangular ones of course), but it get's complicated when the region is something more complex. Luckily, for complicated polygons, we already have a good community-solution, that simply tests whether a point is inside a polygon or not: see here (SE), here (SE) and here (MathGroup). Now the problem is that whenever the mouse moves out of the boundary, the coordinate pair should be modified to be the closes point inside the polygon. I used the distance function defined in this demonstration.

(* define boundary polygon *)    
poly = N@Rescale[ExampleData[{"Statistics", "WesternUgandaBorder"}]];

(* function tests whether a point is inside a polygon *)
inPolyQ = 
  Compile[{{polygon, _Real, 2}, {x, _Real}, {y, _Real}}, 
   Block[{polySides = Length[polygon], X = polygon[[All, 1]], 
     Y = polygon[[All, 2]], Xi, Yi, Yip1, wn = 0, i = 1}, 
    While[i < polySides, Yi = Y[[i]]; Yip1 = Y[[i + 1]];
     If[Yi <= y, If[Yip1 > y, Xi = X[[i]];
        If[(X[[i + 1]] - Xi) (y - Yi) - (x - Xi) (Yip1 - Yi) > 0, 
         wn++;];];, If[Yip1 <= y, Xi = X[[i]];
        If[(X[[i + 1]] - Xi) (y - Yi) - (x - Xi) (Yip1 - Yi) < 0, 
         wn--;];];]; i++]; ! wn == 0]];

(* distance between two points *)
distance[{a_, b_}, p_] := Module[{pz, az, bz, z, d1, d2},
   If[a == b, {a, Norm[p - a]},
    {pz, az, bz} = Map[First[#] + I Last[#] &, {p, a, b}];
    z = (pz - az)/(bz - az);
    If[Not[0 <= Re[z] <= 1], d1 = Norm[p - a]; d2 = Norm[p - b]; 
     If[d1 < d2, {a, d1}, {b, d2}],
     {a + Re[z] (b - a), Norm[Im[z] (b - a)]}]]];

(* closest point of a polygon to a point *)
closest[pt_, poly_] := Module[{f},
   f = Map[distance[#, pt] &, Partition[poly, 2, 1, 1]];
   First@First[Sort[f, Last@#1 <= Last@#2 &]]
   ];

pt = {0.4, 0.5};
LocatorPane[
 Dynamic[pt, (pt = 
     If[inPolyQ[poly, First@#, Last@#], #, closest[#, poly]]) &], 
 Graphics[{FaceForm@None, EdgeForm@Dashed, Polygon@poly}, 
  ImageSize -> 200]]

Mathematica graphics

Now the locator nicely follows the boundary if the mouse is outside the area. If there are multiple adjoining areas (tiled space) each with a locator that is constrained to move inside the given polygon then there should be no problem on which locator to select when interacting with the graphics.

2. Restrict movement via graphics primitive

This basically involves creating your own LocatorPane object. The following code gives some ideas on how to do this. Let's define three hexagons, and put a dynamically updated locator in the middle of each. One can restrict the dynamically tracked mouse position to the given hexagon by reverting the point coordinate to the last valid value before leaving the hexagon (second argument of MousePosition). It is not perfect (a little rough around the edges) but I think it can be finetuned.

hexagon = {{1/2, Sqrt[3]/2}, {-(1/2), Sqrt[3]/2}, {-1, 
    0}, {-(1/2), -(Sqrt[3]/2)}, {1/2, -(Sqrt[3]/2)}, {1, 0}};
{pt1, pt2, 
  pt3} = {{1.5, Sqrt[3]/2}, {1.5, -(Sqrt[3]/2)}, {0, 
   0}}; (* initial positions *)
Dynamic@{pt1, pt2, pt3}
Graphics[{
  EdgeForm@Black, GrayLevel@.9,
  EventHandler[Polygon[# + {3/2, Sqrt[3]/2} & /@ hexagon],
   {
    "MouseClicked" :> (pt1 = MousePosition["Graphics", pt1]),
    "MouseDragged" :> (pt1 = MousePosition["Graphics", pt1])
    }],
  EventHandler[Polygon[# + {3/2, -(Sqrt[3]/2)} & /@ hexagon],
   {
    "MouseClicked" :> (pt2 = MousePosition["Graphics", pt2]),
    "MouseDragged" :> (pt2 = MousePosition["Graphics", pt2])
    }],
  EventHandler[Polygon[hexagon],
   {
    "MouseClicked" :> (pt3 = MousePosition["Graphics", pt3]),
    "MouseDragged" :> (pt3 = MousePosition["Graphics", pt3])
    }],
  {Blue, Circle[Dynamic@pt1, .05], AbsolutePointSize@5, 
   Point@Dynamic@pt1},
  {Red, Circle[Dynamic@pt2, .05], AbsolutePointSize@5, 
   Point@Dynamic@pt2},
  {Darker@Green, Circle[Dynamic@pt3, .05], AbsolutePointSize@5, 
   Point@Dynamic@pt3}
  }, Frame -> True, PlotRange -> {{-1.1, 2.6}, {-2, 2}}, 
 ImageSize -> 400, ImagePadding -> 20]

Mathematica graphics

share|improve this answer
    
In an earlier stage I had to drop and replace Manipulate, I am afraid that LocatorPane has to go too. My hopes are on @kguler for the moment. –  ndroock1 May 25 '12 at 11:54
    
@ndroock1 Please see my edit with the nonregular polygon update. –  István Zachar May 25 '12 at 12:17
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.