Parse TS Blueprint (Connected Object Check)

unit ParseTSBlueprint;

// TJsonObject casts:

// S string
// I Integer
// L Int64
// U UInt64
// F Double
// D TDateTime
// D Utc TDateTime
// B Boolean
// A TJsonArray
// O TJsonObject

// Castle workshop ref 00066EB6 (for powering reference)

// Automation Tools Functions
{
  ConstructOkCancelButtons:
  A procedure which makes the standard OK and Cancel buttons on a form.

  Example usage:
  ConstructOkCancelButtons(frm, pnlBottom, frm.Height - 80);
}
procedure ConstructOkCancelButtons(h: TObject; p: TObject; top: Integer);
var
  btnOk: TButton;
  btnCancel: TButton;
begin
  btnOk := TButton.Create(h);
  btnOk.Parent := p;
  btnOk.Caption := 'OK';
  btnOk.ModalResult := mrOk;
  btnOk.Left := h.Width div 2 - btnOk.Width - 8;
  btnOk.Top := top;

  btnCancel := TButton.Create(h);
  btnCancel.Parent := p;
  btnCancel.Caption := 'Cancel';
  btnCancel.ModalResult := mrCancel;
  btnCancel.Left := btnOk.Left + btnOk.Width + 16;
  btnCancel.Top := btnOk.Top;
end;

{
  ConstructLabel:
  A function which can be used to make a label.  Used to make code more compact.

  Example usage:
  lbl3 := ConstructLabel(frm, pnlBottom, 65, 8, 360, 'Reference removal options:');
}
function ConstructLabel(h: TObject; p: TObject; top: Integer; left: Integer; width: Integer; height: Integer; s: String): TLabel;
var
  lb: TLabel;
begin
  lb := TLabel.Create(h);
  lb.Parent := p;
  lb.Top := top;
  lb.Left := left;
  lb.Width := width;
  if (height > 0) then
    lb.Height := height;
  lb.Caption := s;

  Result := lb;
end;

{
  HexFormID
  Gets the formID of a record as a hexadecimal string.

  This is useful for just about every time you want to deal with FormIDs.

  Example usage:
  s := HexFormID(e);
}
function HexFormID(e: IInterface): string;
var
  s: string;
begin
  s := GetElementEditValues(e, 'Record Header\FormID');
  if SameText(Signature(e), '') then
    Result := '00000000'
  else
    Result := Copy(s, Pos('[' + Signature(e) + ':', s) + Length(Signature(e)) + 2, 8);
end;

// End of Automation Tools Functions

procedure SplitText(const s: String; aList: TStringList);
begin
  aList.Delimiter := '|';
  aList.StrictDelimiter := True; // Spaces excluded from being a delimiter
  aList.DelimitedText := s;
end;

function GetPluginIndex(PluginName: string): integer;
var
  i, pi : integer;
begin
  pi := -1;
  for i := Pred(FileCount) downto 0 do
    if SameText(PluginName, GetFileName(FileByIndex(i))) then begin
      pi := i;
      Break;
    end;
  Result := pi;
end;

function GetWorkshopRef(PluginIndex: integer; WorkshopID:string): IInterface;
var
  fid: integer;
  f: IInterface;
begin
  f := FileByIndex(PluginIndex);
  fid := StrToInt64('$' + IntToHex(GetLoadOrder(f), 2) + WorkshopID);
  Result := RecordByFormID(f, fid, True);
end;

procedure AddOrAssign(r: IInterface; container: string; element: string; value: string);
var
  el: IInterface;
begin
  if ElementExists(r, container) then begin
    el := ElementByPath(r, container);
    el := ElementAssign(el, HighInteger, nil, False);
    if Assigned(el) then begin
      SetElementEditValues(el, element, value);
    end;
  end
  else begin
    el := Add(r, container, True);
    if Assigned(el) then begin
      SetElementEditValues(ElementByIndex(el, 0), element, value);
    end;
  end;
end;

procedure AddToPowerGrid(workshopRef: IInterface; Node1Ref: IInterface; Node2Ref: IInterface; LineRef: IInterface);
var
  el: IInterface;
begin
  if ElementExists(workshopRef, 'Power Grid') then begin
    el := ElementByPath(workshopRef, 'Power Grid');
    SetElementNativeValues(el, 'XWPG', GetElementNativeValues(el, 'XWPG') + 1);
    el := ElementByPath(el, 'Connections');
    if Assigned(el) then begin
      el := ElementAssign(el, HighInteger, nil, False);
      if Assigned(el) then begin
        if Node1Ref <> nil then
          SetElementEditValues(el, 'Node 1', Name(Node1Ref));
        if Node2Ref <> nil then
          SetElementEditValues(el, 'Node 2', Name(Node2Ref));
        if LineRef <> nil then
          SetElementEditValues(el, 'Line', Name(LineRef));
      end;
    end;
  end
  else begin
    el := Add(workshopRef, 'Power Grid', True);
    if Assigned(el) then begin
      SetElementEditValues(el, 'XWPG', '1');
      el := Add(el, 'XWPN', False);
      if Assigned(el) then begin
        SetElementEditValues(el, 'XWPN\Node 1', Name(Node1Ref));
        SetElementEditValues(el, 'XWPN\Node 2', Name(Node2Ref));
        if LineRef <> nil then
          SetElementEditValues(el, 'XWPN\Line', Name(LineRef));
      end;
    end;
  end;
end;

procedure ListAVandKW(rec: IInterface ;sl :TStringList);
var
  j: integer;
  element: IInterface;
begin
  element := ElementByPath(rec, 'PRPS');
  if Assigned(element) then begin
    j := 0;
    while j < ElementCount(element) do begin
      sl.Add(GetElementEditValues(ElementByIndex(element, j), 'Actor Value'));
      Inc(j);
    end;
  end;
  element := ElementByPath(rec, 'KWDA');
  if Assigned(element) then begin
    j := 0;
    while j < ElementCount(element) do begin
      sl.Add(GetEditValue(ElementByIndex(element, j)));
      Inc(j);
    end;
  end;
end;

procedure SetFlag(elem: IInterface; flagName: string; flagValue: boolean);
var
  sl: TStringList;
  i: Integer;
  f, f2: Cardinal;
begin
  sl := TStringList.Create;
  sl.Text := FlagValues(elem);
  f := GetNativeValue(elem);
  for i := 0 to Pred(sl.Count) do
    if SameText(sl[i], flagName) then begin
      if flagValue then
        f2 := f or (1 shl i)
      else
        f2 := f and not (1 shl i);
      if f <> f2 then SetNativeValue(elem, f2);
      Break;
    end;
  sl.Free;
end;

function StripNonAlpha(const AValue: string): string;
var
  regexp: TPerlRegEx;
begin
  regexp := TPerlRegEx.Create;
  try
    regexp.Subject := AValue;
    regexp.RegEx := '([^a-zA-Z0-9]+)';
    regexp.Options := [preCaseLess];
    regexp.ReplaceAll;
    Result := regexp.Subject;
  finally
    regexp.Free;
  end;
end;

function GetWorkshopRefDup(workshopRef: IInterface; workshoptype: integer; ToFile: IInterface): IInterface;
var
  element, baseObj1, baseObj2, workshopRefDup: IInterface;
  i: integer;
begin
  if workshoptype = 0 then begin
    AddMessage('Workshop Type: Copy record for workshop ref as dual workshop.');
    workshopRefDup := wbCopyElementToFile(workshopRef, ToFile, True, True);// Copy record for workshop ref as new record

    baseObj1 := LinksTo(ElementByName(workshopRef, 'NAME - Base')); // Get the workshop base object
    baseObj1 := wbCopyElementToFile(baseObj1, ToFile, True, True); // Copy record for workshop base object
    SetElementEditValues(baseObj1, 'EDID', GetElementEditValues(baseObj1, 'EDID') + '_' + StripNonAlpha(GetFileName(ToFile))); // Add suffix to the EDID of our copied workshop base object
    baseObj2 := RecordByFormID(FileByIndex(0), StrToInt64('$0023F662'), False); // Get the base object of the invisible chest
    SetElementEditValues(baseObj1, 'Model\MODL', GetElementEditValues(baseObj2, 'Model\MODL')); // Set the model of the duplicate workshop base object as a invisible chest
    SetElementEditValues(workshopRefDup, 'NAME', HexFormID(baseObj1)); // Set our custom workshop base object for our duplicated workshop ref.
    SetElementEditValues(workshopRefDup, 'EDID', GetElementEditValues(workshopRef, 'EDID') + '_' + StripNonAlpha(GetFileName(ToFile))); // Set the base object of the duplicate workshop as a invisible chest

    element := Add(workshopRefDup, 'Linked References', True); // Link the duplicated workshop to the actual workshop
    if Assigned(element) then begin
      SetElementEditValues(element, 'XLKR\Keyword/Ref', '00054BA6');
      SetElementEditValues(element, 'XLKR\Ref', Name(workshopRef));
    end;
  end
  else if workshoptype = 1 then begin
    AddMessage('Workshop Type: Copy record for workshop ref as complete replacement');
    workshopRefDup := wbCopyElementToFile(workshopRef, ToFile, True, True);// Copy record for workshop ref as new record
    // redirect 'referenced by' workshop records
    for i := Pred(ReferencedByCount(workshopRef)) downto 0 do begin
      baseObj1 := ReferencedByIndex(workshopRef, i);
      AddMasterIfMissing(ToFile, GetFileName(GetFile(baseObj1)));
      baseObj1 := wbCopyElementToFile(baseObj1, ToFile, False, True);
      CompareExchangeFormID(baseObj1, GetLoadOrderFormID(workshopRef), GetLoadOrderFormID(workshopRefDup));
    end;
    workshopRef := wbCopyElementToFile(workshopRef, ToFile, False, True);// Copy record for workshop ref as override
    SetFlag(ElementByPath(workshopRef, 'Record Header\Record Flags'), 'Deleted', true); // Flag the workshop override as deleted
  end
  else if workshoptype = 2 then begin
    AddMessage('Workshop Type: Override record for workshop ref');
    workshopRefDup := wbCopyElementToFile(workshopRef, ToFile, False, True);// Copy record for workshop ref as override
  end;
  Result := workshopRefDup;
end;

procedure BeginImport(bppath: string; ToFile: IInterface; workshoptype: integer);
var
  BP, obj: TJsonObject;
  form_id, reftype: string;
  items: TJsonArray;
  j, i, pi: integer;
  element, workshopRef, workshopRefDup, wscell, ref, refA, refB, baseObj: IInterface;
  sl: TStringList;
begin
  BP := TJsonObject.Create;
  try
    // parse the blueprint in the path given by the argument bppath (relative to Data)
    BP.LoadFromResource(bppath);
    pi := GetPluginIndex(BP.O['header'].S['worldspace_plugin']);
    workshopRef := GetWorkshopRef(pi, BP.O['workshop'].S['id']);
    wscell := LinksTo(ElementByName(workshopRef, 'Cell'));
    AddMasterIfMissing(ToFile, GetFileName(GetFile(wscell)));
    // Copy the workshop cell as override record and store the cell's persistent group in wscell
    wscell := wbCopyElementToFile(ElementByIndex(ChildGroup(wscell), 0), ToFile, True, False);

    // Add Fallout4.esm as master beforehand because the first record copied
    // could be from another file and it may contain references to records of Fallout4.esm
    AddMasterIfMissing(ToFile, GetFileName(FileByIndex(0)));

    WorkshopRefDup := GetWorkshopRefDup(workshopRef, workshoptype, ToFile);

    items := BP.A['items'];
    i := 0;
    while i < items.Count do begin
      obj := items.O[i];
      pi := GetPluginIndex(obj.S['plugin_name']);
      if pi = -1 then begin
        AddMessage(obj.S['plugin_name'] + ' Plugin Not Found');
      end
      else begin
          form_id := IntToHex(GetLoadOrder(FileByIndex(pi)), 2) + obj.S['FormID'];
          baseObj := RecordByFormID(FileByIndex(pi), StrToInt64('$' + form_id), False);

          sl := TStringList.Create;
          ReportRequiredMasters(baseObj, sl, false, false);
          j := 0;
          while j < sl.Count do begin
            AddMasterIfMissing(ToFile, sl[j]);
            Inc(j);
          end;
          sl.Free;

          if Signature(baseObj) = 'NPC_' then reftype := 'ACHR' else reftype := 'REFR';

          ref := Add(wscell, reftype, True);
          SetElementEditValues(ref, 'NAME', form_id);
          SetElementEditValues(ref, 'DATA\Position\X', obj.S['posX']);
          SetElementEditValues(ref, 'DATA\Position\Y', obj.S['posY']);
          SetElementEditValues(ref, 'DATA\Position\Z', obj.S['posZ']);
          SetElementEditValues(ref, 'DATA\Rotation\X', obj.S['rotX']);
          SetElementEditValues(ref, 'DATA\Rotation\Y', obj.S['rotY']);
          SetElementEditValues(ref, 'DATA\Rotation\Z', obj.S['rotZ']);

          if obj.S['Scale'] <> '1.0' then begin
            element := Add(ref, 'XSCL', True);
            if Assigned(element) then
              SetEditValue(element, obj.S['Scale']);
          end;

          element := Add(ref, 'Linked References', True);
          if Assigned(element) then begin
            SetElementEditValues(element, 'XLKR\Keyword/Ref', '00054BA6');
            SetElementEditValues(element, 'XLKR\Ref', Name(workshopRefDup));
          end;

          obj.S['RefId'] := IntToHex(GetLoadOrderFormID(ref), 8);
      end;
      Inc(i);
    end;

    // Start Powering Phase While
    i := 0;
    while i < items.Count do begin
      obj := items.O[i];

      // Start if refid is not 0
      if obj.S['RefId'] <> '' then begin

        refA := RecordByFormID(ToFile, StrToInt64('$' + obj.S['RefId']), True);

        // Start if Cables else Objects
        // Start Cables
        if obj.S['ConnectedObjects'] <> '' then begin

          sl := TStringList.Create;
          SplitText(obj.S['ConnectedObjects'], sl);

          // Loop Connected Objects
          j := 0;
          while j < sl.Count do begin
            // Start (Is Connected Object with greater Index)
            if StrToInt(sl[j]) > i then begin

              // Start Check if connected object has a reference
              if items.O[StrToInt(sl[j])].S['RefId'] <> '' then begin

                // Get Connected Object Ref
                refB := RecordByFormID(ToFile, StrToInt64('$' + items.O[StrToInt(sl[j])].S['RefId']), True);

                // Create Spline
                ref := Add(wscell, 'REFR', True);
                SetElementEditValues(ref, 'NAME', '0001D971');
                SetElementNativeValues(ref, 'DATA\Position\X', StrToFloat(obj.S['posX']) + ((GetElementNativeValues(refB, 'DATA\Position\X') - GetElementNativeValues(refA, 'DATA\Position\X'))/2));
                SetElementNativeValues(ref, 'DATA\Position\Y', StrToFloat(obj.S['posY']) + ((GetElementNativeValues(refB, 'DATA\Position\Y') - GetElementNativeValues(refA, 'DATA\Position\Y'))/2));
                SetElementNativeValues(ref, 'DATA\Position\Z', StrToFloat(obj.S['posZ']) + ((GetElementNativeValues(refB, 'DATA\Position\Z') - GetElementNativeValues(refA, 'DATA\Position\Z'))/2));
                SetElementEditValues(ref, 'DATA\Rotation\X', '0.0');
                SetElementEditValues(ref, 'DATA\Rotation\Y', '0.0');
                SetElementEditValues(ref, 'DATA\Rotation\Z', '0.0');

                // Link Spline ref to workshop
                element := Add(ref, 'Linked References', True);
                if Assigned(element) then begin
                  SetElementEditValues(element, 'XLKR\Keyword/Ref', '00054BA6');
                  SetElementEditValues(element, 'XLKR\Ref', Name(workshopRefDup));
                end;

                // Set Spline Values
                element := Add(ref, 'XBSD', True);
                if Assigned(element) then begin
                  // Slack
                  SetEditValue(ElementByIndex(element, 0), '0.051149');
                  // Thickness
                  SetEditValue(ElementByIndex(element, 1), '1.500000');
                  // ? Other point Relative X
                  SetNativeValue(ElementByIndex(element, 2), (GetElementNativeValues(refB, 'DATA\Position\X') - GetElementNativeValues(refA, 'DATA\Position\X'))/2);
                  // ? Other point Relative Y
                  SetNativeValue(ElementByIndex(element, 3), (GetElementNativeValues(refB, 'DATA\Position\Y') - GetElementNativeValues(refA, 'DATA\Position\Y'))/2);
                  // ? Other point Relative Z
                  SetNativeValue(ElementByIndex(element, 4), (GetElementNativeValues(refB, 'DATA\Position\Z') - GetElementNativeValues(refA, 'DATA\Position\Z'))/2);
                  // Detached End
                  SetEditValue(ElementByIndex(element, 5), 'False');
                end;

                // Set Spline Connections
                AddOrAssign(ref, 'Spline Connection', 'Ref', Name(refA));
                AddOrAssign(ref, 'Spline Connection', 'Ref', Name(refB));
                AddOrAssign(refA, 'Spline Connection', 'Ref', Name(ref));
                AddOrAssign(refB, 'Spline Connection', 'Ref', Name(ref));

                // Setup Grid
                AddToPowerGrid(workshopRefDup, refA, refB, ref);
              // End Check if connected object has a reference
              end;
            // End (Is Connected Object with greater Index)
            end;
            Inc(j);
          // End Loop Connected Objects
          end;
          sl.Free;
        // End Cables
        end
        // Start Objects
        else begin
          // Start If assigned radiator
          if obj.I['isPowered'] = 1 then
            AddToPowerGrid(workshopRefDup, refA, workshopRefDup, nil);
        // End Objects
        // End if Cables else Objects
        end;

        // Give power to snapped connections
        pi := GetPluginIndex(obj.S['plugin_name']);
        form_id := IntToHex(GetLoadOrder(FileByIndex(pi)), 2) + obj.S['FormID'];
        baseObj := RecordByFormID(FileByIndex(pi), StrToInt64('$' + form_id), False);
        sl := TStringList.Create;
        ListAVandKW(baseObj, sl);
        if sl.IndexOf('WorkshopSnapTransmitsPower [AVIF:00000354]') > -1 then
          AddToPowerGrid(workshopRefDup, refA, workshopRefDup, nil);
        sl.Free;
      // End if refid is not 0
      end;
      Inc(i);
    // End Powering Phase While
    end;
  finally
    BP.Free;
  end;
end;

function SelectWorkshopType(): integer;
var
  frm: TForm;
  lbl: TLabel;
  cbFiles: TComboBox;
begin
  frm := TForm.Create(nil);
  try
    frm.Caption := 'Select Workshop Type';
    frm.Width := 500;
    frm.Height := 160;
    frm.Position := poScreenCenter;

    lbl := ConstructLabel(frm, frm, 8, 8, 284, 30, 'Workshop Type:');

    cbFiles := TComboBox.Create(frm);
    cbFiles.Parent := frm;
    cbFiles.Items.Add('Dual Workshop (two workshops in 1 settlement (2nd hidden), has own stats)');
    cbFiles.Items.Add('Complete Replacement (redirects references, can produce incompatibilities)');
    cbFiles.Items.Add('Override Record (optimal, only new game, saved game = no power)');
    cbFiles.Top := lbl.Top + lbl.Height + 20;
    cbFiles.Left := 8;
    cbFiles.Width := 400;
    cbFiles.ItemIndex := 0;

    ConstructOkCancelButtons(frm, frm, 80);

    if frm.ShowModal = mrOk then
      Result := cbFiles.ItemIndex
    else
      Result := -1;
  finally
    frm.Free;
  end;
end;

function CreateSelector(Blueprints: TwbFastStringList; var bppath: string): integer;
var
  frm: TForm;
  lbl: TLabel;
  cbFiles: TComboBox;
  btnOk, btnCancel: TButton;
  i: integer;
  s: string;
begin
  frm := TForm.Create(nil);
  try
    frm.Caption := 'Select Blueprint';
    frm.Width := 550;
    frm.Height := 170;
    frm.Position := poScreenCenter;

    lbl := ConstructLabel(frm, frm, 8, 8, 284, 30, 'Blueprint');

    cbFiles := TComboBox.Create(frm);
    cbFiles.Parent := frm;
    cbFiles.Top := lbl.Top + lbl.Height + 20;
    cbFiles.Left := 8;
    cbFiles.Width := 500;

    for i := 0 to Pred(Blueprints.Count) do
      cbFiles.Items.Add(Blueprints[i]);

    cbFiles.ItemIndex := 0;

    ConstructOkCancelButtons(frm, frm, cbFiles.Top + 40);

    if frm.ShowModal = mrOk then begin
      bppath := cbFiles.Text;
      Result := 0;
    end
    else Result := 1;
  finally
    frm.Free;
  end;
end;

function SelectBlueprint(var bppath: string): integer;
var
  i: integer;
  slContainers: TStringList;
  Blueprints, slAssets: TwbFastStringList;
  r: integer;
begin
  slContainers := TStringList.Create;
  slAssets := TwbFastStringList.Create;
  Blueprints := TwbFastStringList.Create;

  ResourceContainerList(slContainers);

  for i := 0 to Pred(slContainers.Count) do
    if ExtractFileName(slContainers[i]) = '' then
      ResourceList(slContainers[i], slAssets);

  slAssets.Sort;
  wbRemoveDuplicateStrings(slAssets);

  for i := 0 to Pred(slAssets.Count) do
    if ContainsText(slAssets[i], 'F4SE\Plugins\TransferSettlements\blueprints') then
      Blueprints.Add(slAssets[i]);

  if Blueprints.Count > 0 then begin
    r := CreateSelector(Blueprints, bppath);
  end
  else
    r := 2;
  slAssets.Free;
  slContainers.Free;
  Result := r;
end;

// in the initialization it just shows a dialogue to enter the path of the blueprint
// and calls BeginImport with the given path
function Initialize: Integer;
var
  s: string;
  r, w: integer;
  f: IInterface;
begin
  r := SelectBlueprint(s);
  if r = 0 then begin
    if ResourceExists(s) then begin
      w := SelectWorkshopType();
      if w <> -1 then begin
         f := AddNewFile; //Shows a dialog to create a new esp.
         if f <> nil then BeginImport(s, f, w) else AddMessage('Invalid File Name.');
      end
      else AddMessage('Import canceled.');
    end
    else
      AddMessage('File ' + s + ' could not be found in the Data folder.');
  end
  else if r = 1 then
    AddMessage('Import canceled.')
  else
    AddMessage('No blueprints found.');

  Result := 1;
end;

end.