{
    This file is part of chepersy
    Copyright (c) 2004-2008 by Anton Rzheshevski (chebmaster@mail.ru),

    See the file COPYING.CPS, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}



{  Scenario format: <number of entries>, (<procedure>, <offset>, <tind | size>)}


  procedure CpsBuildsavingScenario(Cind: integer);
  var
    i, ii, sizeind: integer;
    lastisbinary: boolean;
    function AddToScenario(d: dword): integer; inline;
    begin
      SetLength(Scenario, Length(Scenario) + 1);
      Result:=High(Scenario);
      Scenario[Result]:=d;
    end;
  begin
    ii:=AddToScenario(0);
    lastisbinary:=No;
    For i:=0 to Fields[Cind].High do
      With Fields[Cind][i] do begin
        if Skip then begin
          lastisbinary:=no;
          Continue;
        end;
        if Assigned(Types[tind].proc)
        and not (Types[tind].Kind = fk_Enum)
        then begin
          //complex field:
          lastisbinary:=No;
          AddToScenario(dword(pointer(Types[tind].proc)));
          AddToScenario(offset);
          AddToScenario(tind);
          inc(Scenario[ii]);
        end
        else begin
          //binary field:
          if lastisbinary
          and (Fields[Cind][i - 1].offset mod AlignGranularity = 0) //предыдущее выровнено)
          and (offset mod AlignGranularity = 0)//(это выровнено)
          then begin //merge(!) with previous.
            inc(Scenario[sizeind], SizeToBufferIndex(Types[tind].size));
          end
          else begin //add normally
            lastisbinary:=Yes;
            AddToScenario(0);
            AddToScenario(offset);
            sizeind:=AddToScenario(SizeToBufferIndex(Types[tind].size));
            inc(Scenario[ii]);
          end;
        end;
      end;
    tScenarioIndex[Cind]:= ii;
  end;

  procedure CpsFindLoadingScenario(Cind, B_LocalClassInd: integer);
  var
    i: integer;
  begin
    if (Fields[Cind].High <> DH.B_Fields[B_LocalClassInd].High) //number of fields had changed
    or DH.TypeChanged[DH.NaToT[DH.Tnames[B_LocalClassInd]]]
    then begin
      DH.B_ScenarioIndex[B_LocalClassInd]:= -1; //no scenario could be used for this record
      BasketWarningsAdd(
               MsgFormat(MI_BASKET_CONVERSION,
                         [LocalClassNameStr(B_LocalClassInd),
                          FieldKindToCapStr(DH.B_RecKinds[B_LocalClassInd])]));
      Exit;
    end;
    For i:=0 to DH.B_Fields[B_LocalClassInd].High do
      With DH.B_Fields[B_LocalClassInd][i] do
        if (RFInd <> i) //the order of the fields had changed
        or (DH.TypeChanged[Tind]) //the field type requires conversion
        or (NewTind <> 0) //the field changed its type
        then begin
          DH.B_ScenarioIndex[Cind]:= -1; //no scenario could be used for this record
          BasketWarningsAdd(
               MsgFormat(MI_BASKET_CONVERSION,
                          [LocalClassNameStr(B_LocalClassInd),
                           FieldKindToCapStr(DH.B_RecKinds[B_LocalClassInd])]));
          Exit;
        end;
    //else use the existing saving scenario
    DH.B_ScenarioIndex[B_LocalClassInd]:= tScenarioIndex[Cind];
  end;

{  Cloning scenario format:
  <number of entries>, (<procedure>, <offset>, <tind | size>)
  <number of string/array fields> (<offset>)
   We don't neead any procedures. Cloning is performed by simply copying
    the memory region, then adjusting reference count for all array-like fields
    (strings and dynamic arrays);
   }
  procedure CpsBuildCloningScenario(Cind: integer);
  var
    i, ii, sizeind: integer;
    lastiscollated: boolean;
    function AddToScenario(d: dword): integer; inline;
    begin
      SetLength(CloningScenario, Length(CloningScenario) + 1);
      Result:=High(CloningScenario);
      CloningScenario[Result]:=d;
    end;
  begin
    ii:=AddToScenario(0);
    clScenarioIndex[Cind]:= ii;
    lastiscollated:=No;
    For i:=0 to Fields[Cind].High do
      With Fields[Cind][i] do begin
        if Types[tind].Kind = fk_notsupported then begin
          lastiscollated:=no;
          Continue;
        end;

        if lastiscollated
        and (Fields[Cind][i - 1].offset mod AlignGranularity = 0) //предыдущее выровнено)
        and (offset mod AlignGranularity = 0)//(это выровнено)
        then begin //merge(!) with previous.
          inc(CloningScenario[sizeind], SizeToBufferIndex(Types[tind].size));
        end
        else begin //add normally
          lastiscollated:=Yes;
          AddToScenario(0);
          AddToScenario(offset);
          sizeind:=AddToScenario(SizeToBufferIndex(Types[tind].size));
          inc(CloningScenario[ii]);
        end;
      end;
    ii:=AddToScenario(0);
    for i:=0 to Fields[Cind].High do
      with Fields[Cind][i] do begin
        if Types[tind].Kind in ArrayLikeTypes then begin
          AddToScenario(offset);
          inc(CloningScenario[ii]);
        end;
      end;
  end;

{  function TTrulyPersistent.NewInstance(): tobject;
begin
  Result:=inherited NewInstance();
end; }

  procedure CloneRecord(base, newbase: pointer; Cind: integer);
  var
    i, j: integer;
    p: pointer;
  begin
    i:=1 + clScenarioIndex[Cind];
    for j:=1 to CloningScenario[clScenarioIndex[Cind]] do begin
      Move(pointer(cardinal(base) + CloningScenario[i])^,
           pointer(cardinal(newbase) + CloningScenario[i])^,
           4 * CloningScenario[i + 1]);
      inc(i, 2);
    end;

    //tinkering with the ReferenceCount field of strings and dynamic arrays
    for j:=1 to CloningScenario[i] do begin
      p:= pointer(pointer(cardinal(newbase) + CloningScenario[i + j])^);
      if Assigned(p) then inc(longint(pointer(cardinal(p) - 8)^)); //refcount at offset -8
    end;
  end;

  procedure SaveRecord(base: pointer; Cind: integer);
  var
    i, j: integer;
    v: TCustomTypeProcessingProc;
  begin
    i:=1 + tScenarioIndex[Cind];
    //Always by scenario
    For j:=1 to Scenario[i - 1] do begin
      //v:= TCustomTypeProcessingProc(Scenario[i]);
      pointer(v):= pointer(Scenario[i]);
      if Assigned (v)
        then
//begin
//addlog('a: %0',[pointer(v)]);
          v(pointer(cardinal(base) + Scenario[i + 1]), fio_Save, Scenario[i + 2])
//;addlog('b');
//end
        else
          CpsStream.Write(pointer(cardinal(base) + Scenario[i + 1])^, 4 * Scenario[i + 2]);
      inc(i, 3);
    end;
  end;
  
  procedure WalkRecord(base: pointer; Cind: integer);
  var
    i, j: integer;
    v: TCustomTypeProcessingProc;
  begin
    i:=1 + tScenarioIndex[Cind];
    //Always by scenario
    For j:=1 to Scenario[i - 1] do begin
      v:= TCustomTypeProcessingProc(Scenario[i]);
//addlog(' -- %3 field %0 at %1:  %2', [TypeNameSpace[Scenario[i + 2]], Scenario[i + 1], Pointer(Scenario[i]), j ]);
      if Assigned (v) then
          v(pointer(cardinal(base) + Scenario[i + 1]), fio_Walk, Scenario[i + 2]);
      inc(i, 3);
    end;
  end;



  procedure LoadRecord(base: pointer; op: TFieldOperation; B_ClassIndex: integer);
  var
    i, j: integer;
    {$ifndef fpc}
     cp: TCustomConverterProc;
    {$endif}
  begin
    i:= DH.B_ScenarioIndex[B_ClassIndex];
//addlog('-- %0 %1',[B_ClassIndex, i]);
    if i >=0 then begin
      //Load by scenario
      inc(i);
      For j:=1 to Scenario[i - 1] do begin
        if Assigned (pointer(Scenario[i]))
          then TCustomTypeProcessingProc(Scenario[i])
             (pointer(cardinal(base) + Scenario[i + 1]), op, DH.B_FromGtind[Scenario[i + 2]])
          else CpsStream.Read(pointer(cardinal(base) + Scenario[i + 1])^, 4 * Scenario[i + 2]);
        inc(i, 3);
      end;
    end
    else begin
      // Scenario cannot be used for this record.
      //   Either the field list has changed, or some enumerated type has changed.

      // Load using the old routine, featuring a total, per-field conversion.
      for i:=0 to DH.B_Fields[B_ClassIndex].High do begin
        with DH.B_Fields[B_ClassIndex][i] do begin
          if Skip then Continue; //Skipped at saving. Nothing to do.
{addlog('--- %0 %1 rfind%2 %3 %4 offset%5',[i, B_NameSpace[Name], rfind, B_NameSpace[Tnames[tind]], TypeNameSpace[newtind]
,Fields[CNums[B_ClassIndex]][RFind].offset
]);
}
          if (RFind >= 0) and (op = fio_Load) then begin
          //load the field
            if NewTind <> 0
            {$ifdef fpc}
              then GetConverterProc(DH.B_ToGtind[tind], NewTind)
                 (pointer(base) + Fields[DH.CNums[B_ClassIndex]][RFind].offset, tind, NewTind)
            {$else}
              //Stupid, obsolete, good-for-nothing Delphi! -_-#
              then begin
                cp:=GetConverterProc(DH.B_ToGtind[tind], NewTind);
                cp(pointer(cardinal(base) + Fields[CNums[B_ClassIndex]][RFind].offset), tind, NewTind);
              end
            {$endif}
            else with Types[DH.B_ToGtind[Tind]] do
              if Assigned(proc)
                 then
                   proc(pointer(cardinal(base) + Fields[DH.CNums[B_ClassIndex]][RFind].offset), fio_Load, tind)
                 else
                   CpsStream.Read(pointer(cardinal(base) + Fields[DH.CNums[B_ClassIndex]][RFind].offset)^, 4 * SizeToBufferIndex(Size));
          end
          else begin
            //Skip this field, it doesn't exist in current implementation.
            with Types[Tind] do
              if Assigned(proc)
                then proc(nil, fio_Skip, tind)
                else {$ifdef fpc}CpsStream.{$endif}ReadDword; //CpsStream.Position:= CpsStream.Position + 4 * SizeToBufferIndex(Size);
          end;
        end;
//addlog('    pos %0', [CpsStream.Position]);
      end;
    end;
  end;

