(*
*******************************************************************************
*         Copyright (C) SofCon 2002 All Rights Reserved                       *
*******************************************************************************
*
*    project:     priklad prace s dvemi archivy
*                 archivy - kruhovy bufer bez modifikace a s modifikaci
*                           vcetne podpory grafu
*
*    title:       Archive2.pas
*
*******************************************************************************
*
*    description: priklad prace s dvemi archivy
*                 archivy - kruhovy bufer bez modifikace a s modifikaci
*                           s podporou zobrazeni grafu
*		  ve verzi pro PC neni uvolnovana pamet archivu
*			a pamet jednotlivych objektu deskriptoru
*
*    version:     1.05
*    language:    Borland Pascal
*
*    author:      Hvozdovic
*    history:     date      sign   remark
*                 8.02      hv     zacatek vyvoje
*                11.02      hv     prvni release
*                12.02      hv     zruseni odkazu na ChnPrt, ChnSofs2
*                 1.03      hv     pridan priznak af_InitArchive do priznaku
*                                  archivu
*				   pridano osetreni novych chyb archivu
*                 3.03      bi     nova hodnota retezce controlleridstr - jmena stored archivu
*                12.03      hv     doplneni poznamky o reinicializi archivu
*****************************************************************************
*)
{$I sets.inc}

unit Archive2;
interface
uses
   Objects            { objekty }
  ,ChnVirt            { virtualni kanal }
  ,ChnSofT            { definice typu pro protokol SofCon }
  ,Xtking_1           { definice typu a konstant pro praci s vizualizaci }
  ,Xtking_2           { definice typu a konstant pro prenos archivu
                        s rozsirenymi deskriptory - podpora grafu }
  ,AppDesc            { jednotka definujici kompletni rozlozeni pameti
                        v aplikaci LOADER, pouziva xDesc.
                        Dale v teto jednotce mohou byt aplikacne zavisle
                        struktury a konstanty }
  ,ATypes             { definice typu a konstant pro praci s archivy }
  ,AVirt              { virtualni predek vsech archivu pro cteni a zapis }
  ,ChAVirt            { objekt archivu podporujiciho prenos dat po
                        komunikacnim kanalu }
  ,ChADscr            { objekt archivu podporujiciho prenos dat
                        vcetne jeho popisu pomoci deskriptoru }
  ,ChATypes           { definice typu a konstant por praci s archivy
                        podporujicich prenos dat po komunikacnim kanalu }
  ,ChAEDscr           { objekt archivu podporujiciho prenos archivu
                        s rozsirenymi deskriptory - podpora kresleni grafu }
  ,NumToStr           { prace s retezci }
  ,WTArch;            { objekt s podporou prace s archivy }


type
  { vyctovy typ popisujici banky archivu }
  tArchiveEnum =
  (
    arch_Graf1
  );

  { objekt pracujici s archivy  }
  PArchive2 = ^TArchive2;
  TArchive2 = object(TWinTickArchive)
    { pole popisovacu archivu s podporou prenosu archivu }
    m_pArchiveArray : array [tArchiveEnum] of PChArchiveVirt;

    constructor Init;
    destructor Done; virtual;


    function  fnGetArchiveCnt:Byte; virtual;
    function  fnGetExDscrCnt:Byte; virtual;

    procedure fnAbort;virtual;
    function  fnClose:Boolean; virtual;
    procedure fnGetListOpen(var ArchListInfo:TArchListInfo); virtual;
    procedure fnGetListItem(var ArchListItem:TArchDataHeader); virtual;
    procedure fnGetListExItem(var ArchListExItem:TArchDataExHeader); virtual;
    procedure fnGetState(var ArchiveRecState:TRecArchiveState); virtual;
    procedure fnOpenArchive(BegRecTime, EndRecTime:LongInt; var Prvni, Posledni, Length: LongInt); virtual;
    function  fnReadArchive(pData:Pointer; EndTime:LongInt; var Len:Word):Boolean; virtual;
    function  fnClearArchive:Boolean; virtual;
  end;


{ procedura pro zobrazeni stavu - zobrazi se stiskem klavesy "1" }
procedure ShowState;

{ funkce zapisujici do bank archivu }
procedure WriteToArchive;


implementation
uses
   Strings             { retezce zakoncene nulou }
  ,Kernel;             { jadro os ReTOS }


constructor TArchive2.Init;
var
  pArchive:PArchiveVirt;
  pGraf1Dscr, pGraf2Dscr:pDscr;
  ExDscrData:tExDscrData;
  pExDscrObj1,pExDscrObj2,pExDscrObj3:pExDscr;
  ArchiveDesc:TArchiveDesc;
  DscrChArchive:TChArchiveDesc;
  ptr:tArchiveEnum;
begin
  inherited Init;

  {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  { vytvoreni popisovacu archivu #1 }
  New(pGraf1Dscr, Init(
     'Time|Temp|Current|Out0[8-15]|Out0[0-7]',  { popisky/zahlavi polozek zaznamu }
     '',                                        { format % strings polozek zaznamu like CSV }
     sizeof(tGraf1Record)                         { velikost zaznamu }
     ));
  { datum a cas ulozeni zaznamu }
  if not pGraf1Dscr^.AddType(DscrMsk_DosDaTi, 0) then RunError(255);
  { teplota }
  if not pGraf1Dscr^.AddType(DscrMsk_Word, 0) then RunError(255);
  { proud }
  if not pGraf1Dscr^.AddType(DscrMsk_Word, 0) then RunError(255);
  { vystupy }
  if not pGraf1Dscr^.AddType(DscrMsk_ByteBits, 0) then RunError(255);
  if not pGraf1Dscr^.AddType(DscrMsk_ByteBits, 0) then RunError(255);

  { kontrola celkove delky zaznamu - predeslo kontroly lze vynechat }
  if pGraf1Dscr^.GetDscrMaskLen <> sizeof(tGraf1Record) then RunError(255);

  { popis os }
  New(pExDscrObj1, Init(
     exfat_TExFieldAttrChartSeries,     { typ popisovace grafu }
     5                                  { pocet polozek popisovace grafu }
     ));
  { polozka datum a cas -> tato polozka nelze zobrazit,
    protoze se vzdy pouzije pro urceni X osy }
  with ExDscrData.ChartSeries do
  begin
    TeeSeriesAttr:=teeseries_msk_SeriesType_None;
    ScanSemAttr  :=scansem_msk_Type_Default;
  end;
  if not pExDscrObj1^.AddExDscrItem(ExDscrData) then RunError(255);

  { teplota }
  with ExDscrData.ChartSeries do
  begin
    TeeSeriesAttr:=teeseries_msk_SeriesAxisX_DaTi or    { X - datum a cas }
                   teeseries_msk_SeriesAxisY_Left or    { Y - leva osa }
                   teeseries_msk_SeriesType_Line;       { spojovat carou }
    ScanSemAttr  :=scansem_msk_Type_Default;
  end;
  if not pExDscrObj1^.AddExDscrItem(ExDscrData) then RunError(255);

  { proud }
  with ExDscrData.ChartSeries do
  begin
    TeeSeriesAttr:=teeseries_msk_SeriesAxisX_DaTi or    { X - datum a cas }
                   teeseries_msk_SeriesAxisY_Right or   { Y - prava osa }
                   teeseries_msk_SeriesType_Line;       { spojovat carou }
    ScanSemAttr  :=scansem_msk_Type_Default;
  end;
  if not pExDscrObj1^.AddExDscrItem(ExDscrData) then RunError(255);

  { proud }
  with ExDscrData.ChartSeries do
  begin
    TeeSeriesAttr:=teeseries_msk_SeriesAxisX_DaTi or    { X - datum a cas }
                   teeseries_msk_SeriesAxisY_Right or   { Y - prava osa }
                   teeseries_msk_SeriesType_Line;       { spojovat carou }
    ScanSemAttr  :=scansem_msk_Type_Default;
  end;
  if not pExDscrObj1^.AddExDscrItem(ExDscrData) then RunError(255);

  { Out0[8-15] }
  { Out0[0-7] }
  { lze pouzit predchozi definici }
  if not pExDscrObj1^.AddExDscrItem(ExDscrData) then RunError(255);

  { popis jednotek }
  New(pExDscrObj2, Init(
     exfat_TExFieldAttrChartPhysicalUnits,  { typ popisovace grafu }
     1                                      { pocet polozek popisovace grafu
                                              -> lze pouze jednu polozku }
     ));

  with ExDscrData.ChartPhysicalUnits do
  begin
    LeftAxisLabel:='Teplota';               { popiska pro levou osu }
    RightAxisLabel:='Proud/Vystupy';        { popiska pro pravou osu }
    PhysicalUnitStrings:='|C|A';            { jednotky pro jendotlive sloupce }
  end;
  if not pExDscrObj2^.AddExDscrItem(ExDscrData) then RunError(255);

  { popis bitovych poli }
  New(pExDscrObj3, Init(
     exfat_TExFieldAttrChartBitNames,       { typ popisovace grafu }
     2                                      { pocet polozek popisovace grafu }
     ));
  with ExDscrData.ChartBitNames do
  begin
    FieldName:='Out0[8-15]';                    { musi odpovidat jmeno sloupce
                                                  a tato polozka musi byt typu
                                                  DscrMsk_ByteBits }
    BitNameStrings:='B0|B1|B2|B3|B4|B5|B6|B7';  { popis jednotlivych bitu }
  end;
  if not pExDscrObj3^.AddExDscrItem(ExDscrData) then RunError(255);

  with ExDscrData.ChartBitNames do
  begin
    FieldName:='Out0[0-7]';                     { musi odpovidat jmeno sloupce
                                                  a tato polozka musi byt typu
                                                  DscrMsk_ByteBits }
    BitNameStrings:='B0|B1|B2|B3|B4|B5|B6|B7';  { popis jednotlivych bitu }
  end;
  if not pExDscrObj3^.AddExDscrItem(ExDscrData) then RunError(255);

  { definice vlastniho archivu }
  with ArchiveDesc do
  begin
    wArchiveNo:=Word(arch_Graf1);
    laBaseAddr:=laGraf1;
    wRecordSize:=sizeof(tGraf1Record);
    dwMaxRecordCnt:=cGraf1MaxRecord;
{$ifNdef ARCHIVE_INIT}
    SetAFlags:=[af_InitArchive];
{$else}
    { pouze v pripade zamerneho poskozeni archivu }
    SetAFlags:=[af_InitArchive, af_NotCheckAStruct];
{$endif}
    pAStruct:=gpGraf1AStruct;
  end;
  pArchive:=New(pArchiveVirt, Init(nil, ArchiveDesc));
  {nedoslo pri inicializaci archivu k chybe}
  case pArchive^.GetLastError of
    ae_NoError: ;{vse Ok}
    ae_AStructCrc: ;{popisovac archivu je poskozen->mela by nasledovat
                         inicializace archivu}
    ae_BaseAddr,   {datova cast archivu byla posunuta - hrozi poskozeni archivu }
    ae_IncompParams: {nekompatibilni parametry - hrozi poskozeni archivu }
      begin
(*
        v realne aplikaci by melo byt toto osetreni
        { zavreni znovu otevreni  bez kontrol }
        Dispose(pArchive, Done);
        ArchiveDesc.SetAFlags:=[af_NotCheckAStruct];
        pArchive:=New(pArchiveVirt, Init(nil, ArchiveDesc));
        if pArchive^.GetLastError<>ae_NoError then RunError(255);
*)
        { v pripade chyby -> ARCHIVE_INIT }
        writeln('LastError: ', Byte(pArchive^.GetLastError));
        RunError(255);
      end;
  else
    {ae_InvalidParams}
    { v pripade chyby -> ARCHIVE_INIT }
    writeln('LastError: ', Byte(pArchive^.GetLastError));
    RunError(255); { neplatne parametry konstruktoru }
  end;

  with DscrChArchive do
  begin
    SecDiff:=cMinSecDiff;
    pDscrObj:=pGraf1Dscr;
    strName:='Graf';
    wExDscrCnt:=3;
  end;
  m_pArchiveArray[arch_Graf1]:=New(pExDscrChArchive, Init(pArchive,  DscrChArchive));
  if m_pArchiveArray[arch_Graf1]^.GetLastError<>ae_NoError then
  begin
    writeln('LastError: ', Byte(m_pArchiveArray[arch_Graf1]^.GetLastError));
    RunError(255);
  end;

  if not m_pArchiveArray[arch_Graf1]^.AddExDscr(pExDscrObj1) then RunError(255);
  if not m_pArchiveArray[arch_Graf1]^.AddExDscr(pExDscrObj2) then RunError(255);
  if not m_pArchiveArray[arch_Graf1]^.AddExDscr(pExDscrObj3) then RunError(255);

  if m_pArchiveArray[arch_Graf1]^.GetExDscrCnt <> 3 then RunError(255);
end;

destructor TArchive2.Done;
begin
  inherited Done;
end;


function  TArchive2.fnGetArchiveCnt:Byte;
begin
  fnGetArchiveCnt:=Byte(high(tArchiveEnum))+1;
end;

function  TArchive2.fnGetExDscrCnt:Byte;
begin
  fnGetExDscrCnt:=m_pArchiveArray[tArchiveEnum(m_bArchive)]^.GetExDscrCnt;
end;

procedure TArchive2.fnAbort;
begin
end;

function  TArchive2.fnClose:Boolean;
begin
  fnClose:=m_pArchiveArray[tArchiveEnum(m_bArchive)]^.CloseArchive;
end;

procedure TArchive2.fnGetListOpen(var ArchListInfo:TArchListInfo);
begin
  with ArchListInfo do
  begin
    {Serial Number ridiciho systemu - jedinecne cislo HW }
    ControllerSN   := $01;
    {Identifikacni string ridiciho systemu }
    ControllerIDStr:= 'A2: '+strAppName+'_Arch1';
    {celkovy pocet banku archivu - max. 255}
    ArchListCount  := fnGetArchiveCnt;
  end;
end;

procedure TArchive2.fnGetListItem(var ArchListItem:TArchDataHeader);
begin
  pDscrChArchive(m_pArchiveArray[tArchiveEnum(m_bArchive)])^.GetHeader(ArchListItem);
  ArchListItem.NextHeaderFl:=tArchiveEnum(m_bArchive)<>High(tArchiveEnum);
end;

procedure TArchive2.fnGetListExItem(var ArchListExItem :TArchDataExHeader);
begin
  pDscrChArchive(m_pArchiveArray[tArchiveEnum(m_bArchive)])^.GetExHeader(m_bExItem, ArchListExItem);
end;

procedure TArchive2.fnGetState(var ArchiveRecState:TRecArchiveState);
begin
  pDscrChArchive(m_pArchiveArray[tArchiveEnum(m_bArchive)])^.GetState(ArchiveRecState);
end;

procedure TArchive2.fnOpenArchive(BegRecTime, EndRecTime:LongInt;
                                  var Prvni, Posledni, Length: LongInt);
begin
  m_pArchiveArray[tArchiveEnum(m_bArchive)]^.OpenArchive(BegRecTime, EndRecTime, Prvni, Posledni, Length);
end;

function  TArchive2.fnReadArchive(pData:Pointer; EndTime:LongInt; var Len:Word):Boolean;
begin
  fnReadArchive:=m_pArchiveArray[tArchiveEnum(m_bArchive)]^.Read(pData, EndTime, Len);
end;

function  TArchive2.fnClearArchive:Boolean;
begin
  fnClearArchive:=m_pArchiveArray[tArchiveEnum(m_bArchive)]^.InitArchive;
end;

{ procedura pro zobrazeni stavu - zobrazi se stiskem klavesy "1" }
procedure ShowState;
begin
end;

{ funkce zapisujici do bank archivu }
procedure WriteToArchive;
var
  pGraf1:pArchiveVirt;
  item:tGraf1Record;
  uwTemp:Word;
  ArchiveDesc:tArchiveDesc;

begin
  with ArchiveDesc do
  begin
    wArchiveNo:=Word(arch_Graf1);
    laBaseAddr:=laGraf1;
    wRecordSize:=sizeof(tGraf1Record);
    dwMaxRecordCnt:=cGraf1MaxRecord;
    SetAFlags:=[af_InitArchive];
    pAStruct:=gpGraf1AStruct;
  end;
  pGraf1:=New(pArchiveVirt, Init(nil, ArchiveDesc));
  {nedoslo pri inicializaci archivu k chybe}
  case pGraf1^.GetLastError of
    ae_NoError: ;{vse Ok}
    ae_AStructCrc: ;{popisovac archivu je poskozen->mela by nasledovat
                         inicializace archivu}
    ae_BaseAddr,   {datova cast archivu byla posunuta - hrozi poskozeni archivu }
    ae_IncompParams: {nekompatibilni parametry - hrozi poskozeni archivu }
      begin
(*
        v realne aplikaci by melo byt toto osetreni
        { zavreni znovu otevreni  bez kontrol }
        Dispose(pArchive, Done);
        ArchiveDesc.SetAFlags:=[af_NotCheckAStruct];
        pArchive:=New(pArchiveVirt, Init(nil, ArchiveDesc));
        if pArchive^.GetLastError<>ae_NoError then RunError(255);
*)
        { v pripade chyby -> ARCHIVE_INIT }
        writeln('LastError: ', Byte(pGraf1^.GetLastError));
        RunError(255);
      end;
  else
    {ae_InvalidParams}
    { v pripade chyby -> ARCHIVE_INIT }
    writeln('LastError: ', Byte(pGraf1^.GetLastError));
    RunError(255); { neplatne parametry konstruktoru }
  end;

  FillChar(item, 0, sizeof(item));

  uwTemp:=0;
  repeat
    with item do
    begin
      dwPackDate:=GetPackTime;
      wTemp:=uwTemp;
    end;

    if (uwTemp mod 3) = 0 then item.wCurrent:=uwTemp;
    if (uwTemp mod 5) = 0 then
    begin
     {$ifdef Deb_Crt}
      Writeln('Zapis do graf1: ', item.dwPackDate, ',', item.wTemp, ',',
                                  item.wCurrent, ',', item.wOutputs);
     {$endif}
      item.wOutputs:=uwTemp;
      if not pGraf1^.CheckWrite(@item) then RunError(255);
    end;

    Inc(uwTemp);

    Wait(5);
  until FALSE;

  Terminate;

end;

end.
