unit DebugFrm;
{
  (C) 2000 - 2001 Jindrich Jindrich, Pavel Pisa, PiKRON Ltd.

  Originators of the CHROMuLAN project:

  Jindrich Jindrich - http://www.jindrich.com
                      http://orgchem.natur.cuni.cz/Chromulan/
                      software developer, project coordinator
  Pavel Pisa        - http://cmp.felk.cvut.cz/~pisa
                      embeded software developer
  PiKRON Ltd.       - http://www.pikron.com
                      project initiator, sponsor, instrument developer

  The CHROMuLAN project is distributed under the GNU General Public Licence.
  See file COPYING for details.

  Originators reserve the right to use and publish sources
  under different conditions too. If third party contributors
  do not accept this condition, they can delete this statement
  and only GNU license will apply.
}

{$I define.pas}
{$IFNDEF DEBUG}??{$ENDIF}
interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls,
  UtlType, WinUtl, Msgu, {PortLog,}
  UlanType, UlanGlob, CommInt,
  Listu, ListType, BinHex, HiResTim, Beeper;

const
  LogStringLen = 66;
type
  TLogString = ShortString;

type
  TDebugForm = class(TForm)
    DebugMemo: TMemo;
    DebugPanel: TPanel;
    SuspendCheckBox: TCheckBox;
    PortLogCheckBox: TCheckBox;
    Timer1: TTimer;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PortLogCheckBoxMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    IsInReceive:boolean;
    IsInTimer:boolean;
    RcvBuf:array[0..RcvBufSize - 1] of char;
    dlogs,logs:TLogString;
    SFifo:TLst;
    ComPort: TComm;{does not belong to mainform, just pointer to
      active port of active spectrumform }
    dlog: text;
    isInLog: boolean;
    procedure ComPortReceive(Sender: TObject
      {$IFDEF WIN32}
      ;Count: integer
      {$ELSE}
      ;Count: Word
      {$ENDIF}
      );
  public
    { Public declarations }
    procedure Log(s:string);
    procedure PortLogStart;
    procedure PortLogStop;
  end;

var
  DebugForm: TDebugForm;

procedure DebugFormLog(s:string);
{v0.43 moved to exelogu}{/v0.43
procedure DebLog(s:string);}

implementation
{uses main;}
{$R *.DFM}

procedure DebugFormLog(s:string);
begin
  if DebugForm <> nil then
    DebugForm.Log(s);
end;

{v0.43}{/v0.43
procedure DebLog(s:string);
begin
  DebugFormLog(s);
end;}

procedure TDebugForm.Log(s:string);
var i:integer;
  const MaxDebugLines = 50;
begin
  if SuspendCheckBox.Checked then
    exit;
  if isInLog then
    exit;
  isInLog := true;
  try
    writeln(dlog, s);
    DebugMemo.Lines.Add(s);
    if DebugMemo.Lines.Count = MaxDebugLines then
    begin
      for i := 0 to (MaxDebugLines div 5) do begin
        DebugMemo.Lines.Delete(0);
        Application.ProcessMessages;
      end;
    end;
    Application.ProcessMessages;
  finally
    isInLog := false;
  end;
end;

procedure TDebugForm.FormDestroy(Sender: TObject);
begin
  DebugForm := nil;
  closefile(dlog);
end;

procedure TDebugForm.FormCreate(Sender: TObject);
var li:TListInfo;
begin
  ComPort := nil;
  DebugForm := Self;
  IsInReceive:= false;
  IsInTimer:= false;
  FillChar(li, sizeof(li),0);
  li.RecordSize := LogStringLen + 1;
  li.Capacity := 100;
  ListInit(ltRecords or ltAutoDestroy, @li, SFifo);
  logs:= '';
  assignfile(dlog, 'DEBUG.LOG');
  rewrite(dlog);
end;

procedure TDebugForm.PortLogStart;
begin
  if ComPort = nil then begin
    ShowMessage({#}'No port opened.', smError, 0);
    exit;
  end;
  {$IFDEF WIN32}
  {if MainForm.ComPort.Enabled then begin
    ShowMessage('Port in use', smError,0);
    exit;
  end;
  ComPort := MainForm.ComPort;}
  ComPort.DeviceName := CurPortName;{COM' + IntToStr(ComPortNumber);}
  ComPort.OnRxChar := ComPortReceive;
  ComPort.Open;
  {$ELSE}
  if {MainForm.}ComPort.Port <> tptNone then begin
    ShowMessage('Port in use', smError,0);
    exit;
  end;
  {ComPort := MainForm.ComPort;}
  ComPort.OnReceive := ComPortReceive;
  ComPort.Port := TPort(ComPortNumber);
  {$ENDIF}

  {PortLogInit;}
end;

procedure TDebugForm.PortLogStop;
label ex;
begin
  if ComPort = nil then
    exit;
  {$IFDEF WIN32}
  ComPort.Close;
  ComPort.OnRxChar := nil;
  {$ELSE}
  if ComPort.Port <> tptNone then begin
    ComPort.OnReceive := nil;
    ComPort.Port := tptNone;
  end;
  {$ENDIF}
  ComPort := nil;
{  PortLogDone;}
end;

procedure TDebugForm.ComPortReceive(Sender: TObject
      {$IFDEF WIN32}
      ;Count: integer
      {$ELSE}
      ;Count: Word
      {$ENDIF}
  );

var
  CommChar:Char;
  i:Word;
  b:word;

begin
  if IsInReceive then begin
    Log('ComReceive: Recursive call');
    exit;
  end;

  if Count = 0 then
    exit;
  try
    IsInReceive := true;
    repeat
      if Count <= sizeof(RcvBuf) then begin
        b := Count;
      end else begin
        b := sizeof(RcvBuf);
      end;
      dec(Count, b);
      ComPort.Read(RcvBuf, b);
      for i := 0 to b - 1 do begin
        CommChar := RcvBuf[i];
        {PortLogAddRecord(byte(ComPort.Port), 'r', byte(CommChar));}
        logs := logs + ByteToHex(byte(CommChar)) + ' ';
        if length(logs) >= LogStringLen then begin
          ListRecAdd(SFifo, logs);
          logs := '';
        end;
      end;
    until Count = 0;
  finally
    IsInReceive := false;
  end;
end;

procedure TDebugForm.PortLogCheckBoxMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if PortLogCheckBox.Checked then begin
    PortLogStart;
    {PortLogCheckBox.Checked := true;}
  end else begin
    PortLogStop;
    {PortLogCheckBox.Checked := false;}
  end;
end;

procedure TDebugForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
  ClassFree(SFifo);{FreeObject(@SFifo);}
end;

procedure TDebugForm.Timer1Timer(Sender: TObject);

begin
  if IsInTimer then
    exit;
  IsInTimer := true;
  try
    while ListRecGet(SFifo, dlogs) do begin
      Log(dlogs);
    end;
  finally
    IsInTimer := false;
  end;
end;

initialization
  DebugForm := nil;
end.
