Insert new points at specific places in the Locator Pane?

Question

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!

Answer 1

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],
   FirstPosition[SameQ @@@ Thread[{prev, curr}], False][[1]]];
 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]]

Answer 2

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}
   ]
  ]