Show warning when emergency stopping & destopping manually-controlled…

… train.
kmzbrnoI · Jan 21, 2023 · 4c78002 · 4c78002
1 parent abf9148
commit 4c78002
Show file tree

Hide file tree

Showing 2 changed files with 41 additions and 2 deletions.
diff --git a/src/blocks/BlockTrack.pas b/src/blocks/BlockTrack.pas
@@ -125,6 +125,7 @@   TBlkTrack = class(TBlk)
     procedure PotvrDeleteTrain(Sender: TIdContext; success: Boolean);
     procedure PotvrUvolTrain(Sender: TIdContext; success: Boolean);
     procedure PotvrRegVezmiTrain(Sender: TIdContext; success: Boolean);
+    procedure PotvrSTOPTrainOff(Sender: TObject);
 
     procedure MenuObsazClick(SenderPnl: TIdContext; SenderOR: TObject);
     procedure MenuUvolClick(SenderPnl: TIdContext; SenderOR: TObject);
@@ -1263,11 +1264,24 @@ procedure TBlkTrack.MenuSTOPTrainOnClick(SenderPnl: TIdContext; SenderOR: TObjec
 
   var train: TTrain := TrainDb.trains[Self.trains[TPanelConnData(SenderPnl.Data).train_menu_index]];
   train.EmergencyStop();
+
+  if (train.IsAnyHVRuc()) then
+    train.RucUPO(SenderPnl);
 end;
 
 procedure TBlkTrack.MenuSTOPTrainOffClick(SenderPnl: TIdContext; SenderOR: TObject);
 begin
-  Self.MenuJedTrainClick(SenderPnl, SenderOR);
+  if (train.IsAnyHVRuc()) then
+    train.RucUPO(SenderPnl, SenderOR, Self.PotvrSTOPTrainOff)
+  else
+    Self.MenuJedTrainClick(SenderPnl, SenderOR);
+end;
+
+procedure TBlkTrack.PotvrSTOPTrainOff(Sender: TObject);
+begin
+  var SenderPnl: TIdContext := TIdContext(Sender);
+  if ((SenderPnl.data as TPanelConnData).UPO_ref <> nil) then
+    Self.MenuJedTrainClick(SenderPnl, (SenderPnl.data as TPanelConnData).UPO_ref);
 end;
 
 procedure TBlkTrack.MenuJedTrainClick(SenderPnl: TIdContext; SenderOR: TObject);

diff --git a/src/trains/Train.pas b/src/trains/Train.pas
@@ -161,6 +161,8 @@   TTrain = class
      function StrArrowDirection(): string;
 
      procedure CallChangeToTracks();
+     procedure RucUPO(AContext: TIdContext; ref: TObject = nil; callbackOk: TNotifyEvent = nil; callbackEsc: TNotifyEvent = nil);
+     function IsAnyHVRuc(): Boolean;
 
      property index: Integer read findex;
      property sdata: TTrainData read data;
@@ -198,7 +200,7 @@ implementation
       DataHV, AreaDb, TCPServerPanel, BlockDb, BlockSignal, blockRailway,
       fRegulator, fMain, BlockRailwayTrack, announcementHelper, announcement,
       TechnologieTrakce, ownConvert, TJCDatabase, TechnologieJC, IfThenElse,
-      TCPAreasRef;
+      TCPAreasRef, UPO, JCBarriers;
 
 ////////////////////////////////////////////////////////////////////////////////
 
@@ -1566,4 +1568,27 @@ procedure TTrain.CallChangeToTracks();
  end;
 end;
 
+procedure TTrain.RucUPO(AContext: TIdContext; ref: TObject = nil; callbackOk: TNotifyEvent = nil; callbackEsc: TNotifyEvent = nil);
+begin
+  var UPO := TList<TUPOItem>.Create();
+  try
+    for var addr: Integer in Self.HVs do
+      if ((Assigned(HVDb[addr])) and (HVDb[addr].ruc)) then
+        UPO.Add(JCBarriers.JCBarrierToMessage(JCBarrier(barHVManual, nil, addr)));
+    PanelServer.UPO(AContext, UPO, false, callbackOk, callbackEsc, ref);
+  finally
+    UPO.Free();
+  end;
+end;
+
+function TTrain.IsAnyHVRuc(): Boolean;
+begin
+  for var addr: Integer in Self.HVs do
+    if ((Assigned(HVDb[addr])) and (HVDb[addr].ruc)) then
+      Exit(true);
+  Result := false;
+end;
+
+////////////////////////////////////////////////////////////////////////////////
+
 end.//unit