unit U_ArchStroyCalc;

interface

uses Forms, StdCtrls, SysUtils, Classes, ComCtrls, Windows, Controls, Contnrs, Messages, Dialogs, Math, TypInfo, RTLConsts,
      DB,kbmMemTable,kbmMemBinaryStreamFormat,kbmMemCSVStreamFormat;

const
  // Object sys names
  osnRoom = 'ÊÎÌÍ';
  osnBrickWall = 'ÊÈÐÑÒÅÍÀ';
  osnWallDivision = 'ÏÅÐÅÃ';
  osnWallVolume = 'ÑÒÅÍ';
  osnBasement = 'ÔÓÍÄ';
  osnBasementColumn = 'ÑÒÎËÁ_ÔÓÍÄÀÌÅÍÒÀ';
  osnFacade = 'ÔÀÑÀÄ';

type
  TASCObject = class;
  TASCObjectList = class;
  TASCBuildingList = class;

  TASCBasic = class(TComponent)
    private
      FCaption: String;
    public
      procedure LoadFromFile(const AFileName: String);
      procedure LoadFromStream(AStream: TStream);
      procedure SaveToFile(const AFileName: String);
      procedure SaveToStream(AStream: TStream);
    published
      property Caption: string read FCaption write FCaption;
  end;

  TASCItem = class(TCollectionItem)
    private
      FCaption: String;
    public
      FSrcObj: TObject;
      constructor Create(Collection: TCollection); override;
    published
      property Caption: string read FCaption write FCaption;
  end;


  // Ïðîåêò/Îðãàíèçàöèÿ
  TASCProject = class(TASCBasic)
    private
      FBuildings: TASCBuildingList;
    public
      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;
    published
      property Buildings: TASCBuildingList read FBuildings write FBuildings;
  end;

  // Ñòðîéêà
  TASCBuilding = class(TASCItem)
    private
      FObjects: TASCObjectList;
    public
      constructor Create(Collection: TCollection); override;
      destructor Destroy; override;
    published
      property Objects: TASCObjectList read FObjects write FObjects;
  end;
  TASCBuildingList = class(TCollection)
    protected
      function GetItem(Index: Integer): TASCBuilding;
      procedure SetItem(Index: Integer; Value: TASCBuilding);
    public
      property Item[Index: Integer]: TASCBuilding read GetItem write SetItem; default;
      constructor Create;
  end;

  // Îáúåêò (Êîìíàòà)
  TASCObject = class(TASCItem)
    private
      FLength: Double;
      FWidth: Double;
      FHeight: Double;
      FSysName: String;
      FMemTableDump: String;

      FObjects: TASCObjectList;
    public
      constructor Create(Collection: TCollection); override;
      destructor Destroy; override;
      procedure LoadDumpFromMemTable(AMT: TkbmMemTable);
      procedure SaveDumpToMemTable(AMT: TkbmMemTable);
    published
      Property Length: Double read FLength write FLength;
      Property Width: Double read FWidth write FWidth;
      Property Height: Double read FHeight write FHeight;
      Property SysName: String read FSysName write FSysName;
      Property MemTableDump: String read FMemTableDump write FMemTableDump;
      property Objects: TASCObjectList read FObjects write FObjects;
  end;
  TASCObjectList = class(TCollection)
    protected
      function GetItem(Index: Integer): TASCObject;
      procedure SetItem(Index: Integer; Value: TASCObject);
    public
      property Item[Index: Integer]: TASCObject read GetItem write SetItem; default;
      constructor Create;
  end;

  procedure ImportToStroyCalcTest;
  procedure ObjectBinaryToTextView(Input, Output: TStream);

var
  GSFBinary: TkbmBinaryStreamFormat;
  GSFCSV: TkbmCSVStreamFormat;
  GSCDebugMode: Boolean=false;

implementation

{ TASCBasic }

procedure TASCBasic.LoadFromFile(const AFileName: String);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(AFileName, fmOpenRead);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TASCBasic.LoadFromStream(AStream: TStream);
var
  MemStream: TMemoryStream;
begin
  //AStream.ReadComponent(Self);

  MemStream := TMemoryStream.Create;
  ObjectTextToBinary(AStream, MemStream);
  MemStream.Position := 0;
  MemStream.ReadComponent(Self);
  MemStream.Free;
end;

procedure TASCBasic.SaveToFile(const AFileName: String);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(AFileName, fmCreate);
  try
    SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TASCBasic.SaveToStream(AStream: TStream);
var
  MemStream: TMemoryStream;
begin
  //AStream.WriteComponent(Self);

  MemStream := TMemoryStream.Create;
  MemStream.WriteComponent(Self);
  MemStream.Position := 0;
  if Not GSCDebugMode then
    ObjectBinaryToText(MemStream, AStream)
  else
    ObjectBinaryToTextView(MemStream, AStream);
  MemStream.Free;
end;


constructor TASCItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FSrcObj := nil;
end;

{ TASCBProject }

constructor TASCProject.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FBuildings := TASCBuildingList.Create;
end;

destructor TASCProject.Destroy;
begin
  FBuildings.Free;
  inherited;
end;

{ TASCObjectList }

constructor TASCObjectList.Create;
begin
  inherited Create(TASCObject);
end;

function TASCObjectList.GetItem(Index: Integer): TASCObject;
begin
  Result := TASCObject(inherited GetItem(Index));
end;

procedure TASCObjectList.SetItem(Index: Integer; Value: TASCObject);
begin
  inherited SetItem(Index, Value);
end;

{ TASCBuildingList }

constructor TASCBuildingList.Create;
begin
  inherited Create(TASCBuilding);
end;

function TASCBuildingList.GetItem(Index: Integer): TASCBuilding;
begin
  Result := TASCBuilding(inherited GetItem(Index));
end;

procedure TASCBuildingList.SetItem(Index: Integer; Value: TASCBuilding);
begin
  inherited SetItem(Index, Value);
end;

{ TASCBuilding }

constructor TASCBuilding.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FObjects := TASCObjectList.Create;
end;

destructor TASCBuilding.Destroy;
begin
  FObjects.Free;
  inherited;
end;

{ TASCObject }

constructor TASCObject.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FObjects := TASCObjectList.Create;
end;

destructor TASCObject.Destroy;
begin
  FObjects.Free;
  inherited;
end;

procedure TASCObject.LoadDumpFromMemTable(AMT: TkbmMemTable);
var
  StrStream: TStringStream;
begin
  StrStream := TStringStream.Create('');
  if Not GSCDebugMode then
    AMT.SaveToStreamViaFormat(StrStream, GSFBinary)
  else
    AMT.SaveToStreamViaFormat(StrStream, GSFCSV);
  StrStream.Position := 0;
  Self.MemTableDump := StrStream.DataString;
  StrStream.Free;
end;

procedure TASCObject.SaveDumpToMemTable(AMT: TkbmMemTable);
var
  StrStream: TStringStream;
begin
  StrStream := TStringStream.Create(Self.MemTableDump);
  StrStream.Position := 0;
  AMT.LoadFromStreamViaFormat(StrStream, GSFBinary);
  StrStream.Free;
end;

procedure ImportToStroyCalcTest;
var
  ASCProject: TASCProject;
  ASCBuilding: TASCBuilding;
  ASCObject: TASCObject;

  MT: TKbmMemTable;
  sfCSV: TkbmCSVStreamFormat;
  i: Integer;
begin
  try
    ASCProject := TASCProject.Create(nil);
    //ASCProject.Caption;
    ASCProject.LoadFromFile('C:\Temp\stroyCalcProj.scp');
    ASCProject.SaveToFile('C:\Temp\stroyCalcProj_ret.scp');

    if ASCProject.Buildings.Count > 0 then
    begin
      ASCBuilding := ASCProject.Buildings[0];
      //ASCBuilding.Caption
      if ASCBuilding.Objects.Count > 0 then
      begin
        sfCSV := TkbmCSVStreamFormat.Create(nil);
        for i := 0 to ASCBuilding.Objects.Count - 1 do
        begin
          ASCObject := ASCBuilding.Objects[i];
          //ASCObject.Caption
          MT := TKbmMemTable.Create(nil);
          ASCObject.SaveDumpToMemTable(MT);
          MT.SaveToFileViaFormat('C:\Temp\stroyCalcProj_'+IntToStr(i)+'.csv', sfCSV);

          MT.Free;
        end;
        sfCSV.Free;
      end;
    end;

    FreeAndNil(ASCProject);
  except
    on E: Exception do ShowMessage('ImportToStroyCalcTest: '+ E.Message);
  end;
end;

procedure ObjectBinaryToTextView(Input, Output: TStream);
var
  NestingLevel: Integer;
  SaveSeparator: Char;
  Reader: TReader;
  Writer: TWriter;
  ObjectName, PropName: string;

  procedure WriteIndent;
  const
    Blanks: array[0..1] of Char = '  ';
  var
    I: Integer;
  begin
    for I := 1 to NestingLevel do Writer.Write(Blanks, SizeOf(Blanks));
  end;

  procedure WriteStr(const S: string);
  begin
    Writer.Write(S[1], Length(S));
  end;

  procedure NewLine;
  begin
    WriteStr(sLineBreak);
    WriteIndent;
  end;

  procedure ConvertValue; forward;

  procedure ConvertHeader;
  var
    ClassName: string;
    Flags: TFilerFlags;
    Position: Integer;
  begin
    Reader.ReadPrefix(Flags, Position);
    ClassName := Reader.ReadStr;
    ObjectName := Reader.ReadStr;
    WriteIndent;
    if ffInherited in Flags then
      WriteStr('inherited ')
    else if ffInline in Flags then
      WriteStr('inline ')
    else
      WriteStr('object ');
    if ObjectName <> '' then
    begin
      WriteStr(ObjectName);
      WriteStr(': ');
    end;
    WriteStr(ClassName);
    if ffChildPos in Flags then
    begin
      WriteStr(' [');
      WriteStr(IntToStr(Position));
      WriteStr(']');
    end;

    if ObjectName = '' then
      ObjectName := ClassName;  // save for error reporting

    WriteStr(sLineBreak);
  end;

  procedure ConvertBinary;
  const
    BytesPerLine = 32;
  var
    MultiLine: Boolean;
    I: Integer;
    Count: Longint;
    Buffer: array[0..BytesPerLine - 1] of Char;
    Text: array[0..BytesPerLine * 2 - 1] of Char;
  begin
    Reader.ReadValue;
    WriteStr('{');
    Inc(NestingLevel);
    Reader.Read(Count, SizeOf(Count));
    MultiLine := Count >= BytesPerLine;
    while Count > 0 do
    begin
      if MultiLine then NewLine;
      if Count >= 32 then I := 32 else I := Count;
      Reader.Read(Buffer, I);
      BinToHex(Buffer, Text, I);
      Writer.Write(Text, I * 2);
      Dec(Count, I);
    end;
    Dec(NestingLevel);
    WriteStr('}');
  end;

  procedure ConvertProperty; forward;

  procedure ConvertValue;
  const
    LineLength = 64;
  var
    I, J, K, L: Integer;
    S: string;
    W: WideString;
    LineBreak: Boolean;
  begin
    case Reader.NextValue of
      vaList:
        begin
          Reader.ReadValue;
          WriteStr('(');
          Inc(NestingLevel);
          while not Reader.EndOfList do
          begin
            NewLine;
            ConvertValue;
          end;
          Reader.ReadListEnd;
          Dec(NestingLevel);
          WriteStr(')');
        end;
      vaInt8, vaInt16, vaInt32:
        WriteStr(IntToStr(Reader.ReadInteger));
      vaExtended:
        WriteStr(FloatToStr(Reader.ReadFloat));
      vaSingle:
        WriteStr(FloatToStr(Reader.ReadSingle) + 's');
      vaCurrency:
        WriteStr(FloatToStr(Reader.ReadCurrency * 10000) + 'c');
      vaDate:
        WriteStr(FloatToStr(Reader.ReadDate) + 'd');
      vaWString, vaUTF8String:
        begin
          W := Reader.ReadWideString;
          L := Length(W);
          if L = 0 then WriteStr('''''') else
          begin
            I := 1;
            Inc(NestingLevel);
            try
              if L > LineLength then NewLine;
              K := I;
              repeat
                LineBreak := False;
                if (W[I] >= ' ') and (W[I] <> '''') and (Ord(W[i]) <= 127) then
                begin
                  J := I;
                  repeat
                    Inc(I)
                  until (I > L) or (W[I] < ' ') or (W[I] = '''') or
                    ((I - K) >= LineLength) or (Ord(W[i]) > 127);
                  if ((I - K) >= LineLength) then LineBreak := True;
                  WriteStr('''');
                  while J < I do
                  begin
                    WriteStr(Char(W[J]));
                    Inc(J);
                  end;
                  WriteStr('''');
                end else
                begin
                  //WriteStr('#');
                  //WriteStr(IntToStr(Ord(W[I])));
                  WriteStr(W[I]);
                  Inc(I);
                  if ((I - K) >= LineLength) then LineBreak := True;
                end;
                if LineBreak and (I <= L) then
                begin
                  WriteStr(' +');
                  NewLine;
                  K := I;
                end;
              until I > L;
            finally
              Dec(NestingLevel);
            end;
          end;
        end;
      vaString, vaLString:
        begin
          S := Reader.ReadString;
          L := Length(S);
          if L = 0 then WriteStr('''''') else
          begin
            I := 1;
            Inc(NestingLevel);
            try
              if L > LineLength then NewLine;
              K := I;
              repeat
                LineBreak := False;
                if (S[I] >= ' ') and (S[I] <> '''') then
                begin
                  J := I;
                  repeat
                    Inc(I)
                  until (I > L) or (S[I] < ' ') or (S[I] = '''') or
                    ((I - K) >= LineLength);
                  if ((I - K) >= LineLength) then
                  begin
                    LIneBreak := True;
                    if ByteType(S, I) = mbTrailByte then Dec(I);
                  end;
                  WriteStr('''');
                  Writer.Write(S[J], I - J);
                  WriteStr('''');
                end else
                begin
                  //WriteStr('#');
                  //WriteStr(IntToStr(Ord(S[I])));
                  WriteStr(S[I]);
                  Inc(I);
                  if ((I - K) >= LineLength) then LineBreak := True;
                end;
                if LineBreak and (I <= L) then
                begin
                  WriteStr(' +');
                  NewLine;
                  K := I;
                end;
              until I > L;
            finally
              Dec(NestingLevel);
            end;
          end;
        end;
      vaIdent, vaFalse, vaTrue, vaNil, vaNull:
        WriteStr(Reader.ReadIdent);
      vaBinary:
        ConvertBinary;
      vaSet:
        begin
          Reader.ReadValue;
          WriteStr('[');
          I := 0;
          while True do
          begin
            S := Reader.ReadStr;
            if S = '' then Break;
            if I > 0 then WriteStr(', ');
            WriteStr(S);
            Inc(I);
          end;
          WriteStr(']');
        end;
      vaCollection:
        begin
          Reader.ReadValue;
          WriteStr('<');
          Inc(NestingLevel);
          while not Reader.EndOfList do
          begin
            NewLine;
            WriteStr('item');
            if Reader.NextValue in [vaInt8, vaInt16, vaInt32] then
            begin
              WriteStr(' [');
              ConvertValue;
              WriteStr(']');
            end;
            WriteStr(sLineBreak);
            Reader.CheckValue(vaList);
            Inc(NestingLevel);
            while not Reader.EndOfList do ConvertProperty;
            Reader.ReadListEnd;
            Dec(NestingLevel);
            WriteIndent;
            WriteStr('end');
          end;
          Reader.ReadListEnd;
          Dec(NestingLevel);
          WriteStr('>');
        end;
      vaInt64:
        WriteStr(IntToStr(Reader.ReadInt64));
    else
      raise EReadError.CreateResFmt(@sPropertyException,
        [ObjectName, DotSep, PropName, IntToStr(Ord(Reader.NextValue))]);
    end;
  end;

  procedure ConvertProperty;
  begin
    WriteIndent;
    PropName := Reader.ReadStr;  // save for error reporting
    WriteStr(PropName);
    WriteStr(' = ');
    ConvertValue;
    WriteStr(sLineBreak);
  end;

  procedure ConvertObject;
  begin
    ConvertHeader;
    Inc(NestingLevel);
    while not Reader.EndOfList do ConvertProperty;
    Reader.ReadListEnd;
    while not Reader.EndOfList do ConvertObject;
    Reader.ReadListEnd;
    Dec(NestingLevel);
    WriteIndent;
    WriteStr('end' + sLineBreak);
  end;

begin
  NestingLevel := 0;
  Reader := TReader.Create(Input, 4096);
  SaveSeparator := DecimalSeparator;
  DecimalSeparator := '.';
  try
    Writer := TWriter.Create(Output, 4096);
    try
      Reader.ReadSignature;
      ConvertObject;
    finally
      Writer.Free;
    end;
  finally
    DecimalSeparator := SaveSeparator;
    Reader.Free;
  end;
end;

initialization
  //RegisterClass(TASCBuilding);
  GSFBinary := TkbmBinaryStreamFormat.Create(nil);
  GSFCSV := TkbmCSVStreamFormat.Create(nil);

finalization
  FreeAndNil(GSFBinary);
  FreeAndNil(GSFCSV);

end.