unit lodgenalt;

// This is copied and modified code from LODGen
// Credit to Ehamloptiran and Zilav for LODGen, part of TES5Edit

//============================================================================
// declare gloabl lists and initialize
procedure LODGenPrepare;
begin
  slLODTypes := TStringList.Create;
  slLODTypes.StrictDelimiter := True;
  slLODTypes.CommaText := sLODOptions;
  slGridTypes := TStringList.Create;
  slGridTypes.StrictDelimiter := True;
  slGridTypes.CommaText := sGridOptions;
  slReferenceTypes := TStringList.Create;
  slReferenceTypes.StrictDelimiter := True;
  slReferenceTypes.CommaText := sReferenceOptions;
  slLOD := TStringList.Create;
  slCache := TStringList.Create;
  slExport := TStringList.Create;
  lstSkip := TList.Create;
  slLODAssets := TwbFastStringList.Create;
  slLODAssets.Sorted := True;
  slLODAssets.Duplicates := dupIgnore;
end;

//============================================================================
// free globals
procedure LODGenFree;
begin
  lstSkip.Free;
  slExport.Free;
  slCache.Free;
  slReferenceTypes.Free;
  slGridTypes.Free;
  slLOD.Free;
  slLODTypes.Free;
  slLODAssets.Free;
end;

//============================================================================
// initialize for export
function LODGenExportWorldspaceStart(wrld: IInterface): Boolean;
var
  x, y, i: integer;
  sl: TStringList;
  s: string;
begin
  slExport.Clear;
  slCache.Clear;
  lstSkip.Clear;
  slLODAssets.Clear;

  slExport.Add('Worldspace=' + EditorID(wrld));
  Result := LODCellSW(wrld, x, y);
  if not Result then begin
    MyMessage('Unable to open lod settings file for worldspace ' + LODSettingsFileName(wrld));
    Exit;
  end;
  slExport.Add('CellSW=' + Format('%d %d', [x, y]));
  slExport.Add('TextureDiffuseHD=' + GetElementEditValues(wrld, 'TNAM'));
  slExport.Add('TextureNormalHD=' + GetElementEditValues(wrld, 'UNAM'));
  slExport.Add('TextureAtlasMap=' + CachePath + 'atlas_map_' + Lowercase(EditorID(wrld)) + '.txt');
  slExport.Add('AtlasTolerance=0.2');
  slExport.Add('PathData=' + sDataPath);
  s := sDestination;
  if Pos('meshes\', s) = 0 then
    s := s + '\meshes\terrain\' + Lowercase(EditorID(wrld)) + '\objects';
  slExport.Add('PathOutput=' + s);

  sl := TStringList.Create;
  ResourceContainerList(sl);
  for i := 0 to Pred(sl.Count) do begin
    if (ExtractFileExt(Lowercase(sl[i])) = '.bsa') then begin
      slExport.Add('Resource=' + sl[i]);
    end;
  end;
  sl.Free;

  MyMessage('Building a list of LOD objects, please wait...');
end;


//============================================================================
// export list for LODGen.exe
function LODGenExportWorldspaceEnd(wrld: IInterface): Boolean;
var
  sl: TStringList;
begin
  sl := TStringList.Create;
  sl := LoadStringList('manual_static_' + sWorld);
  if fExport then begin
    if slExport.Count > 5 then begin
      if sl.Count > 0 then begin
        MyMessage('Adding ' + IntToStr(sl.Count) + ' manual objects LOD data to LODGen export file');
        slExport.AddStrings(sl);
      end;
      MyMessage('Saving objects LOD data to ' + sExport);
      // make sure folder exists
      if not DirectoryExists(ExtractFilePath(sExport)) then
        if not ForceDirectories(ExtractFilePath(sExport)) then begin
          MyMessage('Error: can not create output folder for LODGen export file ' + ExtractFilePath(sExport));
          Exit;
        end;
      slExport.SaveToFile(sExport);
      MyMessage(Format('LOD references: %d, unique LOD objects: %d', [slExport.Count-5, slCache.Count]));
    end
    else begin
      MessageDlg('No LOD objects in ' + Name(wrld) + ' world.', mtInformation, [mbOk], 0);
      Result := False;
      Exit;
    end;
    Result := True;
  end;
  sl.Free;
end;

//===========================================================================
// on key down event handler for form
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if Key = VK_ESCAPE then
    TForm(Sender).ModalResult := mrCancel;
end;

//============================================================================
// on close event handler for options form
procedure frmOptionsFormClose(Sender: TObject; var Action: TCloseAction);
begin
  if frm.ModalResult <> mrOk then Exit;

  if cbWorld.ItemIndex = -1 then begin
    MessageDlg('No worldspace selected.', mtInformation, [mbOk], 0);
    Action := caNone;
    Exit;
  end;
  
  if (edExport.Text = '') or (edDestination.Text = '') then begin
    MessageDlg('Export file and destination path can not be empty', mtInformation, [mbOk], 0);
    Action := caNone;
    Exit;
  end;

  if slLOD.Count = 0 then begin
    MessageDlg('No mesh LOD rules specified.', mtInformation, [mbOk], 0);
    Action := caNone;
    Exit;
  end;
end;

//============================================================================
// on close event handler for lodgen rule form
procedure frmRuleFormClose(Sender: TObject; var Action: TCloseAction);
begin
  if TForm(Sender).ModalResult <> mrOk then Exit;
  if TEdit(TForm(Sender).FindComponent('edMesh')).Text = '' then begin
    MessageDlg('Mesh mask can not be empty', mtInformation, [mbOk], 0);
    Action := caNone;
  end;
end;

//============================================================================
function CreateLabel(aParent: TControl; x, y: Integer; aCaption: string): TLabel;
begin
  Result := TLabel.Create(aParent);
  Result.Parent := aParent;
  Result.Left := x;
  Result.Top := y;
  Result.Caption := aCaption;
end;

//============================================================================
// fill with worldspaces that have LOD
procedure FillWorldspacesWithLOD(cmbWorld: TComboBox);
var
  i, j: integer;
  f, wrlds, wrld: IInterface;
  sl: TStringList;
  s: string;
begin
  // filling list of worldspaces
  sl := TStringList.Create;
  try
    sl.Duplicates := dupIgnore;
    sl.Sorted := True;
    for i := Pred(FileCount) downto 0 do begin
      wrlds := GroupBySignature(FileByIndex(i), 'WRLD');
      for j := 0 to Pred(ElementCount(wrlds)) do begin
        wrld := ElementByIndex(wrlds, j);
        if ElementType(wrld) <> etMainRecord then
          Continue;
        if HasLOD(wrld) then
          sl.AddObject(EditorID(wrld), MasterOrSelf(wrld));
      end;
    end;
    cmbWorld.Items.Assign(sl);
  finally
    sl.Free;
  end;
end;

//============================================================================
// does worldspace have a lod?
function HasLOD(wrld: IInterface): boolean;
begin
  // a presence of lod settings file
  Result := ResourceExists(LODSettingsFileName(wrld));
end;

//============================================================================
// name of LOD settings file for worldspace
function LODSettingsFileName(wrld: IInterface): string;
begin
  if (wbGameMode = gmFO3) or (wbGameMode = gmFNV) then
    Result := 'lodsettings\' + EditorID(wrld) + '.dlodsettings'
  else
    Result := 'lodsettings\' + EditorID(wrld) + '.lod';
end;

//============================================================================
procedure btnDestinationClick(Sender: TObject);
var
  s: string;
begin
  s := SelectDirectory('Destination path', '', edDestination.Text, nil);
  if s <> '' then
    edDestination.Text := s;
end;

//============================================================================
procedure btnDataPathClick(Sender: TObject);
var
  s: string;
begin
  s := SelectDirectory('Data folder', '', edDataPath.Text, nil);
  if s <> '' then
    edDataPath.Text := s;
end;

//===========================================================================
// listview custom data event
procedure lvRulesData(Sender: TObject; Item: TListItem);
var
  i: integer;
begin
  Item.Caption := slLOD[Item.Index];
  i := slLOD.Objects[Item.Index];
  Item.SubItems.Add(slLODTypes[i and $FF]);
  Item.SubItems.Add(slLODTypes[i shr 8 and $FF]);
  Item.SubItems.Add(slLODTypes[i shr 16 and $FF]);
  if i shr 24 and 1 = 1 then Item.SubItems.Add('Yes') else Item.SubItems.Add('');
end;

//===========================================================================
procedure lvRulesDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
  Accept := (Sender = lvRules) and Assigned(lvRules.GetItemAt(X, Y));
end;

//===========================================================================
procedure lvRulesDragDrop(Sender, Source: TObject; X, Y: Integer);
var
  dropItem : TListItem;
begin
  if Sender <> Source then
    Exit;
  dropItem := lvRules.GetItemAt(X, Y);
  slLOD.Move(SelectedRuleIndex, dropItem.Index);
  dropItem.Selected := True;
  lvRules.Refresh;
end;

//===========================================================================
// on select item event handler for lod rules
procedure lvRulesSelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
begin
  if not Selected then Exit;
  SelectedRuleIndex := Item.Index;
end;

//===========================================================================
// on double click event handler for mesh rules
procedure lvRulesDblClick(Sender: TObject);
begin
  RulesMenuEditClick(nil);
end;

//===========================================================================
// click event for lodgen rules Delete menu
procedure RulesMenuDeleteClick(Sender: TObject);
begin
  if not Assigned(lvRules.Selected) then
    Exit;
  slLOD.Delete(lvRules.Selected.Index);
  lvRules.Items.Count := slLOD.Count;
  lvRules.Refresh;
end;

//============================================================================
// get index of Item in Items, or 0 if not found and Items are not empty
function IndexIn(Items: TStrings; Item: string): integer;
begin
  Result := Items.IndexOf(Item);
  if (Result = -1) and (Items.Count > 0) then
    Result := 0;
end;

//==========================================================================
// make sure that mesh file name starts with 'meshes\'
function NormalizePath(value: string): string;
begin
  if value = '' then
    Exit;
  if Copy(value, 1, 1) = '\' then
    Delete(value, 1, 1);
  value := LowerCase(value);
  if Copy(value, 1, 5) = 'data\' then
    value := Copy(value, 6, Length(value));
  if not (Copy(value, 1, 7) = 'meshes\') then
    value := 'meshes\' + value;
  Result := value;
end;

//============================================================================
// get south west cell of lod
function LODCellSW(wrld: IInterface; var SWCellX, SWCellY: integer): Boolean;
var
  BytesStream: TBytesStream;
  lodsettings: TBinaryReader;
begin
  if not HasLOD(wrld) then
    Exit;

  // read from lod settings file
  BytesStream := TBytesStream.Create(ResourceOpenData('', LODSettingsFileName(wrld)));
  lodsettings := TBinaryReader.Create(BytesStream);
  try
    if (wbGameMode = gmFO3) or (wbGameMode = gmFNV) then
      BytesStream.Position := 12;
    SWCellX := lodsettings.ReadSmallInt;
    SWCellY := lodsettings.ReadSmallInt;
    Result := True;
  finally
    lodsettings.Free;
    BytesStream.Free;
  end;
end;

//============================================================================
// Execute LODGen app
function ExecuteLODGen: Boolean;
var
  lodgenexe: string;
begin
  lodgenexe := ScriptsPath + 'lodgen.exe';
  AddMessage('Executing LODGen...');
  AddMessage(lodgenexe + LODGenParams);
  CreateProcessWait(lodgenexe, LODGenParams, SW_SHOW, 0);
end;

//============================================================================
// getting lod file for a record depending on lod type
function LODMeshFor(rec: IInterface; LodType: integer): string;
begin
  if LodType = iLODNone then
    Exit
  else if LodType = iLODFull then
    Result := GetElementEditValues(rec, 'Model\MODL')
  else if LODType = iLOD4 then
    Result := HexArrayToStr(GetElementEditValues(rec, 'MNAM\LOD #0 (Level 0)\Mesh'))
  else if LODType = iLOD8 then
    Result := HexArrayToStr(GetElementEditValues(rec, 'MNAM\LOD #1 (Level 1)\Mesh'))
  else if LODType = iLOD16 then
    Result := HexArrayToStr(GetElementEditValues(rec, 'MNAM\LOD #2 (Level 2)\Mesh'))
  else if LODType = iLODFar then begin
    Result := GetElementEditValues(rec, 'Model\MODL');
    Result := Copy(Result, 1, Length(Result) - 4) + '_far.nif';
  end else
    Exit;

  if Result <> '' then begin
    Result := NormalizePath(Result);
    if LODType = iLODFar then
      if not ResourceExists(Result) then Result := '';
  end;
end;

//==========================================================================
function HexArrayToStr(s: string): string;
var
  i: integer;
  c: char;
  hex: string;
begin
  Result := '';
  i := 1;
  while i < Length(s) do begin
    if s <> ' ' then begin
      c := Chr(StrToInt('$' + Copy(s, i, 2)));
      if c = #0 then
        Exit;
      Result := Result + c;
      i := i + 3;
    end else
      i := i + 1;
  end;
end;

end.
