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.
Simba Code:
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:
Simba Code:
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.