Results 1 to 6 of 6

Thread: The time marking helper object - TTaggedTimeMarker [lape]

  1. #1
    Join Date
    May 2012
    Location
    Moscow, Russia
    Posts
    661
    Mentioned
    35 Post(s)
    Quoted
    102 Post(s)

    Default The time marking helper object - TTaggedTimeMarker [lape]

    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.
    Per aspera ad Astra!
    ----------------------------------------
    Slow and steady wins the race.

  2. #2
    Join Date
    Oct 2006
    Location
    Netherlands
    Posts
    3,285
    Mentioned
    105 Post(s)
    Quoted
    494 Post(s)

    Default

    Nice, I like your implementation over mine

    Also works with enums ^^

    Simba Code:
    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.
    Working on: Tithe Farmer

  3. #3
    Join Date
    Sep 2008
    Location
    Not here.
    Posts
    5,422
    Mentioned
    13 Post(s)
    Quoted
    242 Post(s)

    Default

    Why not add a global TTaggedTimeMarker variable?

  4. #4
    Join Date
    May 2012
    Location
    Moscow, Russia
    Posts
    661
    Mentioned
    35 Post(s)
    Quoted
    102 Post(s)

    Default

    Quote Originally Posted by tls View Post
    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
    Per aspera ad Astra!
    ----------------------------------------
    Slow and steady wins the race.

  5. #5
    Join Date
    Sep 2008
    Location
    Not here.
    Posts
    5,422
    Mentioned
    13 Post(s)
    Quoted
    242 Post(s)

    Default

    Quote Originally Posted by CynicRus View Post
    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.

  6. #6
    Join Date
    May 2012
    Location
    Moscow, Russia
    Posts
    661
    Mentioned
    35 Post(s)
    Quoted
    102 Post(s)

    Default

    Quote Originally Posted by tls View Post
    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
    Per aspera ad Astra!
    ----------------------------------------
    Slow and steady wins the race.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •