//==============================================================================
//  Program for testing old code and experimenting with new code. 
//==============================================================================
program testing;

{$APPTYPE CONSOLE}

uses
    Constants,
    SysUtils,
    Classes,
    StringHash,
    JassLib,
    TextOnly,
    TextCommon,
    Windows,  // GetTickCount()
    Contnrs;   // Containers? It has collections weee :)

//==============================================================================
procedure TestHash;
var
    hash : TStringHash;
begin
    hash := TStringHash.Create();
    hash.Add('damir', 77);
    hash.Add('damir', 78);
    hash.Modify('damir', 999);
    writeln(hash.ValueOf('damir'));
    hash.Remove('damir');
    writeln(hash.ValueOf('damir'));
    writeln(hash.ValueOf('darko'));
end;

//==============================================================================
procedure TestGetLineWord;
var
    line, word : string;
    i : integer;
begin
    line := 'aaaa bbbb//cccc "uuuuu" dddd';
    i := 1;

    GetLineWord(line, word, i, i);
    writeln(word);

    GetLineWord(line, word, i, i);
    writeln(word);

    GetLineWord(line, word, i, i);
    writeln(word);

    GetLineWord(line, word, i, i);
    writeln(word);
end;

//==============================================================================
procedure TestGetLineToken;
var
    line, word : string;
    i : integer;
begin
    line := 'aaaa bbbb//cccc "uuuuu" dddd';
    i := 1;

    GetLineToken(line, word, i, i);
    writeln(word);

    GetLineToken(line, word, i, i);
    writeln(word);

    GetLineToken(line, word, i, i);
    writeln(word);

    GetLineToken(line, word, i, i);
    writeln(word);
end;

//==============================================================================
procedure TestJassLib;
begin
    JassLib.Reset();
    JassLib.parseFile('common.j');
    JassLib.parseFile('Blizzard.j');
end;

//==============================================================================
procedure TestDynamicArraySpeed;
var
    x : array of string;
    i : integer;
begin
    // almost no resize penalty if length < 2^15
    // 203 miliseconds for a million adds
    for i := 1 to 1000000 do begin
        SetLength(x, i);
        x[i-1] := IntToStr(i);
    end;
end;

//==============================================================================
procedure TestTStringListSpeed;
var
    x : TStringList;
    i : integer;
begin
    x := TStringList.Create();
    // almost no resize penalty if length < 2^15
    // 172 miliseconds for a million adds
    for i := 1 to 1000000 do begin
        x.Add(IntToStr(i));
    end;
end;

//==============================================================================
procedure TestOutParam();
var
    i:integer;
    procedure inner(out x:integer);
    begin
        writeln('TestOutParam: '+IntToStr(x));
        x := 77;
    end;
begin
    i := 6;
    inner(i);
    writeln('TestOutParam: '+IntToStr(i));
end;

//==============================================================================
//  This is so much cooler than array of string
//==============================================================================
procedure TestTStringListFunctions;
var
    x : TStringList;
    y : TStringList;
    i : integer;
begin
    x := TStringList.Create();
    y := TStringList.Create();

    x.Add('000');
    x.Add('111');
    x.Add('222');

    x.Insert(1, 'inserted');
    for i:= 0 to x.Count - 1 do writeln('x['+IntToStr(i)+']='+x[i]);
    x.Delete(1);
    writeln('');

    y.Assign(x); // Copy From
    y.Add('333');

    for i:= 0 to y.Count - 1 do writeln('y['+IntToStr(i)+']='+y[i]);
end;

//==============================================================================
procedure TestGetLineWord2;
var
    line, word : string;
    i : integer;
begin
    line := '//! library xecast';
    i := 1;

    GetLineWord(line, word, i, i);
    writeln(word);

    GetLineWord(line, word, i, i);
    writeln(word);
end;

//==============================================================================
procedure TestIntegerSize;
var
    i : integer;
begin
    i := 2147483647;
    i := i + 1;
    writeln(i);
end;

//==============================================================================
procedure testHasInitTrigPrefix;
begin
    writeln(hasInitTrigPrefix('InitTrig'));
    writeln(hasInitTrigPrefix('InitTrig_'));
    writeln(hasInitTrigPrefix('InitTrig_x'));
    writeln(hasInitTrigPrefix('InitTriga'));
    writeln(hasInitTrigPrefix('InitTriga_bcdef'));
    writeln(hasInitTrigPrefix('aInitTrig'));
    writeln(hasInitTrigPrefix('nitTrig'));
    writeln(hasInitTrigPrefix('InitTri'));
end;

//==============================================================================
procedure testTriggerNameExtractor;
begin
    writeln(extractTriggerName('InitTri'));
    writeln(extractTriggerName('// Trigger: FILE HEADER'));
    writeln(extractTriggerName('// Trigger: Table'));
    writeln(extractTriggerName('InitTrig_x'));
    writeln(extractTriggerName('// Trigger: Costs Core'));
    writeln(extractTriggerName('InitTriga_bcdef'));
    writeln(extractTriggerName('aInitTrig'));
    writeln(extractTriggerName('nitTrig'));    
end;

//==============================================================================
procedure testLineFromTESH;
begin
    writeln(lineFromTESH('//TESH.scrollpos=0'));
    writeln(lineFromTESH('//TESH.alwaysfold=0'));
    writeln(lineFromTESH('InitTrig_x'));
    writeln(lineFromTESH('InitTriga'));
    writeln(lineFromTESH('InitTriga_bcdef'));
    writeln(lineFromTESH('aInitTrig'));
    writeln(lineFromTESH('nitTrig'));
    writeln(lineFromTESH('InitTri'));
end;


//==============================================================================
//  CONCLUSIONS
//==============================================================================

// TStringList is slightly faster than dynamic string array. (not significant)
// and since using TStringList is much easier dynamic arrays go out the window.
// out and var params are the same, difference is only in syntax name.


//==============================================================================
procedure WaitForKeypress;
var
    c : char;
begin
    readln(c);
    if c = 'x' then begin
        writeln('prevents stupid c unused warning');
    end;
end;

//==============================================================================
var tick:Cardinal;
//==============================================================================
procedure TimeStatus();
begin
    Writeln('  Time: '+IntToStr(GetTickCount()-tick));
    tick := GetTickCount();
end;

//==============================================================================
//  MAIN
//==============================================================================
procedure main;
begin
    //TestHash;
    //TestGetLineWord;
    //TestGetLineToken;
    //TestJassLib;
    //TestDynamicArraySpeed;
    //TestTStringListSpeed;
    //TestOutParam;
    //TestTStringListFunctions;
    //TestGetLineWord2;
    //TestIntegerSize;
    //testHasInitTrigPrefix;
    //testTriggerNameExtractor;
    testLineFromTESH;
end;

//==============================================================================
//  BEGIN
//==============================================================================
begin
try
    tick := GetTickCount();
    main();
    TimeStatus();
except
    on e:Exception do WriteLn('Error: '+e.Message);
end;
    WaitForKeypress;
end.
