unit test_BattleSets;

{$mode objfpc}{$H+}

/// <summary>
/// FPCUnit tests for uHCLBattleSets: battleset numbers, file names, and the
/// names read from .res files.  Synthetic .res files are built with
/// uCICHCResContainer in both layouts (old: 5-byte headers with a scenario
/// index; new BSBuilder: 7-byte headers, no index), including an
/// LZH-compressed text body.
/// </summary>

interface

uses
  Classes, SysUtils, fpcunit, testregistry,
  uHCLBattleSets, uHCLCmdLineBuilder, uCICHCResContainer;

type
  TTestBattleSets = class(TTestCase)
  private
    FDir: String;
    function Bytes(const S: String): RawByteString;
    /// <summary>Writes a .res with slots 0..27: slot 26 = index (when AIndexed), slot 27 = AText.</summary>
    procedure WriteRes(const AFileName: String; const AText: RawByteString;
      AIndexed: Boolean; AIndexOffset: Integer = 0);
  protected
    procedure SetUp; override;
    procedure TearDown; override;
  published
    /// <summary>-b numbers map to the GE's files (aszBattlesets); 5 and out-of-range have none.</summary>
    procedure TestFileStems;
    /// <summary>Every number the launcher offers has a file.</summary>
    procedure TestEveryOfferedNumberHasAFile;
    /// <summary>"GIUK -- ..." names itself; padding runs become " - "; otherwise the file stem is the abbreviation.</summary>
    procedure TestSplitTitle;
    /// <summary>Old layout: the index's first entry points into the text.</summary>
    procedure TestReadTitleIndexed;
    /// <summary>New BSBuilder layout: no index, the text starts with the description.</summary>
    procedure TestReadTitleUnindexed;
    /// <summary>An LZH-compressed text body is decoded.</summary>
    procedure TestReadTitleCompressed;
    /// <summary>Missing, empty or garbage files return False without raising.</summary>
    procedure TestReadTitleFailsQuietly;
    /// <summary>Installed files supply the name (any case); otherwise the built-in name, marked not installed.</summary>
    procedure TestInfoFromDirectory;
    /// <summary>Captions: number, abbreviation, name, and "(not installed)".</summary>
    procedure TestCaption;
    /// <summary>The extension's last character is the battleset number in base 36; 0 is USNI.</summary>
    procedure TestScenarioBattleSetNumber;
  end;

implementation

const
  /// <summary>Vector 04 of the shared LZH suite: "x" + 200 x "y" + "z".</summary>
  LZH_XYZ: array[0..11] of Byte = ($04, $05, $04, $00, $61, $80, $30, $00, $27, $00, $00, $C0);

procedure TTestBattleSets.SetUp;
begin
  FDir := IncludeTrailingPathDelimiter(GetTempDir) + 'HCLBattleSets_' + IntToStr(GetTickCount64);
  ForceDirectories(FDir);
end;

procedure TTestBattleSets.TearDown;
var
  SR: TSearchRec;
begin
  if FindFirst(FDir + PathDelim + '*', faAnyFile, SR) = 0 then
  try
    repeat
      if (SR.Attr and faDirectory) = 0 then
        DeleteFile(FDir + PathDelim + SR.Name);
    until FindNext(SR) <> 0;
  finally
    FindClose(SR);
  end;
  RemoveDir(FDir);
end;

function TTestBattleSets.Bytes(const S: String): RawByteString;
begin
  SetLength(Result, Length(S));
  if S <> '' then
    Move(S[1], Result[1], Length(S));
  SetCodePage(Result, CP_NONE, False);
end;

procedure TTestBattleSets.WriteRes(const AFileName: String; const AText: RawByteString;
  AIndexed: Boolean; AIndexOffset: Integer);
var
  C: TCICResContainer;
  I: Integer;
  Index, Data: RawByteString;
  FS: TFileStream;
begin
  C := TCICResContainer.Create;
  try
    C.HeaderSize := CICResHeaderSizeForName(AFileName);
    if C.HeaderSize = HCRES_OLD_HEADER_SIZE then
      C.StructureVersion := 0;
    for I := 0 to HCRES1_SCENARIO_INDEX - 1 do
      C.Resources.Add(TCICResResource.CreateEmpty);
    if AIndexed then
    begin
      // One (u32 offset, u16 length, u16 pad) pair: the description.
      SetLength(Index, 8);
      FillChar(Index[1], 8, 0);
      Index[1] := Chr(AIndexOffset and $FF);
      Index[2] := Chr((AIndexOffset shr 8) and $FF);
      Index[5] := Chr((Length(AText) - AIndexOffset) and $FF);
      Index[6] := Chr(((Length(AText) - AIndexOffset) shr 8) and $FF);
      SetCodePage(Index, CP_NONE, False);
      C.Resources.Add(TCICResResource.CreateOf(Index, HCRES_TYPE_STD_DATA, 0, HCRES_COMPRESS_NONE));
    end
    else
      C.Resources.Add(TCICResResource.CreateEmpty);
    C.Resources.Add(TCICResResource.CreateOf(AText, HCRES_TYPE_STD_DATA, 0, HCRES_COMPRESS_NONE_RANDOM));
    Data := C.ToBytes;
  finally
    C.Free;
  end;
  FS := TFileStream.Create(FDir + PathDelim + AFileName, fmCreate);
  try
    FS.WriteBuffer(Data[1], Length(Data));
  finally
    FS.Free;
  end;
end;

procedure TTestBattleSets.TestFileStems;
begin
  AssertEquals('1', 'GIUK', HCLBattleSetFileStem(1));
  AssertEquals('2', 'NACV', HCLBattleSetFileStem(2));
  AssertEquals('4', 'IOPG', HCLBattleSetFileStem(4));
  AssertEquals('5 is unused', '', HCLBattleSetFileStem(5));
  AssertEquals('6', 'HDS1', HCLBattleSetFileStem(6));
  AssertEquals('14', 'HDS9', HCLBattleSetFileStem(14));
  AssertEquals('15', 'HDSA', HCLBattleSetFileStem(15));
  AssertEquals('26', 'HDSL', HCLBattleSetFileStem(26));
  AssertEquals('32', 'HDSR', HCLBattleSetFileStem(32));
  AssertEquals('35', 'HDSU', HCLBattleSetFileStem(35));
  AssertEquals('0', '', HCLBattleSetFileStem(0));
  AssertEquals('36', '', HCLBattleSetFileStem(36));
end;

procedure TTestBattleSets.TestEveryOfferedNumberHasAFile;
var
  I: Integer;
begin
  for I := Low(BS_INDEX_TO_ID) to High(BS_INDEX_TO_ID) do
    AssertTrue('battleset ' + IntToStr(BS_INDEX_TO_ID[I]) + ' has a file',
      HCLBattleSetFileStem(BS_INDEX_TO_ID[I]) <> '');
end;

procedure TTestBattleSets.TestSplitTitle;
var
  A, N: String;
begin
  AssertTrue(HCLSplitBattleSetTitle('GIUK -- Greenland - Iceland - United Kingdom Gap', 'GIUK', A, N));
  AssertEquals('own abbreviation', 'GIUK', A);
  AssertEquals('name', 'Greenland - Iceland - United Kingdom Gap', N);

  AssertTrue(HCLSplitBattleSetTitle('HDS1 -- HARPOON Designers'' Series BattleSet # 1         Enhanced GIUK', 'HDS1', A, N));
  AssertEquals('HDS1', 'HDS1', A);
  AssertEquals('padding becomes a separator', 'HARPOON Designers'' Series BattleSet # 1 - Enhanced GIUK', N);

  AssertTrue(HCLSplitBattleSetTitle('EC2000 Battle for the Norwegian Sea', 'HDSD', A, N));
  AssertEquals('no own abbreviation: the file stem', 'HDSD', A);
  AssertEquals('whole text', 'EC2000 Battle for the Norwegian Sea', N);

  AssertTrue(HCLSplitBattleSetTitle('Western Pacific BattleSet  WestPac', 'HDSL', A, N));
  AssertEquals('title - region', 'Western Pacific BattleSet - WestPac', N);

  AssertTrue(HCLSplitBattleSetTitle('USA  ', 'HDSU', A, N));
  AssertEquals('trailing padding dropped', 'USA', N);

  AssertTrue(HCLSplitBattleSetTitle('Line one'#13#10'  Line two', 'X', A, N));
  AssertEquals('line breaks are layout', 'Line one - Line two', N);

  AssertTrue(HCLSplitBattleSetTitle('Two Words -- are not an abbreviation', 'HDSX', A, N));
  AssertEquals('a spaced prefix is not an abbreviation', 'HDSX', A);

  AssertFalse('empty', HCLSplitBattleSetTitle('   ', 'X', A, N));
end;

procedure TTestBattleSets.TestReadTitleIndexed;
var
  T: String;
begin
  // The description sits after other text; the index points at it.
  WriteRes('GIUK.RES', Bytes('scenario 1 text'#0'GIUK -- Greenland Gap'#0), True, 16);
  AssertTrue(HCLReadBattleSetTitle(FDir + PathDelim + 'GIUK.RES', T));
  AssertEquals('up to its NUL', 'GIUK -- Greenland Gap', T);
end;

procedure TTestBattleSets.TestReadTitleUnindexed;
var
  T: String;
begin
  WriteRes('hdsl.res', Bytes('Western Pacific BattleSet  WestPac'#0'Battles in the Western Pacific'#0), False);
  AssertTrue(HCLReadBattleSetTitle(FDir + PathDelim + 'hdsl.res', T));
  AssertEquals('start of the text', 'Western Pacific BattleSet  WestPac', T);
end;

procedure TTestBattleSets.TestReadTitleCompressed;
var
  C: TCICResContainer;
  Body, Data: RawByteString;
  Res: TCICResResource;
  I: Integer;
  FS: TFileStream;
  T: String;
begin
  SetLength(Body, Length(LZH_XYZ));
  Move(LZH_XYZ[0], Body[1], Length(LZH_XYZ));
  SetCodePage(Body, CP_NONE, False);
  C := TCICResContainer.Create;
  try
    C.HeaderSize := HCRES_NEW_HEADER_SIZE;
    for I := 0 to HCRES1_SCENARIO_INDEX do
      C.Resources.Add(TCICResResource.CreateEmpty);
    Res := TCICResResource.CreateOf(Body, HCRES_TYPE_STD_DATA, 0, HCRES_COMPRESS_LZH_RANDOM);
    Res.DataSize := 202;
    C.Resources.Add(Res);
    Data := C.ToBytes;
  finally
    C.Free;
  end;
  FS := TFileStream.Create(FDir + PathDelim + 'hdsn.res', fmCreate);
  try
    FS.WriteBuffer(Data[1], Length(Data));
  finally
    FS.Free;
  end;
  AssertTrue(HCLReadBattleSetTitle(FDir + PathDelim + 'hdsn.res', T));
  AssertEquals('decoded, capped at 200', 'x' + StringOfChar('y', 199), T);
end;

procedure TTestBattleSets.TestReadTitleFailsQuietly;
var
  T: String;
  FS: TFileStream;
  Junk: RawByteString;
begin
  AssertFalse('missing', HCLReadBattleSetTitle(FDir + PathDelim + 'NOPE.RES', T));
  Junk := Bytes('this is not a resource file at all');
  FS := TFileStream.Create(FDir + PathDelim + 'JUNK.RES', fmCreate);
  try
    FS.WriteBuffer(Junk[1], Length(Junk));
  finally
    FS.Free;
  end;
  AssertFalse('garbage', HCLReadBattleSetTitle(FDir + PathDelim + 'JUNK.RES', T));
  WriteRes('HDS1.RES', Bytes(''), False);
  AssertFalse('no text', HCLReadBattleSetTitle(FDir + PathDelim + 'HDS1.RES', T));
end;

procedure TTestBattleSets.TestInfoFromDirectory;
var
  Info: THCLBattleSetInfo;
begin
  WriteRes('hdsu.res', Bytes('Kuril Islands  North Pacific'#0), False);
  Info := HCLBattleSetInfo(FDir, 35);
  AssertTrue('installed (found whatever the case)', Info.Installed);
  AssertTrue('name from the file', Info.NameFromFile);
  AssertEquals('abbreviation', 'HDSU', Info.Abbrev);
  AssertEquals('what this install has in slot 35', 'Kuril Islands - North Pacific', Info.Name);

  Info := HCLBattleSetInfo(FDir, 1);
  AssertFalse('GIUK not installed here', Info.Installed);
  AssertFalse('not from a file', Info.NameFromFile);
  AssertEquals('built-in name', 'Greenland - Iceland - United Kingdom Gap', Info.Name);

  WriteRes('HDSR.RES', Bytes(''), False);
  Info := HCLBattleSetInfo(FDir, 32);
  AssertTrue('installed', Info.Installed);
  AssertFalse('unreadable name', Info.NameFromFile);
  AssertEquals('falls back to the built-in name', 'Malacca Straits - South East Asia', Info.Name);

  Info := HCLBattleSetInfo('', 2);
  AssertEquals('no directory: built-in', 'North Atlantic Convoys', Info.Name);
  AssertEquals('number kept', 2, Info.Number);
end;

procedure TTestBattleSets.TestCaption;
var
  Info: THCLBattleSetInfo;
begin
  Info := Default(THCLBattleSetInfo);
  Info.Number := 1;
  Info.Abbrev := 'GIUK';
  Info.Name := 'Greenland - Iceland - United Kingdom Gap';
  Info.Installed := True;
  AssertEquals('installed', '1  GIUK: Greenland - Iceland - United Kingdom Gap', HCLBattleSetCaption(Info));
  Info.Installed := False;
  AssertEquals('not installed', '1  GIUK: Greenland - Iceland - United Kingdom Gap (not installed)',
    HCLBattleSetCaption(Info));
  Info.Name := '';
  AssertEquals('no name', '1  GIUK (not installed)', HCLBattleSetCaption(Info));
end;

procedure TTestBattleSets.TestScenarioBattleSetNumber;
begin
  AssertEquals('.SCm: EC2003 GIUK (HDSH)', 22, HCLScenarioBattleSetNumber('PINGER.SCm'));
  AssertEquals('HDSH', 'HDSH', HCLBattleSetFileStem(HCLScenarioBattleSetNumber('PINGER.SCm')));
  AssertEquals('.sc1: GIUK', 1, HCLScenarioBattleSetNumber('Day.sc1'));
  AssertEquals('.scq: WestPac (HDSL)', 26, HCLScenarioBattleSetNumber('WestPac1.0.scq'));
  AssertEquals('.SCa', 10, HCLScenarioBattleSetNumber('X.SCA'));
  AssertEquals('.scz: slot 35', 35, HCLScenarioBattleSetNumber('X.scz'));
  AssertEquals('.sc0: USNI', 120, HCLScenarioBattleSetNumber('X.sc0'));
  AssertEquals('saved games follow the same rule', 22, HCLScenarioBattleSetNumber('autosave.hpm'));
  AssertEquals('no extension', 0, HCLScenarioBattleSetNumber('README'));
  AssertEquals('not a digit or letter', 0, HCLScenarioBattleSetNumber('x.sc_'));
end;

initialization
  RegisterTest(TTestBattleSets);

end.