library airteamconvert;
uses classes, sysutils, stddlg, fpjson, jsonparser;

{$IFDEF CPU64}
{$ERROR Dieses Projekt kann nicht 64 Bit verwendet werden.}
{$ENDIF}

type
  TCallback = procedure(var x1, y1, z1, x2, y2, z2, x3, y3, z3 : Double);
  TCallback2 = procedure (var fId, plId : integer; out x, y, z : Double; out edge : PChar);
  TAddrCallback = procedure(out Address, PrId : PChar);
  TOnNewFace = procedure (var fId : integer; FaceType : PChar);
  TOnFaceDone = procedure;

procedure Error(msg : String; exCode : integer);
begin
  writeln(msg);
  Halt(exCode);
end;

procedure WritePoint(p : TJSONData; out x, y, z : Double);
var po : TJSONObject absolute p;
    xd, yd, zd : TJSONNumber;
begin
  if (p is TJSONObject) then
  begin
    if (po.Find('x', xd)) and
       (po.Find('y', yd)) and
       (po.Find('z', zd)) then
    begin
      x := xd.asFloat;
      y := yd.AsFloat;
      z := zd.AsFloat;
    end else
    begin
      x := 0;
      y := 0;
      z := 0;
    end;
  end;
end;

procedure ConvertFile(inFile : PChar; cb : TCallBack);
var P : TJSonParser;
    J : TJSonData;
    JO : TJSONObject absolute J;
    F : TFileStream;
    vertices : TJSonArray;
    faces : TJSONArray;
    i : integer;

  procedure ProcessFace(FaceD : TJSONData);
  var Face : TJSONObject absolute FaceD;
      v : TJSONArray;
      x1, y1, z1,
      x2, y2, z2,
      x3, y3, z3 : Double;
  begin
    if (FaceD is TJSONObject) then
    begin
      if (Face.Find('vertexKeys', v)) then
      begin
        if (v.Count = 3) then
        begin
          WritePoint(vertices[v[0].asInteger], x1, y1, z1);
          WritePoint(vertices[v[1].asInteger], x2, y2, z2);
          WritePoint(vertices[v[2].asInteger], x3, y3, z3);
          cb(x1, y1, z1, x2, y2, z2, x3, y3, z3);
        end else
         Error('VertexCount not 3', 1);
      end;
    end;
  end;

begin
  F := TFileStream.Create(inFile, fmOpenRead);
  P := TJSonParser.Create(F, []);
  J := P.Parse;
  if ((Assigned(J)) and (J is TJSONObject)) then
  begin
    try
      if (JO.Find('vertices', vertices)) then
      begin
        if (JO.Find('faces', faces)) then
        begin
          for i := 0 to faces.count - 1 do
            ProcessFace(faces[i]);
        end else
          error('List "faces" not found', 5);
      end else
       error('list "vertices " not found', 6);
    finally
      FreeAndNil(J);
    end;

  end else
    Error('File cannot be parsed', 4);
end;

procedure ConvertFile2(inFile : PChar; cbNewFace : TOnNewFace; cbFaceDone : TOnFaceDone; cb : TCallBack2; addrcb : TAddrCallback);
var P : TJSonParser;
    J : TJSonData;
    JO : TJSONObject absolute J;
    F : TFileStream;
    vertices : TJSonArray;
    faces : TJSONArray;
    classifiedEdges : TJSonArray;
    i : integer;
    jaddr : TJSonString;
    jprjid : TJSonNumber;
    addr : PChar;
    prjId : PChar;

  function FindEdgeType(Idx1, Idx2 : integer) : PChar;
  var edge : TJSonObject;
      vertexKeys : TJSonArray;
      i1, i2 : integer;
      cat : TJSonString;
      i : integer;
  begin
    Result := 'unknown';
    exit;
    if classifiedEdges <> nil then
    begin
      for i := 0 to classifiedEdges.Count - 1 do
      begin
        edge := TJSonObject(classifiedEdges[i]);
        if (edge.Find('vertexKeys', vertexKeys)) then
        begin
          i1 := vertexKeys[0].asInteger;
          i2 := vertexKeys[1].asInteger;
          if ((i1 = Idx1) and
              (i2 = Idx2)) or
             ((i2 = Idx1) and
              (i1 = Idx2)) then
          begin
            if (edge.Find('category', cat)) then
              Result := PChar(cat.asString);
            exit;
          end;
        end;
      end;
    end;
  end;

  procedure ProcessFace(fId : integer; FaceD : TJSONData);
  var Face : TJSONObject absolute FaceD;
      pl : TJSonObject;
      pla : TJSONArray;
      v : TJSONArray;
      x, y, z : Double;
      i, j, j2 : integer;
      plc, vc, plno : integer;
      cat : TJSonString;
      catp : PChar;
      edge : PChar;
  begin
    if (FaceD is TJSONObject) then
    begin
      if (Face.Find('category', cat)) then
      begin
        catp := PChar(cat.AsString);
        cbNewFace(fId, catp);
      end;
      if (Face.Find('polylines', pla)) then
      begin
        plc := pla.Count;
        for i := 0 to plc - 1 do
        begin
          pl := TJSonObject(pla[i]);
          if (pl.Find('vertexKeys', v)) then
          begin
            vc := v.Count;
            for j := 0 to vc - 1 do
            begin
              WritePoint(vertices[v[j].asInteger], x, y, z);
              plno := i;
              if (j < vc - 1) then
                j2 := j+1
              else
                j2 := 0;
              edge := FindEdgeType(v[j].asInteger, v[j2].asInteger);
              cb(fId, plno, x, y, z, edge);
            end;
          end;
        end;
      end else
        error('array polylines inside face not found', 7);
      cbFaceDone;
    end;
  end;

begin
  try
    F := TFileStream.Create(inFile, fmOpenRead or fmShareDenyNone);
    P := TJSonParser.Create(F, []);
    J := P.Parse;
    if ((Assigned(J)) and (J is TJSONObject)) then
    begin
      try
        if (not (JO.Find('classifiedEdges', classifiedEdges))) then
          classifiedEdges := nil;
        addr := nil;
        prjId := nil;
        if (JO.Find('projectId', jprjId)) then
        begin
          prjId := PChar(jprjid.AsString);
        end;
        if (JO.Find('address', JAddr)) then
        begin
          addr := PChar(JAddr.AsString);
        end;
        addrcb(addr, prjId);
        if (JO.Find('vertices', vertices)) then
        begin
          if (JO.Find('assembledFaces', faces)) then
          begin
            for i := 0 to faces.count - 1 do
              ProcessFace(i, faces[i]);
          end else
            error('List "assembledFaces" not found', 5);
        end else
         error('list "vertices " not found', 6);
      finally
        FreeAndNil(J);
      end;

    end else
      Error('File cannot be parsed', 4);
    P.Free;
    F.Free;
  finally
  end;
end;


exports
 ConvertFile,
 ConvertFile2;

{$R *.res}

begin
end.