The time marking helper object - TTaggedTimeMarker [lape]

[CynicRus]

Just the wrapper for time marking routines. Based on TTimeMarker from SRL. This may be usefull when you want a use multiple timers in script without a bunch of variables.


const
APaused = 'Already paused';
type
TMarkedTime = record
tag: string;
time, startTime, __prevMark: UInt64;
paused: Boolean;
end;

TMarkedTimeArray = array of TMarkedTime;
TMarkedTimeList = record
FList: TMarkedTimeArray;
end;

TTaggedTimeMarker = record
FInfo: TMarkedTimeList;
end;

procedure TMarkedTime.Init(aTag: string);
begin
Self.paused := False;
Self.time := 0;
Self.startTime := getTickCount64();
Self.__prevMark := 0;
Self.tag:= aTag;
end;

procedure TMarkedTime.Reset();
begin
Self.paused := False;
Self.time := 0;
Self.startTime := getTickCount64();
Self.__prevMark := 0;
end;

procedure TMarkedTime.start();
begin
Self.__prevMark := getTickCount64();
if (not Self.paused) then
begin
Self.startTime := getTickCount64();
Self.time := 0;
end;
Self.paused := False;
end;

procedure TMarkedTime.Pause;
begin
if not Self.paused then
begin
Self.time := Self.time + (getTickCount64() - Self.__prevMark);
Self.paused := True;
end else
WriteLn(APaused);
end;

function TMarkedTime.GetTime(): int64;
begin
if not Self.paused then
Result := Self.time + (getTickCount64() - Self.__prevMark)
else
Result := Self.time;
end;

function TMarkedTime.GetTotalTime(): int64;
begin
if (Self.startTime > 0) then
Result := getTickCount64() - Self.startTime;
end;

procedure TMarkedTimeList.Init;
begin
SetLEngth(FList, 0);
end;

procedure TMarkedTimeList.Destroy;
begin
SetLEngth(FList, 0);
end;

function TMarkedTimeList.GetCount: integer;
begin
result := Length(Flist);
end;

function TMarkedTimeList.GetItem(Index: Integer): TMarkedTime;
begin
if (Index >= 0) and (Index < GetCount()) then
Result := FList[Index];
end;

procedure TMarkedTimeList.SetItem(Index: integer; aItem: TMarkedTime);
begin
if Index <=GetCount() then
FList[Index] := aItem;
end;

procedure TMarkedTimeList.Add(aItem: TMarkedTime);
var
len: integer;
begin
len := Length(FList);
SetLength(FList, len + 1);
FList[len] := aItem;
end;

function TMarkedTimeList.Remove(const Idx: Integer; const Count: Integer): Integer;
var
I, J, L, M, F: Integer;
begin
L := Length(Flist);
if (Idx >= L) or (Idx + Count <= 0) or (L = 0) or (Count = 0) then
begin
Result := 0;
exit;
end;
I := Max(Idx, 0);
J := Min(Count, L - I);
M := L - J - I;
for F := 0 to M - 1 do
FList[I + F] := FList[I + J + F];
SetLength(FList, L - J);
Result := J;
end;

function TMarkedTimeList.IndexOf(aTag: string): Integer;
var
I, len: Integer;
begin
len := GetCount();
for I := 0 to len - 1 do
if FList[i].Tag = aTag then
begin
Result := I;
Exit;
end;
Result := - 1;
end;
(*
TTaggedTimeMarker.Init
~~~~~~~~~~~~~~~~~

.. code-block pascal

procedure TTaggedTimeMarker.Init;

Constuctor TTaggedTimeMarker object.

.. note::

- by Cynic

Example:

.. code-block:: pascal

MyTaggedTimeMarker.Init;
*)
procedure TTaggedTimeMarker.Init;
begin
FInfo.Init;
end;
(*
TTaggedTimeMarker.Init
~~~~~~~~~~~~~~~~~

.. code-block pascal

procedure TTaggedTimeMarker.Destroy;

Destructor TTaggedTimeMarker object.

.. note::

- by Cynic

Example:

.. code-block:: pascal

MyTaggedTimeMarker.Destroy;
*)
procedure TTaggedTimeMarker.Destroy;
begin
FInfo.Destroy;
end;
(*
TTaggedTimeMarker.Start
~~~~~~~~~~~~~~~~~

.. code-block pascal

procedure TTaggedTimeMarker.start(Tag: string);

Create and starts the timer with tag as timer name. Can also be used when paused to continue where it left.

.. note::

- by Bart de Boer, Cynic

Example:

.. code-block:: pascal

MyTaggedTimeMarker.start('My first timer');
*)
procedure TTaggedTimeMarker.Start(Tag: string);
var
MarkedTime: TMarkedTime;
ElemIndex: integer;
begin
ElemIndex := FInfo.IndexOf(Tag);
if (ElemIndex > - 1) then
begin
MarkedTime := FInfo.GetItem(ElemIndex);
MarkedTime.Start();
FInfo.SetItem(ElemIndex,MarkedTime);
end
else
begin
MarkedTime.Init(Tag);
MarkedTime.Start();
FInfo.Add(MarkedTime);
end;
end;

(*
TTaggedTimeMarker.RemoveTimer
~~~~~~~~~~~~~~~~~

.. code-block pascal

procedure TTaggedTimeMarker.RemoveTimer(tag: string);

Remove the timer by tag..

.. note::

- by Bart de Boer, Cynic

Example:

.. code-block:: pascal

MyTaggedTimeMarker.RemoveTimer('My first timer');
*)
procedure TTaggedTimeMarker.RemoveTimer(Tag: string);
var
MarkedTime: TMarkedTime;
ElemIndex: integer;
begin
ElemIndex := FInfo.IndexOf(Tag);
if (ElemIndex > - 1) then
FInfo.Remove(ElemIndex,1) else
begin
WriteLn(Format('Item with tag = %s not found!', [tag]));
TerminateScript;
end;
end;

(*
TTaggedTimeMarker.GetTotalTime
~~~~~~~~~~~~~~~~~~~~~~~~

.. code-block pascal

function TTaggedTimeMarker.GetTotalTime(Tag: string): int64;

Gets the time from the timer by tag including the time it was paused.

.. note::

- by Bart de Boer, Cynic

Example:

.. code-block:: pascal

BreakTime := MyTaggedTimeMarker.getTotalTime('My first timer') - MyTaggedTimeMarker.getTime('My first timer');

*)
function TTaggedTimeMarker.GetTotalTime(Tag: string): int64;
var
MarkedTime: TMarkedTime;
ElemIndex: integer;
begin
result:=-1;
ElemIndex := FInfo.IndexOf(Tag);
if (ElemIndex > - 1) then
begin
MarkedTime := FInfo.GetItem(ElemIndex);
result:=MarkedTime.GetTotalTime;
end
else
begin
WriteLn(Format('Item with tag = %s not found!', [tag]));
TerminateScript;
end;
end;
(*
TTaggedTimeMarker.Pause
~~~~~~~~~~~~~~~~~

.. code-block pascal

procedure TTaggedTimeMarker.pause(tag: string);

Pauses the timer by tag. It can be continued with start(tag).

.. note::

- by Bart de Boer, Cynic

Example:

.. code-block:: pascal

MyTaggedTimeMarker.pause('My first timer');
TakeABreak(90000);
MyTaggedTimeMarker.start('My first timer');
*)
procedure TTaggedTimeMarker.Pause(Tag: string);
var
MarkedTime: TMarkedTime;
ElemIndex: integer;
begin
ElemIndex := FInfo.IndexOf(Tag);
if (ElemIndex > - 1) then
begin
MarkedTime := FInfo.GetItem(ElemIndex);
MarkedTime.Pause;
FInfo.SetItem(ElemIndex,MarkedTime);
end
else
begin
WriteLn(Format('Item with tag = %s not found!', [tag]));
TerminateScript;
end;
end;
(*
TTaggedTimeMarker.Reset
~~~~~~~~~~~~~~~~~

.. code-block pascal

procedure TTaggedTimeMarker.reset(Tag: string);

Stops the timer and resets it to zero by tag.

.. note::

- by Bart de Boer, Cynic

Example:

.. code-block:: pascal

MyTaggedTimeMarker.Reset('My first timer');
*)
procedure TTaggedTimeMarker.Reset(Tag: string);
var
MarkedTime: TMarkedTime;
ElemIndex: integer;
begin
ElemIndex := FInfo.IndexOf(Tag);
if (ElemIndex > - 1) then
begin
MarkedTime := FInfo.GetItem(ElemIndex);
MarkedTime.Reset;
FInfo.SetItem(ElemIndex,MarkedTime);
end
else
begin
WriteLn(Format('Item with tag = %s not found!', [tag]));
TerminateScript;
end;
end;
(*
TTaggedTimeMarker.GetTime
~~~~~~~~~~~~~~~~~~~

.. code-block pascal

function TTaggedTimeMarker.GetTime(): int64;

Gets the time from the timer. Returns zero if the timer was not set.

.. note::

- by by Bart de Boer, Cynic

Example:

.. code-block:: pascal

MyTaggedTimeMarker.start('My first timer');
repeat
DoStuff;
until(MyTaggedTimeMarker.GetTime('My first timer') > 60000);

*)
function TTaggedTimeMarker.GetTime(Tag: string): int64;
var
MarkedTime: TMarkedTime;
ElemIndex: integer;
begin
result:=-1;
ElemIndex := FInfo.IndexOf(Tag);
if (ElemIndex > - 1) then
begin
MarkedTime := FInfo.GetItem(ElemIndex);
result:=MarkedTime.GetTime;
end
else
begin
WriteLn(Format('Item with tag = %s not found!', [tag]));
TerminateScript;
end;
end;


Test script:
var
MyMarker: TTaggedTimeMarker;
begin
MyMArker.Init;
try
MyMarker.Start('first_timer');
MyMarker.Start('second_timer');
MyMarker.Start('third_timer');
while (MyMarker.GetTime('first_timer') <= 400) do
begin
WriteLn('First timer: ' + ToStr(MyMarker.GetTotalTime('first_timer')));
WriteLn('Second timer: ' + ToStr(MyMarker.GetTotalTime('second_timer')));
WriteLn('Third timer: ' + ToStr(MyMarker.GetTotalTime('third_timer')));
end;
finally
MyMarker.Destroy;
end;

Cheers,
Cynic.

[masterBB]

Nice, I like your implementation over mine ;)

Also works with enums ^^

type
MyTimers = (ScriptTimer, MineTimer, WalkTimer);

var
MyMarker: TTaggedTimeMarker;

begin
MyMarker.Init;
MyMarker.Start(ToStr(ScriptTimer));
MyMarker.Start(ToStr(MineTimer));
MyMarker.Start(ToStr(WalkTimer));
while (MyMarker.GetTime(ToStr(ScriptTimer)) <= 400) do
begin
WriteLn('First timer: ' + ToStr(MyMarker.GetTotalTime(ToStr(ScriptTimer))));
WriteLn('Second timer: ' + ToStr(MyMarker.GetTotalTime(ToStr(MineTimer))));
WriteLn('Third timer: ' + ToStr(MyMarker.GetTotalTime(ToStr(WalkTimer))));
end;
MyMarker.Destroy;
end.

[tls]

Why not add a global TTaggedTimeMarker variable?

[CynicRus]

Why not add a global TTaggedTimeMarker variable?
What do you mean? TTaggedTimeMarker is an object, in you script you can use that as you wish:)

[tls]

What do you mean? TTaggedTimeMarker is an object, in you script you can use that as you wish:)

I'm assuming it would be added to a library...and it would make sense to just have one of them per script-scope.

[CynicRus]

I'm assuming it would be added to a library...and it would make sense to just have one of them per script-scope.

Well, if someone needs it, then somebody will do it:)