Manipulate[] with interdependent Locators

Question

how would I create a Manipulate to draw a InfiniteLine between two Locator? The first Loactor should control the x/y of the first point together with the y of the second one. The second Locator should control x/y of the second point only.

In other words the first Locator should parallel shift the line in y, the second one change the slope.

This is what I tried so far (track the changes of first point y and update second point):

 Manipulate[
 Graphics[
   If[p1[[2]] =!= old,
     p2[[2]] += p1[[2]] - old;
     old = p1[[2]];
     ];
 
  InfiniteLine[{p1, p2}],
  PlotRange -> 4 {{-1, 1}, {-1, 1}}
  ],
 {{old, 0}, ControlType -> None},
 {{p1, {0, 0}}, Locator},
 {{p2, {2, 1}}, Locator}
 ]

This "works" somehow but only when just slowly dragging the first point, otherwise it gets garbled.

Any hints wellcome.

Hello I came up with a new trial.

Manipulate[
 Graphics[{InfiniteLine[{pt[[1]], pt[[2]]}]}, PlotRange -> 2],
 {{pt, {{-1, 0}, {1, 0}}}, Locator,
  TrackingFunction -> (pt = {#[[1]], #[[2]] + #[[1]] - pt[[1]]}; &)}]

The Idea is to detect delta movement of the first point an add it to the second one to keep the slope constant when moving the first point, done via the TrackingFunction option. Delta "should be" calculated by subtracting the old value pt[1] from the actual value #[1] both of the first point.

Somehow this still does not work, the longer you drag the more error bulds up. While @kglr solution is running smooth I am still curious why ma attempt fails.

Answer 1

Update 2: A variation on RobertNovak`s answer to keep the horizontal axis of the second locator fixed:

tF[p : {{x1_, y1_}, {x2_, y2_}}] := If[#[[1, 1]] != #[[2, 1]], 
    If[CurrentValue["CurrentLocatorPaneThumb"] == 2, #, 
       {#[[1]], {x2, #[[1, 2]] + (x2 - #[[1, 1]]) (y1 - y2)/(x1 - x2)}}], p] &;

Manipulate[Graphics[{InfiniteLine @ pt, Opacity[0], 
    MapThread[MouseAppearance[Point@#, #2] &, {pt, {"PanView", "RotateViewVertical"}}]},
   PlotRange -> 2, 
   GridLines -> {{{pt[[2, 1]], Dashed}}, None}], 
 {{pt, {{-1, 0}, {1, 1}}}, Locator, TrackingFunction -> (pt = tF[pt]@#; &), 
   Appearance -> (Style["\[EmptyCircle]", 24, Bold, #] & /@ {Red, Blue})}]

Update: Using a single control with multiple locators, we specify the updates based on the active locator:

Manipulate[Graphics[{InfiniteLine @ pt}, PlotRange -> 2, 
    GridLines -> {{{pt[[2, 1]], Dashed}}, None}],
 {{pt, {{-1, 0}, {1, 1}}}, Locator, 
  TrackingFunction -> (If[CurrentValue["CurrentLocatorPaneThumb"] == 2, 
       pt = #;, 
       pt = {#[[1]], pt[[2]] + #[[1]] - pt[[1]]}]; &), 
  Appearance -> (Style["■", 24, #] & /@ {Red, Blue})}]

Original answer:

You can use DynamicModule and Locator with two-argument form of Dynamic:

DynamicModule[{p1 = {0, 0}, p2 = {2, 1}, old = {0, 0}}, 
 Deploy @ Dynamic @
   Graphics[{InfiniteLine[{p1, p2}], 
     Locator[Dynamic[p1, (p1 = #; p2 += p1 - old; old = p1;) &]], 
     Locator[Dynamic[p2]]}, 
    GridLines -> {{{p2[[1]], Dashed}}, None}, 
    Frame -> True, FrameTicks -> None,
    PlotRange -> 4 {{-1, 1}, {-1, 1}}]]

If you have to use Manipulate:

Manipulate[Graphics[{InfiniteLine[{p1, p2}], 
   Locator[Dynamic[p1, (p1 = #; p2 += p1 - old; old = p1;) &]], 
   Locator[Dynamic[p2]]},
  PlotRange -> 4 {{-1, 1}, {-1, 1}}],
 {{old, {0, 0}}, None}, {{p1, {0, 0}}, None}, {{p2, {2, 1}}, None}]

Answer 2

Finaly thanks to @kglr the locators move in the most intuitive way. The second point now only moves in y while the first one is draged arround.

Manipulate[Graphics[{InfiniteLine@pt}, PlotRange -> 2],
 {{pt, {{-1, 0}, {1, 1/2}}}, Locator,
  TrackingFunction -> (With[{t = 
         Apply[Divide]@Reverse[pt[[2]] - pt[[1]]]},
       pt = If[#[[2, 1]] != #[[1, 1]],
         {#[[1]], 
          If[CurrentValue["CurrentLocatorPaneThumb"] == 2, #[[
            2]], {pt[[2, 1]], 
            pt[[2, 2]] + #[[1, 2]] - pt[[1, 2]] - 
             t (#[[1, 1]] - pt[[1, 1]])}]},
         pt]
       ]; &),
  Appearance -> {Style["✥", Large], Style["®", Large]}}
 ]