unit UnitDebug;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls , ComCtrls, Menus, unitconfig;

type
  TFormDebug = class(TForm)
    EditNivDebug: TEdit;
    Label1: TLabel;
    LabelTitreDebug: TLabel;
    SaveDialog: TSaveDialog;
    ButtonEcrLog: TButton;
    ButtonRazTampon: TButton;
    ButtonCherche: TButton;
    ButtonAffEvtChrono: TButton;
    ButtonCop: TButton;
    PopupMenuRE: TPopupMenu;
    copier1: TMenuItem;
    ButtonRazLog: TButton;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    CheckAffSig: TCheckBox;
    CheckBoxEvtDetAig: TCheckBox;
    CheckBoxTraceLIste: TCheckBox;
    CheckTrame: TCheckBox;
    CheckBoxAffFD: TCheckBox;
    CheckBoxAffDebDecSig: TCheckBox;
    GroupBox3: TGroupBox;
    ButtonSigSuiv: TButton;
    ButtonCanSuivSig: TButton;
    EditSigSuiv: TEdit;
    Label4: TLabel;
    GroupBox4: TGroupBox;
    ButtonDetSuiv: TButton;
    EditPrec: TEdit;
    EditActuel: TEdit;
    ButtonCP: TButton;
    Button2: TButton;
    RichDebug: TRichEdit;
    PopupMenuRD: TPopupMenu;
    Copier2: TMenuItem;
    GroupBox5: TGroupBox;
    ButtonSimuDet0: TButton;
    ButtonSimuDet1: TButton;
    EditSimuDet: TEdit;
    ButtonRazTout: TButton;
    EditDebugSignal: TEdit;
    CheckBoxTiers: TCheckBox;
    ButtonSimuAct0: TButton;
    ButtonSimuAct1: TButton;
    ButtonElSuiv: TButton;
    CheckBox1: TCheckBox;
    CheckDebugTCO: TCheckBox;
    GroupBox6: TGroupBox;
    EditAdresse: TEdit;
    Label3: TLabel;
    Label5: TLabel;
    EditSortie: TEdit;
    Button1: TButton;
    Button0: TButton;
    MemoEvtDet: TRichEdit;
    CheckDetSIg: TCheckBox;
    CheckBoxPrinc: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure ButtonEcrLogClick(Sender: TObject);
    procedure EditNivDebugKeyPress(Sender: TObject; var Key: Char);
    procedure CheckAffSigClick(Sender: TObject);
    procedure ButtonRazTamponClick(Sender: TObject);
    procedure ButtonChercheClick(Sender: TObject);
    procedure ButtonAffEvtChronoClick(Sender: TObject);
    procedure CheckBoxTraceLIsteClick(Sender: TObject);
    procedure CheckTrameClick(Sender: TObject);
    procedure ButtonCopClick(Sender: TObject);
    procedure ButtonRazLogClick(Sender: TObject);
    procedure CheckBoxEvtDetAigClick(Sender: TObject);
    procedure CheckBoxAffFDClick(Sender: TObject);
    procedure CheckBoxAffDebDecSigClick(Sender: TObject);
    procedure ButtonSigSuivClick(Sender: TObject);
    procedure ButtonDetSuivClick(Sender: TObject);
    procedure ButtonCanSuivSigClick(Sender: TObject);
    procedure ButtonCPClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Copier2Click(Sender: TObject);
    procedure RichDebugChange(Sender: TObject);
    procedure ButtonSimuDet0Click(Sender: TObject);
    procedure ButtonSimuDet1Click(Sender: TObject);
    procedure ButtonRazToutClick(Sender: TObject);
    procedure MemoEvtDet1Change(Sender: TObject);
    procedure EditDebugSignalChange(Sender: TObject);
    procedure CheckBoxTiersClick(Sender: TObject);
    procedure ButtonSimuAct1Click(Sender: TObject);
    procedure ButtonSimuAct0Click(Sender: TObject);
    procedure ButtonElSuivClick(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure CheckDebugTCOClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button0Click(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure FormActivate(Sender: TObject);
    procedure MemoEvtDetChange(Sender: TObject);
    procedure CheckDetSIgClick(Sender: TObject);
    procedure CheckBoxPrincClick(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  FormDebug: TFormDebug;
  NivDebug,signalDebug,compt_erreur,positionErreur,LigneErreur : integer;
  AffSignal,AffAffect,initform,AffFD,debug_dec_sig,debugTCO,DebugAffiche,AFfDetSIg,
  ProcPrinc : boolean;
  N_event_det : integer;   // index du dernier évènement (de 1 à 20)
  N_Event_tick : integer ; // dernier index


procedure AfficheDebug(s : string;lacouleur : TColor);
procedure AfficheDebug_suivi(s : string;lacouleur : TColor);
procedure RE_ColorLine(ARichEdit: TRichEdit; ARow: Integer; AColor: TColor);
procedure affiche_evt(s: string;lacouleur : TColor);
procedure couleurs_debug;

implementation

uses UnitPrinc;

{$R *.dfm}

procedure RE_ColorLine(ARichEdit : TRichEdit;ARow : Integer;AColor : TColor);
begin
  with ARichEdit do
  begin
    SelStart:=SendMessage(Handle,EM_LINEINDEX,ARow,0);
    SelLength:=Length(Lines[ARow]);
    SelAttributes.Color:=AColor;
    SelLength:=0;
  end;
end;

// affiche un texte coloré dans la fenêtre evt
procedure affiche_evt(s: string;lacouleur : TColor);
begin
  if DebugAffiche then
  with FormDebug.MemoEvtDet do
  begin
    Lines.add(s);
    RE_ColorLine(FormDebug.MemoEvtDet,FormDebug.MemoEvtDet.lines.count-1,lacouleur);
  end;
end;

procedure AfficheDebug(s : string;lacouleur : TColor);
begin
  if debugAffiche then
  with FormDebug.RichDebug do
  begin
    Lines.add(s);
    RE_ColorLine(FormDebug.RichDebug,FormDebug.RichDebug.lines.count-1,lacouleur);
  end;
end;

procedure couleurs_debug;
var c : tcomponent;
    i : integer;
begin
  if sombre then with formdebug do
  begin
    Color:=Couleurfond;
    for i:=0 to ComponentCount-1 do
    begin
      c:=Components[i];
      composant(c,couleurFond,couleurTexte);
    end;
  end;
end;

procedure AfficheDebug_suivi(s : string;lacouleur : TColor);
var i : integer;
begin
  if DebugAffiche then
  with formDebug.RichDebug do
  begin
    i:=lines.Count-1;
    s:=lines.Strings[i]+s;
    lines.Strings[i]:=s;
    RE_ColorLine(FormDebug.RichDebug,i,lacouleur);
  end;
end;

procedure TFormDebug.FormCreate(Sender: TObject);
var s: string;
begin
  if affevt then affiche('FormDebug create',clLime);
  if debug=1 then Affiche('Création fenêtre debug',clLime);
  EditNivDebug.Text:='0';
  RichDebug.WordWrap:=false;   // interdit la coupure des chaînes en limite du composant
  RichDebug.color:=$33;
  initform:=false;
  RichDebug.clear;
  s:=DateToStr(date)+' '+TimeToStr(Time)+' ';
  Autoscroll:=true; // permet l'affichage de l'ascenseur dans radstudio
  DebugAffiche:=true;
  compt_erreur:=0;
  LigneErreur:=0;
  if debug=1 then Affiche('Fin création fenêtre debug',clLime);
  // && débug=====================
  //CheckBoxEvtDetAig.Checked:=true;
  //CheckTrame.checked:=true;
  // fin debug====================
  couleurs_debug;
end;

procedure TFormDebug.ButtonEcrLogClick(Sender: TObject);
var s : string;
    i : integer;
    fte : textFile;
begin
  s:=GetCurrentDir;
  SaveDialog.InitialDir:=s;
  SaveDialog.DefaultExt:='txt';
  SaveDialog.Filter:='Fichiers texte (*.txt)|*.txt|Tous fichiers (*.*)|*.*';
  if SaveDialog.Execute then
  begin
    s:=SaveDialog.FileName;
    assignFile(fte,s);
    rewrite(fte);
    with RichDebug do
    for i:=0 to Lines.Count do
    begin
      writeln(fte,Lines[i]);
    end;
    closefile(fte);
  end;
end;

procedure TFormDebug.EditNivDebugKeyPress(Sender: TObject; var Key: Char);
  var i,e  : integer;
begin
 if ord(Key) = VK_RETURN then
  begin
    Key := #0; // prevent beeping
    val(EditNivDebug.text,i,e);
    if e=0 then
    begin
      if (i>=0) and (i<=3) then NivDebug:=i
      else EditNivDebug.text:='3';
    end
    else EditNivDebug.text:='0';
  end; 
  RichDebug.Lines.add('Niveau='+intToSTR(NivDebug));
end;


procedure TFormDebug.CheckAffSigClick(Sender: TObject);
begin
  AffSignal:=checkAffSig.Checked;
end;

procedure TFormDebug.ButtonRazTamponClick(Sender: TObject);
begin
   N_event_det:=0;
   Event_det[1].adresse:=0;
   MemoEvtDet.Clear;
   memoEvtDet.Refresh;
end;

procedure TFormDebug.ButtonChercheClick(Sender: TObject);
var i,l,positionErreur : integer;
    s : string;
    trouve : boolean;
begin
  with RichDebug do
  begin
    ligneErreur:=0;
    repeat
      s:=lowercase(Lines[ligneErreur]);
      positionErreur:=pos('erreur',s);
      trouve:=positionErreur<>0;
      inc(LigneErreur);
    until (LigneErreur>=Lines.Count) or trouve;

    if trouve then
    begin
      inc(compt_erreur);
      //Affiche('trouvé en '+Lines[ligneErreur-1],clred);
      l:=0;
      for i:=0 to ligneErreur-1 do
      begin
        l:=l+length(Lines[i])+2;
      end;
      SelStart:= l-length(s)+positionErreur-3;
      SelLength:=6;
      SetFocus;      // afficher la sélection
      Perform(EM_SCROLLCARET,0,0); // et scroller à l'endroit de la sélection
    end
    else
    begin
      LigneErreur:=0;
    end;
  end;
end;

procedure TFormDebug.ButtonAffEvtChronoClick(Sender: TObject);
var i,j,etat : integer;
    s : string;
    typ : Tequipement;
begin
  RichDebug.Clear;
  if N_event_tick=0 then
  begin
    AfficheDebug('Il n''y a aucun évènement détecteur ou aiguillage',clyellow);
    exit;
  end;
  s:='Evts chronologiques det aig du '+DateToStr(date)+' '+TimeToStr(Time)+' '+s;
  AfficheDebug(s,clLime);

  for i:=1 to N_Event_tick do
  begin
    begin
      j:=event_det_tick[i].adresse;
      etat:=event_det_tick[i].etat;
      if j<>-1 then
      begin
        s:=IntToSTR(i)+' Tick='+IntToSTR(event_det_tick[i].tick);
        typ:=event_det_tick[i].modele;
        if typ=det then s:=s+' Det=';
        if typ=aig then s:=s+' Aig=';
        if typ=act then s:=s+' Act=';
        s:=s+IntToSTR(j)+'='+intToSTR(etat);
        AfficheDebug(s,clyellow);
      end;
    end;
  end;
  AfficheDebug('-----------------------------',cllime);
end;


procedure TFormDebug.CheckBoxTraceLIsteClick(Sender: TObject);
begin
  TraceListe:=CheckBoxTraceLIste.checked;
end;

procedure TFormDebug.CheckTrameClick(Sender: TObject);
begin
  traceTrames:=CheckTrame.Checked;
end;

procedure TFormDebug.ButtonCopClick(Sender: TObject);
begin
  RichDebug.Lines:=Formprinc.FenRich.lines;
end;

procedure TFormDebug.ButtonRazLogClick(Sender: TObject);
begin
  RichDebug.Clear;
end;

procedure TFormDebug.CheckBoxEvtDetAigClick(Sender: TObject);
begin
  AffAigDet:=CheckBoxEvtDetAig.checked;
end;

procedure TFormDebug.CheckBoxAffFDClick(Sender: TObject);
begin
  AffFD:=CheckBoxAffFD.checked;
end;

procedure TFormDebug.CheckBoxAffDebDecSigClick(Sender: TObject);
begin
  debug_dec_sig:=CheckBoxAffDebDecSig.checked;
end;


procedure TFormDebug.ButtonSigSuivClick(Sender: TObject);
var adr,erreur,ancdebug,AdrSigSuivant : integer ;
begin
  ancdebug:=NivDebug;
  NivDebug:=3;
  Val(EditSigSuiv.Text,adr,erreur);
  if (erreur<>0) and (adr>0) then etat_signal_suivant(Adr,1,AdrSigSuivant) ;
  NivDebug:=AncDebug;
end;

procedure TFormDebug.ButtonDetSuivClick(Sender: TObject);
var Adr,Prec,Actuel,erreur,ancdebug : integer ;
    type1,type2 : tequipement;
    s1,s2 : string;
begin
  ancdebug:=NivDebug;
  NivDebug:=3;
  s1:=EditPrec.Text;
  s2:=EditActuel.Text;
  if (s1='') or (s2='') then exit;
  if s1[1]='A' then begin type1:=aig;delete(s1,1,1);end else type1:=det;
  if s2[1]='A' then begin type2:=aig;delete(s2,1,1);end else type2:=det;
  Val(s1,prec,erreur);
  if (erreur<>0) or (prec<1) then exit;
  Val(s2,Actuel,erreur);
  if (erreur<>0) or (actuel<1) then exit;
  Adr:=detecteur_suivant_El(prec,type1,actuel,type2,1);
  if Adr<9996 then AfficheDebug('Le détecteur suivant aux éléments '+IntToSTR(prec)+'/'+IntToSTR(actuel)+' est '+IntToSTR(Adr),clyellow)
  else AfficheDebug('Pas trouvé de détecteur suvant aux éléments '+IntToSTR(prec)+'/'+IntToSTR(actuel),clyellow); 
  NivDebug:=AncDebug;
end;

procedure TFormDebug.ButtonCanSuivSigClick(Sender: TObject);
var Adr,erreur,ancdebug : integer ;
begin
  ancdebug:=NivDebug;
  NivDebug:=3;
  Val(EditSigSuiv.Text,Adr,erreur);
  if (erreur=0) or (adr<1) then exit;
  if test_memoire_zones(Adr) then AfficheDebug('Présence train',clYellow) else
    AfficheDebug('Absence train',clyellow);
  NivDebug:=AncDebug;
end;


procedure TFormDebug.ButtonCPClick(Sender: TObject);
var Adr,erreur,ancdebug,adrtrain,voie : integer ;
begin
  Val(EditSigSuiv.Text,Adr,erreur);
  if (erreur<>0) or (adr<1) then exit;
  ancdebug:=NivDebug;
  NivDebug:=3;
  if PresTrainPrec(Adr,Nb_cantons_Sig,false,voie,adrtrain) then AfficheDebug('Présence train '+intToSTR(AdrTrain),clYellow) else
    AfficheDebug('Absence train',clyellow);
  NivDebug:=AncDebug;
end;

procedure TFormDebug.Button2Click(Sender: TObject);
var Adr,erreur,ancdebug,train : integer ;
    reservetraintiers : boolean;
begin
  Val(EditSigSuiv.Text,Adr,erreur);
  if (erreur<>0) or (Adr<1) then exit;
  ancdebug:=NivDebug;
  NivDebug:=3;
  Cond_Carre(Adr);
  carre_signal(adr,0,reservetraintiers,train);
  NivDebug:=AncDebug;
end;

procedure TFormDebug.Copier2Click(Sender: TObject);
begin
  RichDebug.SelectAll;
  RichDebug.CopyToClipboard;
  RichDebug.SetFocus;
end;

// pour déplacer l'ascenseur de l'affichage automatiquement en bas
procedure TFormDebug.RichDebugChange(Sender: TObject);
begin
  SendMessage(RichDebug.handle,WM_VSCROLL,SB_BOTTOM,0);
end;

procedure TFormDebug.ButtonSimuDet0Click(Sender: TObject);
var det,erreur : integer;
begin
  val(EditSimuDet.Text,det,erreur);
  if (erreur=0) and (det>0) then Event_Detecteur(det,false,'');
end;

procedure TFormDebug.ButtonSimuDet1Click(Sender: TObject);
var det,erreur : integer;
begin
  val(EditSimuDet.Text,det,erreur);
  if (erreur=0) and (det>0) then Event_Detecteur(det,true,'');
end;

procedure TFormDebug.ButtonSimuAct1Click(Sender: TObject);
var det,erreur : integer;
begin
  val(EditSimuDet.Text,det,erreur);
  if (erreur=0) and (det>0) then Event_Act(det,0,1,'');
end;

procedure TFormDebug.ButtonSimuAct0Click(Sender: TObject);
var det,erreur : integer;
begin
  val(EditSimuDet.Text,det,erreur);
  if (erreur=0) and (det>0)  then Event_Act(det,0,0,'');
end;

procedure TFormDebug.ButtonRazToutClick(Sender: TObject);
begin
  AfficheDebug('Raz tous trains et routes',clLime);
  Raz_tout;
end;

procedure TFormDebug.MemoEvtDet1Change(Sender: TObject);
begin
  SendMessage(MemoEvtDet.handle,WM_VSCROLL,SB_BOTTOM,0);
end;

procedure TFormDebug.EditDebugSignalChange(Sender: TObject);
var erreur : integer;
begin
  val(EditDebugSignal.text,signalDebug,erreur);
end;

procedure TFormDebug.CheckBoxTiersClick(Sender: TObject);
begin
  AffTiers:=checkBoxTiers.checked;
end;

procedure TFormDebug.ButtonElSuivClick(Sender: TObject);
var Adr,Prec,Actuel,erreur,ancdebug : integer ;
    type1,type2 : tequipement;
    s1,s2,s : string;
begin
  ancdebug:=NivDebug;
  NivDebug:=3;
  s1:=EditPrec.Text;
  s2:=EditActuel.Text;
  if (s1='') or (s2='') then exit;
  if s1[1]='A' then begin type1:=aig;delete(s1,1,1);end else type1:=det;
  if s2[1]='A' then begin type2:=aig;delete(s2,1,1);end else type2:=det;
  Val(s1,prec,erreur);
  if (erreur<>0) or (prec<1) then exit;
  Val(s2,Actuel,erreur);
  if (erreur<>0) or (actuel<1) then exit;
  Adr:=suivant_Alg3(prec,type1,actuel,type2,1);
  if Adr<9995 then
  begin
    s:='L''élément suivant aux éléments '+IntToSTR(prec)+'/'+IntToSTR(actuel)+' est '+IntToSTR(Adr)+' ';
    s:=s+BTypeToChaine(typeGen);
    AfficheDebug(s,clYellow);
  end
  else AfficheDebug('Pas trouvé d''élement suivant aux éléments '+IntToSTR(prec)+'/'+IntToSTR(actuel),clyellow);
  NivDebug:=AncDebug;
end;

procedure TFormDebug.CheckBox1Click(Sender: TObject);
begin
  dupliqueEvt:=CheckBox1.checked;
end;

procedure TFormDebug.CheckDebugTCOClick(Sender: TObject);
begin
  debugTCO:=checkDebugTCO.checked;
end;

procedure TFormDebug.Button1Click(Sender: TObject);
var adr,sortie,erreur,groupe : integer;
    fonction : byte;
    s : string;
begin
  val(EditAdresse.text,adr,erreur);
  if (erreur<>0) or (adr<1) or (adr>2048) then
  begin
    EditAdresse.text:='1';
    exit;
  end;
  val(EditSortie.text,sortie,erreur);
  if (sortie<1) or (sortie>2) then
  begin
    EditSortie.text:='1';
    exit;
  end;

  s:='Accessoire '+IntToSTR(adr)+' ; sortie '+intToSTR(sortie)+' à 1';
  AfficheDebug(s,clyellow);

  if CDM_connecte then
  begin
    //AfficheDebug(intToSTR(adresse),clred);
    s:=chaine_CDM_Acc(adr,sortie);
    envoi_CDM(s);
  end;
  
  // pilotage par USB ou par éthernet de la centrale ------------
  if (hors_tension=false) and (portCommOuvert or parSocketLenz) then
  begin
    if protocole=1 then
    begin
      groupe:=(adr-1) div 4;
      fonction:=((adr-1) mod 4)*2 + (sortie-1);
      // pilotage à 1
      s:=#$52+Char(groupe)+char(fonction or $88);   // activer la sortie
      s:=checksum(s);
      envoi(s);     // envoi de la trame et attente Ack
    end;
    if protocole=2 then AfficheDebug('D10: Commande DCC++ pas encore implantée',clred);
  end;

  Self.ActiveControl:=nil;
end;

procedure TFormDebug.Button0Click(Sender: TObject);
var adr,sortie,erreur,groupe : integer;
    fonction : byte;
    s : string;
begin
  val(EditAdresse.text,adr,erreur);
  if (erreur<>0) or (adr<1) or (adr>2048) then
  begin
    EditAdresse.text:='1';
    exit;
  end;
  val(EditSortie.text,sortie,erreur);
  if (sortie<1) or (sortie>2) then
  begin
    EditSortie.text:='1';
    exit;
  end;

  s:='Accessoire '+IntToSTR(adr)+' ; sortie '+intToSTR(sortie)+' à 0';
  AfficheDebug(s,clyellow);

  if CDM_connecte then
  begin
    //AfficheDebug(intToSTR(adresse),clred);
    s:=chaine_CDM_Acc(adr,0);
    envoi_CDM(s);
  end;
  
  // pilotage par USB ou par éthernet de la centrale ------------
  if (hors_tension=false) and (portCommOuvert or parSocketLenz) then
  begin
    if protocole=1 then
    begin
      groupe:=(adr-1) div 4;
      fonction:=((adr-1) mod 4)*2 + (sortie-1);
      // pilotage à 0
      s:=#$52+Char(groupe)+char(fonction or $80);  // désactiver la sortie
      s:=checksum(s);
      envoi(s);     // envoi de la trame et attente Ack
    end;
    if protocole=2 then AfficheDebug('D11: Commande DCC++ pas encore implantée',clred)
  end;

  Self.ActiveControl:=nil;
end;

procedure TFormDebug.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if key=chr(27) then close;
end;

procedure TFormDebug.FormActivate(Sender: TObject);
begin
  if affevt then affiche('FormConfig activate',clLime);
  formDebug.buttonCP.Caption:='Etat '+intToSTR(Nb_cantons_Sig)+' cantons précédents signal';
end;

procedure TFormDebug.MemoEvtDetChange(Sender: TObject);
begin
  SendMessage(MemoEvtDet.handle,WM_VSCROLL,SB_BOTTOM,0);
end;

procedure TFormDebug.CheckDetSIgClick(Sender: TObject);
begin
  AFfDetSIg:=checkDetSig.checked;
end;


procedure TFormDebug.CheckBoxPrincClick(Sender: TObject);
begin
  ProcPrinc:=checkBoxPrinc.checked;
end;


end.
