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: enter image description here

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 Jun 13 '16 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],
   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]]
  • 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? – kornaros Jun 13 '16 at 14:33
  • I think ImageDimensions[[1]] should be ImageDimensions[img][[1]]. – yulinlinyu Jun 13 '16 at 15:04
  • @Bole Is it possible to add redo and Undo buttons? It will very useful for the case I make a mistake... – kornaros Jun 13 '16 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 Jun 13 '16 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? – kornaros Jun 13 '16 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.

Snapshot

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}
   ]
  ]
  • Let us continue this discussion in chat. – kornaros Jun 15 '16 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}] – kmutiny Feb 7 at 2:09

Your Answer

 
discard

By clicking "Post Your Answer", you acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.

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