unit UnitDebug;

interface

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

type
  TFormDebug = class(TForm)
    EditNivDebug: TEdit;
    Label1: TLabel;
    MemoEvtDet: TMemo;
    Label2: TLabel;
    SaveDialog: TSaveDialog;
    ButtonEcrLog: TButton;
    ButtonRazTampon: TButton;
    ButtonCherche: TButton;
    ButtonAffEvtChrono: TButton;
    ButtonCop: TButton;
    RichEdit: TRichEdit;
    PopupMenuRE: TPopupMenu;
    copier1: TMenuItem;
    ButtonRazLog: TButton;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    CheckAffSig: TCheckBox;
    CheckBoxEvtDetAig: TCheckBox;
    CheckBoxTraceLIste: TCheckBox;
    CheckTrame: TCheckBox;
    CheckBoxAct: TCheckBox;
    CheckBoxAffFD: TCheckBox;
    CheckBoxAffDebDecSig: TCheckBox;
    GroupBox3: TGroupBox;
    ButtonSigSuiv: TButton;
    ButtonCanSuivSig: TButton;
    EditSigSuiv: TEdit;
    Label4: TLabel;
    GroupBox4: TGroupBox;
    ButtonDetSuiv: TButton;
    EditPrec: TEdit;
    EditActuel: TEdit;
    Button1: TButton;
    Button2: TButton;
    RichDebug: TRichEdit;
    PopupMenuRD: TPopupMenu;
    Copier2: TMenuItem;
    GroupBox5: TGroupBox;
    ButtonSimuDet0: TButton;
    ButtonSimuDet1: TButton;
    EditSimuDet: TEdit;
    ButtonRazTout: TButton;
    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 copier1Click(Sender: TObject);
    procedure ButtonRazLogClick(Sender: TObject);
    procedure CheckBoxActClick(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 Button1Click(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 RichEditChange(Sender: TObject);
    procedure MemoEvtDetChange(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

Const
Max_Event_det_tick=30000;
Max_event_det=400;
Max_Trains=50;

var
  FormDebug: TFormDebug;
  NivDebug : integer;
  AffSignal,AffAffect,initform,AffFD,debug_dec_sig : boolean;
  N_event_det : integer; // index du dernier évènement (de 1 à 20)
  event_det : array[1..Max_event_det] of integer;
  event_det_train : array[1..Max_Trains] of record
                    NbEl : integer;
                    Det : array[1..3] of integer; // tableau des evts détecteurs par train
                    end;
  //                    tick 1/10s,détecteur
  N_Event_tick : integer ; // dernier index

  // tableau des évènements détecteurs et aiguillages
  event_det_tick : array[0..Max_Event_det_tick] of
     record
       tick : longint;
       detecteur : integer ;
       Aiguillage : integer ;
       actionneur : integer;
       objet : integer;  // numéro d'objet dans CDM
       etat : integer ; // état du détecteur de l'aiguillage ou de l'actionneur
       traite : boolean;  // traité lors de a recherche d'une route
     end;

  
  

procedure AfficheDebug(s : string;lacouleur : TColor);
Procedure Raz_tout;
procedure RE_ColorLine(ARichEdit: TRichEdit; ARow: Integer; AColor: TColor);
  
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;

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

Procedure Raz_tout;
var i : integer;
begin
  N_Event_tick:=0;
  N_event_det:=0;
  N_trains:=0;
  Formprinc.LabelNbTrains.caption:=IntToSTR(N_trains);
  for i:=1 to Max_Trains do Event_det_Train[i].NbEl:=0;
  i_simule:=0;
  FormDebug.MemoEvtDet.Clear;
  FormDebug.Richedit.Clear;
end;

procedure TFormDebug.FormCreate(Sender: TObject);
var s: string;
begin
  EditNivDebug.Text:='0';
  s:='Cette fenêtre permet d''afficher des informations sur le ';
  s:=s+'comportement du programme. Positionner le niveau du débug de 1 à 3 pour';
  s:=s+' afficher des informations plus ou moins détaillées.';
  RichEdit.Lines.add(s);
  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)+' ';
  if IsWow64Process then s:=s+' OS 64 Bits' else s:=s+' OS 32 Bits';
  RichEdit.color:=$111122;
  RichDebug.Lines.add(s);
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);
    writeln(fte,s);
    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]:=0;
   MemoEvtDet.Clear;
   memoEvtDet.Refresh;
end;

procedure TFormDebug.ButtonChercheClick(Sender: TObject);
var i : integer;
    trouve : boolean;
begin

  with RichDebug do
  begin
    i:=0;
    repeat
      trouve:=pos('erreur',uppercase(Lines[i]))<>0;
      inc(i);
    until (i>=Lines.Count) or trouve;
    if trouve then
    begin
    Affiche('trouvé en '+intToSTR(i),clyellow);
    SelStart := I - 1;
    SelLength := Length('erreur');
    SetFocus;
    end;
  end;
end;

procedure TFormDebug.ButtonAffEvtChronoClick(Sender: TObject);
var i,j,etat : integer;
    s : string;
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].detecteur;
      etat:=event_det_tick[i].etat;
      if j<>-1 then
      begin
        s:=IntToSTR(i)+' Tick='+IntToSTR(event_det_tick[i].tick)+' Det='+IntToSTR(j)+'='+intToSTR(etat);
        AfficheDebug(s,clyellow);
      end;
    end;

    j:=event_det_tick[i].aiguillage;
    if j<>-1 then
    begin
      s:=IntToSTR(i)+' Tick='+IntToSTR(event_det_tick[i].tick)+' Aig='+IntToSTR(j)+'='+intToSTR(event_det_tick[i].etat);
      AfficheDebug(s,clyellow);
    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);
var i : integer;
begin
  RichDebug.Lines:=Formprinc.FenRich.lines;
end;

procedure TFormDebug.copier1Click(Sender: TObject);
begin
  RichEdit.SelectAll;
  RichEdit.CopyToClipboard;
  RichEdit.SetFocus;
end;

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

procedure TFormDebug.CheckBoxActClick(Sender: TObject);
begin
  AffActionneur:=CheckBoxAct.Checked;
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 : integer ;
begin
  ancdebug:=NivDebug;
  NivDebug:=3;
  Val(EditSigSuiv.Text,adr,erreur);
  if erreur<>0 then exit;
  etat_signal_suivant(Adr,1) ;
  NivDebug:=AncDebug;
end;

procedure TFormDebug.ButtonDetSuivClick(Sender: TObject);
var Adr,type1,type2,Prec,Actuel,erreur,ancdebug : integer ;
    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:=2;delete(s1,1,1);end else type1:=1;
  if s2[1]='A' then begin type2:=2;delete(s2,1,1);end else type2:=1;
  Val(s1,prec,erreur); if erreur<>0 then exit;
  Val(s2,Actuel,erreur); if erreur<>0 then exit;
  Adr:=detecteur_suivant_El(prec,type1,actuel,type2);
  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 then exit;
  test_memoire_zones(Adr);
  NivDebug:=AncDebug;
end;



procedure TFormDebug.Button1Click(Sender: TObject);
var Adr,erreur,ancdebug : integer ;
begin
  Val(EditSigSuiv.Text,Adr,erreur); if erreur<>0 then exit;
  ancdebug:=NivDebug;
  NivDebug:=3;
  PresTrainPrec(Adr);
  NivDebug:=AncDebug;
end;

procedure TFormDebug.Button2Click(Sender: TObject);
var Adr,erreur,ancdebug : integer ;
begin
  Val(EditSigSuiv.Text,Adr,erreur); if erreur<>0 then exit;
  ancdebug:=NivDebug;
  NivDebug:=3;
  Cond_Carre(Adr);
  carre_signal(adr);
  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 then
  begin
    Event_Detecteur(det,false,'');
  end;
end;
  

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

procedure TFormDebug.ButtonRazToutClick(Sender: TObject);
begin
  Raz_tout;
end;

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

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

end.