16
$\begingroup$

I want to emulate the GeoGebra app. I want to get an effect like this in Mathematica.

enter image description here

I don't know how to move whole circle without changing the radius of the circle.

My sample code:

Manipulate[
  Graphics[{Circle[p, Norm[p2 - p]]}, PlotRange -> 5, Frame -> 1], 
  {{p, {0, 0}}, Locator}, 
  {{p2, {2, 2}}, Locator}]
$\endgroup$
  • 2
    $\begingroup$ Related, though almost the converse of this question: (56390) $\endgroup$ – Mr.Wizard Sep 15 '14 at 7:43
  • $\begingroup$ Closely related 30354 $\endgroup$ – Kuba Sep 15 '14 at 13:26
7
$\begingroup$

This is what I find more intuitive:

circle[] := DynamicModule[{a = {0, 0}, b = {1, 0}, r = 1, w},
  {
   Dynamic@Circle[a, r],
   Locator[Dynamic[a, {(w = b - a) &, (a = #; b = a + w) &, None}]],
   Locator[Dynamic[b, (b = #; r = Norm[b - a]) &]]

   }]

Graphics[circle[], Frame -> True, PlotRange -> 2]

enter image description here


And this is what fits well OP's example:

circle2[] := DynamicModule[{a = {0, 0}, b = {1, 0}, r = 1, s, p, hand},
  {Thick,
   EventHandler[
    Dynamic@hand@Circle[a, r],
    {"MouseDown" :> {s = {p[], a, b}; },
     "MouseDragged" :> {{a, b} = (p[] - s[[1]] + #) & /@ Rest[s]}

     }],
   Locator[Dynamic[a, (a = #; r = Norm[b - a]) &]], 
   Locator[Dynamic[b, (b = #; r = Norm[b - a]) &]]}

  ,
  Initialization :> (
    p[] := MousePosition["Graphics"];
    hand = MouseAppearance[#, "LinkHand"] &;
    )]

Graphics[circle2[], Frame -> True, PlotRange -> 2]

You can improve styling ofc.

$\endgroup$
  • $\begingroup$ This is nice, but it doesn't have the behavior the OP asks for. $\endgroup$ – m_goldberg Sep 15 '14 at 15:09
  • $\begingroup$ Still seems wrong. Dragging the center locator doesn't change the radius. Dragging on the circle's circumference doesn't move it. $\endgroup$ – m_goldberg Sep 15 '14 at 16:47
  • $\begingroup$ I have now. It meets the specs. I like it. But I don't like circle. I think it detracts from your answer to leave it in. $\endgroup$ – m_goldberg Sep 15 '14 at 17:30
  • $\begingroup$ @m_goldberg Ok, removed :) $\endgroup$ – Kuba Sep 15 '14 at 17:37
  • $\begingroup$ Personally, I preferred the original circle based version - which garnered my upvote. While it didn't replicate the GeoGebra behavior exactly, it certainly got the same idea across and with much simpler code. Furthermore, it's not clear from the question that an exact replication was necessary - at least not to me. $\endgroup$ – Mark McClure Sep 15 '14 at 17:43
8
$\begingroup$

I do nor know how to implement what you want to do in a Manipulate expression using locators, because I don't know how to handle mouse events in a Manipulate expression. However, if you are willing to accept an answer using EventHandler, the behavior you ask for isn't very difficult to implement.

With[{δ = .2}, 
  DynamicModule[{p1 = {0, 0}, p2 = {2, 2}, mouse, action, dp},
    EventHandler[
      Dynamic @ Graphics[{
          {PointSize[Large], Point[{p1, p2}]},
          {Thick, Circle[p1, Norm[p2 - p1]]}},
        Frame -> True,
        PlotRange -> 5],
      {"MouseDown" :>
        (mouse = MousePosition["Graphics"];
         action =
          Which[
           Norm[p1 - mouse] < δ , "p1",
           Norm[p2 - mouse] < δ , "p2",
           Abs[Norm[mouse - p1] - Norm[p2 - p1]] < δ , "circle"]),
       "MouseDragged" :>
        (mouse = MousePosition["Graphics"];
         Switch[action,
          "p1", p1 = mouse,
          "p2", p2 = mouse,
          "circle", dp = p2 - p1; p1 = mouse; p2 = p1 + dp])}]]]

dynamic-circle

The plan behind this code is

  • A mouse-down event detects what visual object the mouse is near. This in turn sets what action should be done during the drag.

  • A mouse-dragged event carries out the selected action.

$\endgroup$
  • $\begingroup$ I like that Mouse-Action stuff! Cool. $\endgroup$ – user9660 Sep 15 '14 at 15:37
1
$\begingroup$
x = {3, 3};
y = {5, 3};
LocatorPane[Dynamic[{x, y}], 
 Dynamic@Graphics[{{Gray, Circle[x, Abs[y[[1]] - x[[1]]]]}, {Blue, 
     PointSize[0.02], Point[{x, {y[[1]], x[[2]]}}]}}, Axes -> True, 
   PlotRange -> {{-2, 8}, {-2, 8}}, AxesOrigin -> {0, 0}], 
 Appearance -> None]
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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