unit AVR_ICP;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DevicesFrame, ImgList, ComCtrls, StdCtrls, Mask, ToolEdit, ComboDigEdit,
  ToolWin, ExtCtrls, Grids, StrUtils, RUtilites, SendThread, CommInt, Math, CreateMenu, HexGrid;



type
  TVerifyStruct = record
    b:integer;
    m:word;
  end;


  TfrmAtmel_AVR_ICP = class(TfrmDevice)
    procedure tbReadClick(Sender: TObject);
    procedure tbVerifyClick(Sender: TObject);
    procedure tbWriteClick(Sender: TObject);
    procedure tbEraseClick(Sender: TObject);
  private
    FPinTX:boolean;

    { Private declarations }
    function  Get_Pin_MOSI:Integer;
    procedure Set_Pin_MOSI(b:integer);
    function  Get_Pin_MISO:Integer;
    procedure Set_Pin_MISO(b:integer);
    function  Get_Pin_SCK:Integer;
    procedure Set_Pin_SCK(b:integer);
    function  Get_Pin_RST:Integer;
    procedure Set_Pin_RST(b:integer);
    function  CollectNodesData(strID:string):TVerifyStruct;
  protected
    //Процедуры передаваемые на выполнение потоку SendThread
    function  Tr_ResetChip:boolean;
    function  Tr_SendInstruction(b1,b2,b3,b4:byte):word;
    procedure Tr_ReadChipMemoryToGrid(ArIndx:integer;Grid:THexGrid;cmd:integer);
    Procedure Tr_ProgramChipFromGrid(ArIndx:integer;Grid:THexGrid;cmd:integer);
    procedure Tr_ReadProcess;
    procedure Tr_WriteProcess;
    procedure Tr_EraseProcess;

  public
    { Public declarations }
    class procedure CreateInPlace(Owner:TWinControl;ChipName:String;var aCommPort:TComm);override;
    constructor Create(AOwner: TComponent); override;

    property Pin_MOSI:  integer read Get_Pin_MOSI write Set_Pin_MOSI;
    property Pin_MISO: integer read Get_Pin_MISO write Set_Pin_MISO;
    property Pin_SCK:  integer read Get_Pin_SCK write Set_Pin_SCK;
    property Pin_RST:  integer read Get_Pin_RST write Set_Pin_RST;

  end;

var
  frmAtmel_AVR_ICP: TfrmAtmel_AVR_ICP;

implementation

uses MainForm, InProgress, ErrorRep;

{$R *.DFM}


class procedure TfrmAtmel_AVR_ICP.CreateInPlace(Owner:TWinControl;ChipName:String;var aCommPort:TComm);
var frm:TfrmAtmel_AVR_ICP;
    SectName:string;
begin
  frm:=Create(Owner);
  SectName:='Chip '+ChipName;
  frm.lblDeviceName.Caption:=MemIniFile.ReadString(sectName,'ItemCaption','');
  frm.Parent:=Owner;
  frm.Align:=alClient;
  frm.Visible:=true;
  frm.CommPort:=aCommPort;
  //  Заполнение области Areas

  frm.FillAreaAndParams(SectName);
  if not frm.CommPort.Enabled then frm.CommPort.Open;

  frm.Pin_RST:=0;
  frm.Pin_MOSI:=0;
  frm.Pin_SCK:=0;


end;


constructor TfrmAtmel_AVR_ICP.Create(AOwner: TComponent);
begin
  inherited;
  InitRequired:=false;
  frmMain.LoFirstOrder:=true;
end;


function TfrmAtmel_AVR_ICP.Get_Pin_MISO:integer;
const bi:array [boolean] of integer = (0,1);
begin
  Get_Pin_MISO:= bi[CommPort.CTS];
end;

procedure TfrmAtmel_AVR_ICP.Set_Pin_MISO(b:integer);
begin
//
end;

function TfrmAtmel_AVR_ICP.Get_Pin_MOSI:integer;
begin
  Get_Pin_MOSI:= 0;
end;


procedure TfrmAtmel_AVR_ICP.Set_Pin_MOSI(b:integer);
const ib:array[0..1] of boolean = (false, true);
begin
  CommPort.SetDTRState(ib[b]);
end;


function TfrmAtmel_AVR_ICP.Get_Pin_SCK:integer;
const bi:array [boolean] of integer = (0,1);
begin
  Get_Pin_SCK:= bi[not CommPort.DSR];
end;

procedure TfrmAtmel_AVR_ICP.Set_Pin_SCK(b:integer);
const ib:array[0..1] of boolean = (false, true);
begin
  CommPort.SetRTSState(ib[b]);
end;


function TfrmAtmel_AVR_ICP.Get_Pin_RST:integer;
const bi:array [boolean] of integer = (0,1);
begin
  Get_Pin_RST:= bi[FPinTX];
end;

procedure TfrmAtmel_AVR_ICP.Set_Pin_RST(b:integer);
const ib:array[0..1] of boolean = (false, true);

begin
  CommPort.SetBREAKState(not ib[b]);
  FPinTX:=ib[b];
end;

procedure TfrmAtmel_AVR_ICP.tbReadClick(Sender: TObject);
begin
  FVerify:=false;
  self.FProcessProc:=Tr_ReadProcess;
  inherited;
end;

procedure TfrmAtmel_AVR_ICP.tbVerifyClick(Sender: TObject);
begin
  FVerify:=true;
  StrList_ErrorsRep.Clear;
  self.FProcessProc:=Tr_ReadProcess;
  inherited;
  if StrList_ErrorsRep.Count<>0 then
    with TfrmErrorRep.Create(Self) do
    begin
      LstBxErrorRep.Clear;
      LstBxErrorRep.Items.Assign(StrList_ErrorsRep);
      ShowModal;
    end;
end;

procedure TfrmAtmel_AVR_ICP.tbWriteClick(Sender: TObject);
begin
  self.FProcessProc:=Tr_WriteProcess;
  inherited;
end;

procedure TfrmAtmel_AVR_ICP.tbEraseClick(Sender: TObject);
begin
  self.FProcessProc:=Tr_EraseProcess;
  inherited;
end;


{
.................................................................

Процедуры передаваемые на выполнение потоку SendThread

.................................................................
}

function  TfrmAtmel_AVR_ICP.Tr_ResetChip:boolean;
var i:integer;
begin
  Pin_MOSI:=0;
  Pin_SCK:=0;
  Pin_RST:=1;
  sleep(5);
  Pin_RST:=0;
  sleep(20);
  // Инструкция разрешения программирования
  for i:=1 to 32 do
  begin
    if (Tr_SendInstruction($AC,$53,0,0) shr 8)=$53 then
    begin
      Tr_ResetChip:=true;
      exit;
    end;
    Pin_SCK:=1;
    Pin_SCK:=0;

  end;
//  Tr_ResetChip:=false;
  Raise Exception.Create(strIsNotAnswerFromDev);
end;


function TfrmAtmel_AVR_ICP.Tr_SendInstruction(b1,b2,b3,b4:byte):word;
var wrd:word;
    i:integer;
begin
  wrd:=0;
  for i:=7 downto 0 do
  begin
    Pin_MOSI:=(b1 shr i) and 1;
    Pin_SCK:=1;
    Pin_SCK:=0;
  end;
  for i:=7 downto 0 do
  begin
    Pin_MOSI:=(b2 shr i) and 1;
    Pin_SCK:=1;
    Pin_SCK:=0;
  end;
  for i:=7 downto 0 do
  begin
    Pin_MOSI:=(b3 shr i) and 1;
    wrd:=(wrd shl 1) or Pin_MISO;
    Pin_SCK:=1;
    Pin_SCK:=0;
  end;
  for i:=7 downto 0 do
  begin
    Pin_MOSI:=(b4 shr i) and 1;
    wrd:=(wrd shl 1) or Pin_MISO;
    Pin_SCK:=1;
    Pin_SCK:=0;
  end;
  Tr_SendInstruction:=wrd;

end;

procedure TfrmAtmel_AVR_ICP.Tr_ReadChipMemoryToGrid(ArIndx:integer; // индекс области программирования
                                Grid:THexGrid;                    // текущая сетка данных
                                cmd:integer);                     // команда
var
  firstAddr,lastAddr:Word;
//  InBuf:TThreadBuf;
  indx:Longint;
//  bufStr:string;
  k:Cardinal;
  DataWord:DWORD;
  ActualBitN:Integer;
  wrd:word;
  errcnt:integer;
begin
  with FSendThread do
  begin
    Synchronize(frmInProgress.InitGauge);
    firstAddr:=AreasData[ArIndx].DataArr[0];
    lastAddr:=AreasData[ArIndx].DataArr[1];
    ActualBitN:=AreasData[ArIndx].DataArr[2];
    FDataMask:=GetDataMask(ActualBitN);
    k:= (lastAddr-firstAddr+1);  //  Количество читаемых слов
    errcnt:=0;
    for indx:=0 to k-1 do
    begin
      if  Terminated then abort;
      if  ActualBitN>8 then
      begin
        DataWord:=Tr_SendInstruction(byte(cmd or $08),Hi(indx),Lo(indx),0) and $FF;
        DataWord:=(DataWord shl 8) or (Tr_SendInstruction(byte(cmd),Hi(indx),Lo(indx),0) and $FF);
        if FVerify then
        begin
          wrd:=Grid.AData[indx*2+1] or  (Grid.Adata[indx*2] shl 8);
          if DataWord<>wrd then
          begin
            if errcnt=10 then StrList_ErrorsRep.Add('More errors ...');
            if errcnt<10 then
            begin
              StrList_ErrorsRep.Add(AreasData[ArIndx].strCapt+'   '+format('Addres: %4.4x  Source: %4.4x <> Chip: %4.4x',[indx,wrd,DataWord]));
            end;
            Inc(errcnt);
          end;
        end
        else
        begin
          Grid.AData[indx*2+1]:=DataWord and $FF;
          Grid.Adata[indx*2]:= DataWord shr 8;
        end;
      end
      else
      begin
        DataWord:=Tr_SendInstruction(byte(cmd),Hi(indx),Lo(indx),0) and $FF;
        if FVerify then
        begin
          wrd:=Grid.AData[indx];
          if (DataWord and $FF)<>wrd then
          begin
            if errcnt=10 then StrList_ErrorsRep.Add('More errors ...');
            if errcnt<10 then
            begin
              StrList_ErrorsRep.Add(AreasData[ArIndx].strCapt+'   '+format('Addres: %4.4x  Source: %2.2x <> Chip: %2.2x',[indx,byte(wrd),byte(DataWord)]));
            end;
            Inc(errcnt);
          end;
        end
        else
        begin
          Grid.AData[indx]:=DataWord and $FF;
        end;
      end;
      frmInProgress.ProgrPos:=Round(100*indx/k);
      Synchronize(frmInProgress.UpdateGauge);
    end;
  end;
end;



procedure TfrmAtmel_AVR_ICP.Tr_ReadProcess;
var ArIndx:integer;

  procedure ReadBITS(stID:string);
  var i,j,b:integer;
      st:string;
      vs:TVerifyStruct;
  begin
    b:=Tr_SendInstruction($58,0,0,0) and $FF;

    if FVerify then
    begin
      vs:=CollectNodesData(stID);
      if (b and vs.m)<>(vs.b and vs.m) then
        StrList_ErrorsRep.Add(stID+' '+format('  Source: %4.4x <> Chip: %4.4x',[vs.b and vs.m,b and vs.m]));
    end
    else
      for i:=0 to HIGH(NodesData) do
        if NodesData[i].strAreaID=stID then
        begin
          // Обработка соответствующего узла
          with trvParameters.Items[i] do
          begin
            if not HasChildren then break;
            // перебор субузлов заданного узла
            for j:=0 to count-1 do
            begin
              st:=NodesData[Item[j].AbsoluteIndex].strMask ;
              if CompareWithMask(b,st) then
                SelectSubNode(trvParameters.Items[i],trvParameters.Items[i].Item[j]);
            end;
          end; {with }
        end;
  end;

  procedure ReadID;
  var st:string;
      i:integer;
  begin
    st:='';
    for i:=0 to 2 do
      st:=st + Format('%2.2x ',[ Tr_SendInstruction($30,0,i,0) and $FF]);
    if FindNodeIndex('ID',i) then
    begin
      trvParameters.Items[i].Item[0].text:=st;
      SelectSubNode(trvParameters.Items[i],trvParameters.Items[i].Item[0]);
    end;

  end;

begin
  with FSendThread do
  begin
    try
      PurgePort;
      Tr_ResetChip;
      for ArIndx:=0 to lsvAreas.Items.Count-1 do
        If lsvAreas.Items[ArIndx].Checked then
        begin
          if AreasData[ArIndx].strID='CODE' then Tr_ReadChipMemoryToGrid(ArIndx,frmMain.CodeGrid,$20);
          if AreasData[ArIndx].strID='EEPROM' then Tr_ReadChipMemoryToGrid(ArIndx,frmMain.EEPROMGrid,$A0);
          if AreasData[ArIndx].strID='LOCKBITS' then ReadBITS('LOCKBITS');
          if AreasData[ArIndx].strID='FUSES' then ReadBITS('FUSES');
        end;
        ReadID;
    finally
      Pin_RST:=0;
      Pin_MOSI:=0;
      Pin_SCK:=0;

      // Закрыть окно InProgress
      PostMessage(frmInProgress.Handle,wm_ThreadDoneErrMsg,0,0);
    end;
  end; {with FSendThread}
end;

Procedure TfrmAtmel_AVR_ICP.Tr_ProgramChipFromGrid(ArIndx:integer;
                                             Grid:THexGrid;
                                             cmd:integer);
var
  firstAddr,lastAddr:Word;
  k:Cardinal;
  indx:Longint;
  ActualBitN:Integer;
  b:byte;
begin
  with FSendThread do
  begin
    Synchronize(frmInProgress.InitGauge);
    ActualBitN:=AreasData[ArIndx].DataArr[2];
    // Перевести в исчисление в байтах
    firstAddr:=AreasData[ArIndx].DataArr[0];
    lastAddr:=(AreasData[ArIndx].DataArr[1]+1)-1;

    FDataMask:=GetDataMask(ActualBitN);

    k:= (lastAddr-firstAddr+1);
    for indx:=0 to k-1 do
    begin
      if  Terminated then abort;
      if  ActualBitN>8 then
      begin
        b:=Grid.Adata[indx*2];
        Tr_SendInstruction(byte(cmd) or $08,Hi(indx),Lo(indx),b);
        sleep(7);

        b:=Grid.Adata[indx*2+1];
        Tr_SendInstruction(byte(cmd),Hi(indx),Lo(indx),b);
        sleep(7);
      end
      else
      begin
        Tr_SendInstruction(byte(cmd),Hi(indx),Lo(indx),Grid.Adata[indx]);
        sleep(7);
      end;


      frmInProgress.ProgrPos:=Round(100*indx/k);
      Synchronize(frmInProgress.UpdateGauge);

    end;
  end;
end;

function TfrmAtmel_AVR_ICP.CollectNodesData(strID:string):TVerifyStruct;
var b:word;
    i:integer;
    strMask:string;
    vmask:word;
begin
  b:=0;
  vmask:=0;
  // Поиск всех установок связанных с
  // данной областью

  for i:=0 to HIGH(NodesData) do
    if NodesData[i].strAreaID=strID then
    begin
      // Обработка соответствующего узла
      with trvParameters.Items[i] do
      begin
        if not HasChildren then break;
        strMask:=NodesData[NodesData[i].intSelSubIt].strMask ;
        b:=SetByMask(b,strMask);
        vmask:=SetVerMaskByMask(vmask,strMask);
      end; {with }
    end;
  CollectNodesData.b:=b;
  CollectNodesData.m:=vmask;
end;


procedure TfrmAtmel_AVR_ICP.Tr_WriteProcess;
var ArIndx:integer;
//    DataBuf:array[0..127] of byte;


  procedure WriteBITS(stID:string);
  var b,i:integer;
      strMask:string;
  begin
    b:=0;
    // Поиск всех установок связанных с
    // данной областью

    for i:=0 to HIGH(NodesData) do
      if NodesData[i].strAreaID=stID then
      begin
        // Обработка соответствующего узла
        with trvParameters.Items[i] do
        begin
          if not HasChildren then break;
          strMask:=NodesData[NodesData[i].intSelSubIt].strMask2 ;
          b:=SetByMask(b,strMask);
        end; {with }
      end;
   Tr_SendInstruction($AC,b,0,0);
  end;



begin
  with FSendThread do
  begin
    try
      PurgePort;
      Tr_ResetChip;
      for ArIndx:=0 to lsvAreas.Items.Count-1 do
        If lsvAreas.Items[ArIndx].Checked then
        begin
          if AreasData[ArIndx].strID='CODE' then
            Tr_ProgramChipFromGrid(ArIndx,frmMain.CodeGrid,$40);
          if AreasData[ArIndx].strID='EEPROM' then
            Tr_ProgramChipFromGrid(ArIndx,frmMain.EEPROMGrid,$C0);
          if AreasData[ArIndx].strID='LOCKBITS' then
            WriteBITS('LOCKBITS');
          if AreasData[ArIndx].strID='FUSES' then
            WriteBITS('FUSES');
        end;
    finally
      Pin_RST:=0;
      Pin_MOSI:=0;
      Pin_SCK:=0;

      // Закрыть окно InProgress
      PostMessage(frmInProgress.Handle,wm_ThreadDoneErrMsg,0,0);
    end;
  end; {with FSendThread}
end;

procedure TfrmAtmel_AVR_ICP.Tr_EraseProcess;
begin
  with FSendThread do
  begin
    try
      PurgePort;
      Tr_ResetChip;
      Tr_SendInstruction($AC,$80,0,0);
      sleep(20);
    finally
      Pin_RST:=0;
      Pin_MOSI:=0;
      Pin_SCK:=0;

      // Закрыть окно InProgress
      PostMessage(frmInProgress.Handle,wm_ThreadDoneErrMsg,0,0);
    end;
  end; {with FSendThread}
end;



initialization
   SetLength(ConstructorsList, Length(ConstructorsList)+1);
   ConstructorsList[High(ConstructorsList)].name:='TfrmATMEL_AVR_ICP';
   ConstructorsList[High(ConstructorsList)].ClassName:=TfrmATMEL_AVR_ICP;
end.
