unit u_main;

{  DISCLAIMER
This software is free to use, copy or distribute as a whole or in parts, as you like.
I, the author do not guarantee proper operation, suitability for any use,
  correctness of results, etc.....
I do not take any responsibility for misbehaviour of the software,
  including affecting the system on which it runs.
I can give some support regarding the operation of the program.
I cannot give any support for problems related to Free Pascal or Lazarus.
If you have such, visit the FPC and Lazarus forum(s).
This software was developed and tested on
  - WXP and W7 with FPC version 2.6.2 and Lazarus version 1.0.14.
  - Linux Mint with FPC version 2.6.4 and Lazarus version 1.4.2  

This software requires the packet Sdpo-Serial to be installed in the IDE.
                                                                          
January 2019 jan@breem.nl
}

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, ComCtrls,
  Dialogs, ExtCtrls, StdCtrls, SdpoSerial, StrUtils;

type
  TFrmMain = class(TForm)
    ButtClrClipsB: TButton;
    ButtClrClipsMT: TButton;
    ButtZeroBass: TButton;
    ButtStore: TButton;
    ButtMuteBas: TButton;
    ButtZeroMid: TButton;
    ButtMuteMid: TButton;
    CbxTalk: TCheckBox;
    CbxResetTPA: TCheckBox;
    Label1: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    Label9: TLabel;
    LblFault_B: TLabel;
    LblTpaInReset: TLabel;
    LblSuppliesOK: TLabel;
    LblOTW_MT: TLabel;
    LblFault_MT: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label16: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    LblOtw_B: TLabel;
    Lbl50: TLabel;
    Lbl12: TLabel;
    Lbl5: TLabel;
    Lblmin5: TLabel;
    LblMainsOK: TLabel;
    Serial: TSdpoSerial;
    TbxBas: TEdit;
    TbxClipsB: TEdit;
    TbxClipsMT: TEdit;
    TbxInMessageLength: TEdit;
    TbxMid: TEdit;
    TbxV50: TEdit;
    TbxV12: TEdit;
    TbxV5A: TEdit;
    TbxSerialPortName: TEdit;
    TbxV5D: TEdit;
	TbxOS: TEdit;
    TbxAdcRef: TEdit;
    TbxVMin5A: TEdit;
    TbxInMessage: TEdit;
    TbxOutCount: TEdit;
    TbxInCount: TEdit;
    TbxOutMessage: TEdit;
    Timer: TTimer;
    UDbas: TUpDown;
    UDmid: TUpDown;
    procedure ButtClrClipsBClick(Sender: TObject);
    procedure ButtClrClipsMTClick(Sender: TObject);
    procedure ButtMuteBasClick(Sender: TObject);
    procedure ButtMuteMidClick(Sender: TObject);
    procedure ButtStoreClick(Sender: TObject);
    procedure ButtZeroBassClick(Sender: TObject);
    procedure ButtZeroMidClick(Sender: TObject);
    procedure CbxTalkChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure UDbasClick(Sender: TObject; Button: TUDBtnType);
    procedure UDmidClick(Sender: TObject; Button: TUDBtnType);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  FrmMain: TFrmMain;

implementation
{$R *.lfm}
uses u_numstrings;
const
  VERSIONSTRING = '2019-01-22';
  INMESSAGESIZE = 13;
var
  InMessage, OutMessage, SerialPortName, SettingsFileName: shortstring;
  Status, Command, InCount, OutCount: byte;
  ChBas, ChMid, StoreBas, StoreMid: byte;
  MuteBas, MuteMid: boolean;
  ClipsB, ClipsMT: byte;
  V5D, V50, V12, V5A, VMin5A: real;

procedure DecodeInMessage;
var AdcRef: integer;
begin 
  with FrmMain do
  begin
    // Decompose message
    Status:= byte(InMessage[1]);
    AdcRef:= StrLittleToUnSignedInt(Midstr(InMessage,2,2)); // ADC value
    V50:= StrLittleToUnSignedInt(Midstr(InMessage,4,2));    // millivolts
    V12:= StrLittleToUnSignedInt(Midstr(InMessage,6,2));    // millivolts
    V5A:= StrLittleToUnSignedInt(Midstr(InMessage,8,2));    // millivolts
    Vmin5A:= StrLittleToSignedInt(Midstr(InMessage,10,2));  // millivolts
    ClipsB:= byte(InMessage[12]);
    ClipsMT:= byte(InMessage[13]);
    // Process supply voltages
    TbxAdcRef.text:= format('%3d',[AdcRef]);
    if AdcRef > 400 then  // prevent division by zero.
    V5D:= 2.5 * 1024.0 / AdcRef else V5D:= 0;
    TbxV50.text:= format('%4.1f',[V50 / 1000]);
    TbxV12.text:= format('%4.1f',[V12 / 1000]);
    TbxV5A.text:= format('%4.1f',[V5A / 1000]);
    TbxVMin5A.text:= format('%4.1f',[Vmin5A / 1000]);
    TbxV5D.text:= format('%4.1f',[V5D]);
    if(V50 < 42000) or (V50 > 55000) then Lbl50.Color:= clRed else Lbl50.Color:= clLime;
    if(V12 < 10000) or (V12 > 13000) then Lbl12.Color:= clRed else Lbl12.Color:= clLime;
    if(V5A < 4500) or (V5A > 5500) then Lbl5.Color:= clRed else Lbl5.Color:= clLime;
    if(Vmin5A < -5500) or (Vmin5A > -4500) then Lblmin5.Color:= clRed else Lblmin5.Color:= clLime;
    // Process Status byte
    if(Status and $01) = $01 then LblMainsOK.Color:= clRed else LblMainsOK.Color:= clLime;
    if(Status and $02) = $02 then LblSuppliesOK.Color:= clRed else LblSuppliesOK.Color:= clLime;
    if(Status and $04) = $04 then LblFault_B.Color:= clRed else LblFault_B.Color:= clLime;
    if(Status and $08) = $08 then LblFault_MT.Color:= clRed else LblFault_MT.Color:= clLime;
    if(Status and $10) = $10 then LblOtw_B.Color:= clRed else LblOtw_B.Color:= clLime;
    if(Status and $20) = $20 then LblOTW_MT.Color:= clRed else LblOTW_MT.Color:= clLime;
    if(Status and $40) = $40 then ;  // we cannot process spontaneous messages
    if(Status and $80) = $80 then LblTpaInReset.Color:= clRed else LblTpaInReset.Color:= clLime;
    // Others
    TbxClipsB.text:= format('%3d', [ClipsB]);
    TbxClipsMT.text:= format('%3d', [ClipsMT]);
  end;
end;

procedure PrepareOutMessage;
begin
  if FrmMain.CbxResetTPA.checked then Command += $80;
  OutMessage:= char(Command)+ char(ChBas) + char(ChMid);
  Command:= 0;
end;

// Convert PGA code to dB's.  see datasheet PGA2311
function PGAdB (code: byte): real;
begin
  PGAdB:= (code - 192) / 2;
end;

procedure TFrmMain.UDbasClick(Sender: TObject; Button: TUDBtnType);
begin
  ChBas:= UDbas.position;
  TbxBas.text:=  Format('%4.1f', [PGAdB(ChBas)]); 
end;

procedure TFrmMain.UDmidClick(Sender: TObject; Button: TUDBtnType);
begin
  ChMid:= UDMid.position;
  Tbxmid.text:= Format('%4.1f', [PGAdb(ChMid)]);
end;

procedure TFrmMain.ButtZeroBassClick(Sender: TObject);
begin
  UDbas.Position:=192;
  ChBas:= UDBas.position;
  Tbxbas.text:= Format('%4.1f', [PGAdB(ChBas)]);
end;

procedure TFrmMain.ButtZeroMidClick(Sender: TObject);
begin
  UDmid.Position:=192;
  ChMid := UDMid.position;
  Tbxmid.text :=  Format('%4.1f', [PGAdB(ChMid)]);
end;

procedure TFrmMain.ButtMuteBasClick(Sender: TObject);
begin
  if not MuteBas then
  begin
    StoreBas:= UDBas.Position;
    UDbas.Position:= 0;
  end
  else
    UDbas.Position:= StoreBas;
  MuteBas:= not MuteBas;
  ChBas:= UDBas.position;
  Tbxbas.text:= Format('%4.1f', [PGAdB(ChBas)]);
end;

procedure TFrmMain.ButtMuteMidClick(Sender: TObject);
begin
  if not MuteMid then
  begin
    StoreMid:= UDMid.Position;
    UDMid.Position:= 0;
  end
  else
    UDMid.Position:= StoreMid;
  MuteMid:= not MuteMid;
  ChMid := UDMid.position;
  Tbxmid.text:=  Format('%4.1f', [PGAdB(ChMid)]);
end;

procedure TFrmMain.ButtClrClipsBClick(Sender: TObject);
begin
  Command += $20;
end;

procedure TFrmMain.ButtClrClipsMTClick(Sender: TObject);
begin
  Command += $40;
end;

procedure TFrmMain.ButtStoreClick(Sender: TObject);
begin
  Command += $04;
end;

// This program is not able to receive spontaneous messages from FLT
procedure TFrmMain.TimerTimer(Sender: TObject);
var InMessageLength: integer;
begin
  InMessage:= Serial.ReadData;
  InMessageLength:= length(InMessage);
  TbxInMessage.text:= BytesView(InMessage,InMessageLength);
  if InMessageLength > 0 then
  begin
  	inc(InCount);
  	TbxInCount.text:= format('%3d',[InCount]);
  end;
  TbxInCount.text:= format('%3d',[InCount]);
  TbxInMessageLength.text:= format('%3d',[InMessageLength]);
  if InMessageLength = INMESSAGESIZE then DecodeInMessage;
  PrepareOutMessage;
  TbxOutMessage.Text:= BytesView(OutMessage, length(OutMessage));
  inc(OutCount);
  TbxOutCount.text:= format('%3d',[OutCount]);
  Serial.WriteData(OutMessage);
end;

procedure TFrmMain.CbxTalkChange(Sender: TObject);
begin
  if CbxTalk.Checked then
  begin
    Try
      Serial.close;
      SerialPortName:= TbxSerialPortName.text;
      Serial.Device:= SerialPortName;
      Serial.BaudRate:= br_19200;
  	  Serial.Open;
   	  Timer.enabled:= true;
    except
      on E: Exception do ShowMessage(E.message);
    end;
  end
  else
  begin
    Timer.enabled := false;
    Serial.Close;
  end;
end;

procedure WriteSettings;
var DataFile : text;
begin
  assign(DataFile, SettingsFileName);
  rewrite(DataFile);
  SerialPortName:= FrmMain.TbxSerialPortName.text;
  writeln(DataFile, SerialPortName);
  writeln(DataFile, ChBas);
  writeln(DataFile, ChMid);
  close(DataFile);
end;

procedure ReadSettings;
var DataFile : text;
p: TObject;
b: TUDBtnType;
begin
  if not FileExists(SettingsFileName) then exit;
  assign(DataFile, SettingsFileName);
  reset(DataFile);
  readln(DataFile, SerialPortName);
  readln(DataFile, ChBas);
  readln(DataFile, ChMid);
  close(DataFile);
  with FrmMain do
  begin
    UDBas.position:= ChBas; UDBasClick(p, b);
    UDMid.position:= ChMid; UDMidClick(p, b);
    TbxSerialPortName.text:= SerialPortName;
  end;
end;

procedure TFrmMain.FormDestroy(Sender: TObject);
begin
  WriteSettings;
end;

procedure TFrmMain.FormCreate(Sender: TObject);
var
  b: TUDBtnType;
  OSstring, ExeDir: shortstring;
begin
{$IFDEF Linux}
  OSstring:= 'Linux';
{$ENDIF}
{$IFDEF WINDOWS}
  OSstring:= 'Windows';
{$ENDIF}
// todo: MAC
  TbxOS.text:= OSstring;
  Caption:= 'TestTool FLT ' + VERSIONSTRING;
  ExeDir:= application.Location; // directory of executable
  SettingsFilename:= ExeDir + 'Settings.txt';
  ReadSettings;
  UDbasClick(Sender, b);
  UDMidClick(Sender, b);
end;

end.

