# Insert new points at specific places in the Locator Pane?

I am trying to make some BSplineCurve examples for my students. For fun I created the following Manipulate that draw an elephant using BSplineCurve

img = Import[
"http://www.clipartqueen.com/image-files/elephant-silhouette.png"]
ptsin = {{984., 950.}, {1113., 898.}, {1188.2, 843.6}, {1226.7,
784.7}, {1247.1, 748.5}, {1260.6, 712.3}, {1269.7,
655.7}, {1274.2, 592.3}, {1278.7, 501.8}, {1292.3,
452.}, {1328.5, 370.5}, {1249.3, 465.6}, {1224.4, 375.1}, {1224.4,
341.1}, {1197.3, 289.1}, {1188.2, 232.5}, {1181.4, 164.6}};
Manipulate[
Show[Image[img, ImageSize -> 400],
Graphics[{Yellow, Blue, Thick,
BSplineCurve[pts, SplineDegree -> 3,
SplineClosed -> True], Polygon[pts]}, Frame -> True,
PlotRange -> All]], {{pts, ptsin}, Locator,
LocatorAutoCreate -> True}, "Alt+click to add points"]

I take the following locator Pane:

I need some help on making a nicer LocatorPane! I can draw new points into pts list (using Alt+ click) but these are only inserted at the end of pts. Is it possible each point is exactly inserted after (the position of) the last clicked point(and not at the end of pts)? Is it posible to have redo or undo buttons( in other words: How to make a "history" of pts)? Excuse for the multiple questions here. I found that LocatorPane is very attractive method for making fun with maths, vector drawings etc.

I hope that is not a duplicate question!

• Undo: Alt + clicking an existing point removes it.
– BoLe
Commented Jun 13, 2016 at 9:30

I guess you could do everything you wanted but you will have to abandon the general Manipulate and program your own LocatorPane. Here's a try.

First I modified your input data slightly to debugging taste.

With[{width = 400},
original = Import[
"http://www.clipartqueen.com/image-files/elephant-silhouette.png"];
img = ImageResize[original, width] // ColorReplace[#,
Black -> LightRed, 1] &;
ptsin = {{984., 950.}, {1113., 898.}, {1188.2, 843.6}, {1226.7,
784.7}, {1247.1, 748.5}, {1260.6, 712.3}, {1269.7,
655.7}, {1274.2, 592.3}, {1278.7, 501.8}, {1292.3,
452.}, {1328.5, 370.5}, {1249.3, 465.6}, {1224.4,
375.1}, {1224.4, 341.1}, {1197.3, 289.1}, {1188.2,
232.5}, {1181.4, 164.6}};
ptsin *= width/ImageDimensions[original][[1]]];

LocatorPane below has two arguments, both dynamically updated: the locator coordinates and displayed expression. Dynamic of the coordinates has the optional second argument: function that is evaluated whenever the coordinates change. This way the index of the coordinate last moved (i) is stored. EventHandler shows its first argument (Show) and also listens to defined events: in this case the depressing of the mouse right button. (I don't think you can interfere with Alt + clicking, so you must append your functionality to a new event.)

Coded like this, the user interface below is: Alt + clicking appends a new point to the end of ptsin (or removes an existing point), right-clicking inserts a new point after the point last dragged.

DynamicModule[{i = Length[ptsin], last},
last[prev_, curr_] :=
If[Length[prev] != Length[curr],
Length[curr],
LocatorPane[
Dynamic[ptsin, (i = last[ptsin, #]; ptsin = #) &],
EventHandler[
Show[img,
Graphics[{Thick, Black, Line[ptsin],
Text[i, Scaled[{.95, .95}], {1, 1}]}],
Frame -> True] // Dynamic,
{{"MouseDown", 2} :> (ptsin = Insert[ptsin,
MousePosition["GraphicsAbsolute"], i + 1])}
],
LocatorAutoCreate -> True]]
• Thanks for the improvments. I tried to run the code but without sucess. I have problem with FirstPosition Command. Onother question: How one could delete a point from pstin? Commented Jun 13, 2016 at 14:33
• I think ImageDimensions[[1]] should be ImageDimensions[img][[1]]. Commented Jun 13, 2016 at 15:04
• @Bole Is it possible to add redo and Undo buttons? It will very useful for the case I make a mistake... Commented Jun 13, 2016 at 15:18
• @komaros FirstPosition is a Mathematica 10 method. Instead do Position[SameQ @@@ Thread[{prev, curr}], False, 1, 1][[1, 1]]. Mistake with ImageDimensions in the preliminary block, correct. You can readily implement Undo with a Button. Just keep remembering where in ptsin the last new point was added. What do you think Redo should do here? Inserting another point at the same place wouldn't have much sense ...
– BoLe
Commented Jun 13, 2016 at 18:57
• @Bole. I am interested in not only for the last insertion but for all the history of inserted points in pts. One could delete or undo the last or any other insertion before this ( like the normal editing in a photo program). I have never seen an implementation of these two buttons in Mathematica! Do you have any ideas how one could implement this? Commented Jun 13, 2016 at 19:55

A version with buttons. First thing to note: I don't know how to subscribe to the Alt + click event and do appropriate things when it triggers. This is why mixing point adding by Alt + click and right-click is error-prone. If one sticks to adding points merely by right-click (via {"MouseDown", 2} event in LocatorPane), code could be bug-free ...

You start it up by supplying an image and a list of starting points (ptsin in your case for example), or specify the image alone and the locator list will be initially empty.

edit[image_] := edit[image, {}]

edit[image_, starters_] :=
DynamicModule[{
p = starters, i = Length[starters], track = {}, last},

(* index of a locator point last moved/clicked on *)
last[prev_, curr_] :=
Position[SameQ @@@ Thread[{prev, curr}], False, 1, 1][[1, 1]];

Column[{

(* top row of button controls: Undo, Clear, Random 5 *)
Row[{
Button["Undo",
If[track =!= {}, CompoundExpression[
p = Delete[p, Last[track]],
track = Most[track],
If[i > Length[track], i = Length[track]]]],
ImageSize -> Automatic], Spacer[5],
Button["Clear", (p = {}; track = {}; i = 0),
ImageSize -> Automatic], Spacer[5],
Button["Random 5",
(p =
Table[RandomInteger[{1, #}] & /@ ImageDimensions[image], {5}];
track = {}; i = Length[p]),
ImageSize -> Automatic]
}
],

LocatorPane[
Dynamic[p, (i = last[p, #]; p = #) &],
EventHandler[
Dynamic@Show[image,
Graphics[{Thick, Black, Line[p],
Text["Last moved: " <> ToString[i],
Scaled[{.95, .95}], {1, 1}],
Text["Insertion track: " <> StringJoin[Riffle[track, " "]],
Scaled[{.05, .95}], {-1, 1}]}]],
{{"MouseDown", 2} :> CompoundExpression[
p = Insert[p, MousePosition["Graphics"], i + 1],
AppendTo[track, i + 1], i += 1]}],
LocatorAutoCreate -> True]
},
Frame -> True,
FrameStyle -> Directive[Gray, Thick, Dashed],
Spacings -> {2, 2}
]
]
• Commented Jun 15, 2016 at 4:10
• I get this error: StringJoin::string: String expected at position 1 in 1<> <>2. >> And the spacing is off, so I used these to fix it: StringJoin[Riffle[Map[ToString[#] &, track], " "]] Text["Last moved: " <> ToString[i], Scaled[{.95, .95}], {1, -1}] Commented Feb 7, 2018 at 2:09