Mathematica Stack Exchange is a question and answer site for users of Mathematica. Join them; it only takes a minute:

Sign up
Here's how it works:
  1. Anybody can ask a question
  2. Anybody can answer
  3. The best answers are voted up and rise to the top

I am not sure if what I want to do is possible in Mathematica. I've provided something simple below to convey what I want to do. Basically what I want to happen is that when the Locator crosses over the blue line, the Disk[] will turn red and stay red until the Locator crosses the blue line again (it should stay red regardless of where the Locator is).

 Plot[x^3, {x, 0, 1}, PlotRange -> {{0, 1.5}, {0, 1.5}}, Frame -> True,
  Epilog -> 
   Inset[Graphics[{Blue, Disk[]}, ImageSize -> 30], {0.2, 1}]],
 {{comp, {0.5, 0.7}}, Locator}]

enter image description here

I am trying to make a Demonstration that shows the behavior of a single component (water in this case) on a pressure vs. temperature phase diagram. Water exists in 3 distinct phases and there is only a phase change from liquid to vapor (or supercritical) if a certain boundary is crossed (looks like the one I showed here) but you can go around that boundary and not change phase. So that's what I am trying to show here with the colored disk as the indicator of "phase change"


 DynamicModule[{col = False, acc = 0, p = {420, Log[6]}},
  EventHandler[Show[Quiet@LogPlot[Log[T], {T, 273.16, 647.096}, PlotStyle -> Thick] /. 
     l_Line :> EventHandler[l, {"MouseEntered" :> If[acc === 0, 
(col = col /. {True -> False, False -> True})]}],
    Frame -> True, PlotRange -> {{273.16, 700}, {Log[5.6], Log[7]}}, 
    Epilog -> 
       Text[Style[Dynamic@If[col == True, "liquid", "vapor"], 18], 
        Scaled[{0.400, 0.1}]]]]],
   {"MouseDown" :> (acc = 1; MousePosition[Dynamic@p]), 
    "MouseDragged" :> (MousePosition[Dynamic@p]), 
    "MouseUp" :> (acc = 0; MousePosition[Dynamic@p])}, 
   PassEventsDown -> True]],
 {{p, {420, Log[6]}}, Locator, 
  Appearance -> Graphics[{Disk[]}, ImageSize -> 12]}]

It will only work if the mouse is not depressed.

share|improve this question
What is the problem, it seems you've changed If[acc === 1, to If[acc === 0, on purpose. P.s. in case of True/False you can just use col = !col instead of rules. – Kuba Jul 2 '14 at 8:48
I will try that. The reason I messed with If[acc===1 was because nothing at all worked with that definition for some reason. Thanks for all your help! – baumannr Jul 2 '14 at 15:55
up vote 2 down vote accepted

I don't know how to handle parallel Events but if there is single Locator you can try this:

DynamicModule[{col = Blue, acc = 0, p = {1, 1}},
   Graphics[{Dynamic@Disk[p, Scaled@.03]}],
   Plot[x^3, {x, 0, 1}] /. l_Line :> EventHandler[ l, {"MouseEntered" :> 
                   If[acc === 1, (col = col /. {Red -> Blue, Blue -> Red})]}]
   , Frame -> True, PlotRange -> {{0, 1.5}, {0, 1.5}}, 
   Epilog -> Inset[Graphics[Dynamic@{col, Disk[]}, ImageSize -> 30], {0.2, 1}]
  {"MouseDown" :> (acc = 1; p = MousePosition["Graphics"]), 
   "MouseDragged" :> (p = MousePosition["Graphics"]),
   "MouseUp" :> (acc = 0;)}, PassEventsDown -> True]

enter image description here

Do not move cursor too quickly :P

The order of things in Show is important. Our custom locator has to be under the border line.

share|improve this answer
Thank you! This is simple and works...well mostly. It only works in my other program it the mouse is NOT depressed haha. – baumannr Jul 1 '14 at 20:43
@baumannr could you say more, maybe I can help? (not today since I have to go but in near future :)) – Kuba Jul 1 '14 at 21:19
In your solution, when you have the button on the mouse depressed and move the black circle across the line x^3, the color of the other disk changes. In the code that I worked this into, if I "click" and hold the mouse and then drag the cursor over the line, it won't work. It does work properly only if I just scroll over the line (without ever having clicked the mouse). I've made a number of desperate attempts to correct it but no luck. I will post an update with code a bit more similar to what I am using in case that makes any difference. Thank you so much! No rush. – baumannr Jul 1 '14 at 21:50
@baumannr I will take a look at this tomorrow. If your update can change the context so those answers are not valid anymore please consider posting another question. Cya – Kuba Jul 1 '14 at 22:47

One way to detect crossings is to form a straight line between the previous position of the locator and the new position, and then check if there is an intersection between that straight line and $x^3$. I wrote this function to count the number of line intersection of a straight line with endpoints p1 and p2. The function which in this case is $x^3$ can be any function, and the interval which in this case is $0<x<1$ can be any interval.

SetAttributes[countIntersections, HoldFirst]
countIntersections[{f_, {xmin_, xmax_}}, p1_, p2_] := Module[{delta = p2 - p1, sol},
  If[p1 == p2, Return[0]];
  sol = Solve[{
     {x, f} == p1 + Normalize[delta] k,
     # < x < #2 & @@ Sort[{First[p1], First[p1 + delta]}],
     xmin < x < xmax,
     0 < k < Norm[delta]
     }, {x, k}];

Just to emphasize how this work I built a little demo.

DynamicModule[{p1 = {0.5, 0.5}, p2 = {0.6, 0.5}},
  Dynamic[{p1, p2}],
    Plot[x^3, {x, 0, 1}],
       countIntersections[{x^3, {0, 1}}, p1, p2] == 0,
      Line[{p1, p2}]

First demo

But of course for the real thing we don't have two locators. The second position is simply the previous position of the locator. Here's how that can be written:

DynamicModule[{p1 = {0.5, 0.5}, p2, plot, diskColor = Black},
 p2 = p1;
     countIntersections[{x^3, {0, 1}}, p1, p2] != 0,
     diskColor = diskColor /. {Red -> Black, Black -> Red}
    plot = Show[
      Plot[x^3, {x, 0, 1}],
        Disk[{0.2, 1}, 0.08]
        }], AspectRatio -> 0.75, PlotRange -> {{0, 2}, {0, 1.5}}
   p2 = p1;

Second demo

share|improve this answer

Partial answer: this does not handle the going-around-the-curve bit.

 g1 = Graphics[{Blue, Table[Circle[{0, 0}, i], {i, 3}]}, ImageSize -> 20];
 g2 = Graphics[{Red, Table[Circle[{0, 0}, i], {i, 3}]},  ImageSize -> 20];

 DynamicModule[{pt = {0.1, 1}},
    Plot[x^3, {x, 0, 1}, PlotRange -> {{0, 1.5}, {0, 1.5}}, 
       Filling -> Bottom, Frame -> True, ImageSize -> 600,
       Epilog -> Dynamic@{
          If[Last[pt] < First[pt]^3, Blue, Red], PointSize[.05], Point[{.1, 1}],
          Locator[Dynamic[pt], If[Last[pt] < First[pt]^3, g1, g2]]}]]

enter image description here

enter image description here

share|improve this answer

Your Answer


By posting your answer, you agree to the privacy policy and terms of service.

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