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
  • 2
    $\begingroup$ Related, though almost the converse of this question: (56390) $\endgroup$
    – Mr.Wizard
    Sep 15, 2014 at 7:43
  • $\begingroup$ Closely related 30354 $\endgroup$
    – Kuba
    Sep 15, 2014 at 13:26

3 Answers 3

8
$\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$
5
  • $\begingroup$ This is nice, but it doesn't have the behavior the OP asks for. $\endgroup$
    – m_goldberg
    Sep 15, 2014 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, 2014 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, 2014 at 17:30
  • $\begingroup$ @m_goldberg Ok, removed :) $\endgroup$
    – Kuba
    Sep 15, 2014 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$ Sep 15, 2014 at 17:43
10
$\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$
1
  • $\begingroup$ I like that Mouse-Action stuff! Cool. $\endgroup$
    – user9660
    Sep 15, 2014 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 and acknowledge that you have read and understand our privacy policy and code of conduct.

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