Results 1 to 15 of 15

Thread: Multithreading with Timer

  1. #1
    Join Date
    May 2009
    Posts
    799
    Mentioned
    2 Post(s)
    Quoted
    16 Post(s)

    Default Multithreading with Timer

    Introduction:
    In this tutorial I'll be showing you how to use the TTimer object to run multiple functions or procedures at once. This is called Multithreading.

    It's very usefull when you want to create your progress report all the time the script is running, or when you just want to scan for a certain event, while a script is running.

    It's not "real" multithreading though. Because real MT typically enables you to safe Critical Sections, synchronize threads or vary the priority of a thread...

    Example Script (no timers):
    We are wanting to use an extra thread for our proggy in this script. We also want another thread, to do stuff, like "painting" a progress report or such.

    All of that will happen while our actuall script is looping the woodcutting procedures.

    SCAR Code:
    program Timers;
    var
       loadcount : integer;

    procedure proggy;
    begin
      ClearReport;
      AddToReport('Scriptname');
      AddToReport('Time Running: '+IntToStr(GetTimeRunning));
      AddToReport('Loads: '+IntToStr(loadcount));
    end;

    procedure Woodcutting;
    begin
      WriteLn('Woodcutting');
      wait(5000);
    end;

    procedure Dropping;
    begin
      WriteLn('Dropping');
      wait(5000);
    end;

    procedure mainloop;
    begin
      Woodcutting;
      Dropping;
      inc(loadcount);
    end;

    begin

      repeat
        mainloop;
       
        proggy;
      until(loadcount=10);

    end.

    Generating a Timer and calling it:
    We will generate a new form(not visible) and Create a new timer on that form. We may also apply our timer to the undetermined nil pointer, which would spare us the form, but may result in exceptions when not freed correctly.

    I hope i commented everything suffieciently. If you still got any question don't bother to ask .

    Code with timers/Multithreading:
    SCAR Code:
    program Timers;

    var
     //Timer and Form Vars
      frmDesign: TForm;
      thread1, thread2: TTimer;
     //proggy var
      loadcount : integer;

    procedure proggy;
    begin
      ClearReport;
      AddToReport('Scriptname');
      AddToReport('Time Running: '+IntToStr(GetTimeRunning));
      AddToReport('Loads: '+IntToStr(loadcount));
    end;

    //The procedure of our first thread/timer
    procedure t1(sender: TObject);
    begin
      proggy;
    end;

    //The procedure of our second thread/timer
    procedure t2(sender: TObject);
    begin
      writeln('Timer 2 Looping, painting the progress report and such');
    end;

    //Creating the Form
    procedure InitForm;
    begin
      frmDesign := CreateForm;
    end;

    //Creating the Timer
    procedure InitTimer;
    begin
      thread1 := TTimer.Create(frmDesign);
      thread2 := TTimer.Create(frmDesign);
    end;

    procedure SafeInitFormandTimer;
    var
      v: TVariantArray;
    begin
      setarraylength(v, 0);
      ThreadSafeCall('InitForm',v);
      ThreadSafeCall('InitTimer',v);
     
      //Function which is run everytime the timer loops
      thread1.OnTimer := @t1;
      //timer interval in ms
      thread1.Interval := 300;
      //enabled
      thread1.enabled := TRUE;
     
      //Same as above for the second timer/thread
      thread2.OnTimer := @t2;
      thread2.Interval := 200;
      thread2.enabled := TRUE;
    end;

    procedure Woodcutting;
    begin
      WriteLn('Woodcutting');
      wait(5000);
    end;

    procedure Dropping;
    begin
      WriteLn('Dropping');
      wait(5000);
    end;

    procedure mainloop;
    begin
      Woodcutting;
      Dropping;
      inc(loadcount);
    end;

    begin
      //Generating and setting up the timer
      SafeInitFormandTimer;
     
      repeat
        mainloop;
       
       // proggy;
      until(loadcount = 10);

      // And Freeing the memory
      FreeForm(frmDesign);
    end.

    Conclusion:
    So, this technique can be used whenever you need multiple tasks done at the "same time". Watch out that you do not write in the same var or use a function multiple times at the same time, that may cause access violations and stops the script.

    Another good thing, where a thread/timer comes in handy is, when you want your script to download a website, but you do not want the whole script to stop and wait till it's done. Or when you want to download multiple websites at once .

    If anything is unclear, feel free to ask .

    ~caused
    Last edited by caused; 10-06-2009 at 11:32 PM.

  2. #2
    Join Date
    Oct 2009
    Posts
    55
    Mentioned
    0 Post(s)
    Quoted
    0 Post(s)

    Default

    Can you give me an example of how i put an autoresponder in my script at all times plz.
    Edgville WoodCutter Version 0.0.3 is out! Get it Now! Version 0.0.3!
    Get it here:
    http://www.villavu.com/forum/showthr...110#post648110
    Yesterday is history. - Tommorrow is a Mistery. - But today is a Gift.
    (Only if it was that simple)

  3. #3
    Join Date
    May 2009
    Posts
    799
    Mentioned
    2 Post(s)
    Quoted
    16 Post(s)

    Default

    Quote Originally Posted by Zerghunter3000 View Post
    Can you give me an example of how i put an autoresponder in my script at all times plz.
    Well, you gotta read that tutorial . THan you will know what to do.

    ~caused

  4. #4
    Join Date
    Oct 2009
    Location
    Stockton, CA
    Posts
    2,040
    Mentioned
    0 Post(s)
    Quoted
    1 Post(s)

    Default

    You can also use SetTimeOut.
    Join the IRC! irc.rizon.net:6667/srl | SQLite (0.99rc3+) | SRL Doc | Simba Doc | Extra Simba Libraries (openSSL & sqlite3)
    Quote Originally Posted by #srl
    10:45 < Toter> daphil when can get sex anyday I want
    10:45 < Toter> he is always on #SRL
    "A programmer is just a tool which converts caffeine into code"

  5. #5
    Join Date
    May 2009
    Posts
    799
    Mentioned
    2 Post(s)
    Quoted
    16 Post(s)

    Default

    Hmn that is true : D... Maybe that's even a better solution. I wasn't aware that scar had such function : O

    Here's an example with SetTimeout.
    SCAR Code:
    program New;

    procedure checksomething;
    begin
       writeLn('test');
       SetTimeout(1000,'checksomething');
    end;

    begin
      SetTimeout(1000,'checksomething');
      wait(5000);
    end.
    Last edited by caused; 11-03-2009 at 03:30 PM.

  6. #6
    Join Date
    Feb 2007
    Location
    Access Violation at 0x00000000
    Posts
    2,865
    Mentioned
    3 Post(s)
    Quoted
    18 Post(s)

    Default

    I only got the TTimers xD
    Explain the SetTimeouts to me tho.

    This is something I'm going to use if I ever write a script, though.

    edit;
    SCAR seems to crash fatally when you pause a script while the threads are running...
    Ce ne sont que des gueux


  7. #7
    Join Date
    Oct 2009
    Location
    Stockton, CA
    Posts
    2,040
    Mentioned
    0 Post(s)
    Quoted
    1 Post(s)

    Default

    Maybe a Try Except will fix it? Probably not though.
    Join the IRC! irc.rizon.net:6667/srl | SQLite (0.99rc3+) | SRL Doc | Simba Doc | Extra Simba Libraries (openSSL & sqlite3)
    Quote Originally Posted by #srl
    10:45 < Toter> daphil when can get sex anyday I want
    10:45 < Toter> he is always on #SRL
    "A programmer is just a tool which converts caffeine into code"

  8. #8
    Join Date
    Feb 2007
    Location
    Access Violation at 0x00000000
    Posts
    2,865
    Mentioned
    3 Post(s)
    Quoted
    18 Post(s)

    Default

    SCAR Code:
    Program New;

    Var
      MyNumber, MyNumber2, StartTime, PauseTime : Integer;
      Stop : Boolean;
      frmDesign : TForm;
      Threads : Array Of TTimer;

    Procedure DoNumber(Sender : TObject);
    Var
      i : Integer;
    Begin
      Inc(MyNumber);
      i := MyNumber;
      WriteLn('Thread[1] :: Inc :: '+ IntToStr(i));
      If MyNumber = 10 Then
        Stop := True;
    End;

    Procedure DoNumber2(Sender : TObject);
    Var
      i : Integer;
    Begin
      Dec(MyNumber2);
      i := MyNumber2;
      WriteLn('Thread[2] :: Dec :: '+ IntToStr(i));
      If MyNumber2 = 0 Then
        Stop := True;
    End;

    Procedure ShowTimeRunning(Sender : TObject);
    Var
      i : Integer;
    Begin
      i := (GetSystemTime - StartTime - PauseTime);
      Disguise('Thread[0] :: Time Running :: '+ IntToStr(i) +' ms');
    End;

    Procedure ScriptPause;
    Var
      i : Integer;
    Begin
      For i := 0 To High(Threads) Do
        Threads[i].Enabled := False;
      Disguise('Thread[3] :: SCRIPT PAUSED!');
      PauseTime := GetSystemTime;
    End;

    Procedure ScriptResume;
    Var
      i : Integer;
    Begin
      For i := 0 To High(Threads) Do
        Threads[i].Enabled := True;
      Disguise('Thread[3] :: SCRIPT RESUMED!');
      PauseTime := (GetSystemTime - PauseTime);
    End;

    Procedure InitForm;
    Begin
      frmDesign := CreateForm;
    End;

    Procedure InitTimer;
    Var
      i : Integer;
    Begin
      For i := 0 To High(Threads) Do
        Threads[i] := TTimer.Create(frmDesign);
    End;

    Procedure SafeInitAll;
    Var
      v : TVariantArray;
    Begin
      SetArrayLength(v, 0);
      ThreadSafeCall('InitForm', v);
      ThreadSafeCall('InitTimer', v);

      Threads[0].OnTimer := @ShowTimeRunning;
      Threads[0].Interval := 1;
      Threads[0].Enabled := True;

      Threads[1].OnTimer := @DoNumber;
      Threads[1].Interval := 1000;
      Threads[1].Enabled := True;

      Threads[2].OnTimer := @DoNumber2;
      Threads[2].Interval := 1001;
      Threads[2].Enabled := True;
    End;

    Begin
      SetArrayLength(Threads, 3);
      MyNumber2 := 10;
      StartTime := GetSystemTime;
      SafeInitAll;
      Repeat
        MoveMouse(Random(500), Random(500));
        Wait(100);
      Until(Stop);
      WriteLn('We stopped!');
    End.

    Try running that a few times repeatedly. It seems to get all glitchy and stop somewhere in the middle without saying 'We stopped!'

    The script is supposed to;
    1)
    Count up from 0-10
    2)
    Count down from 10-0
    3)
    Keep track of the time in MS

    at the same time, while the mouse is moving in a random 500x500 box, using TTimers.

    EDIT:
    Updated the script with ScriptPause/Resume.
    Ce ne sont que des gueux


  9. #9
    Join Date
    Sep 2006
    Posts
    6,089
    Mentioned
    77 Post(s)
    Quoted
    43 Post(s)

    Default

    Quote Originally Posted by Floor66 View Post
    I only got the TTimers xD
    Explain the SetTimeouts to me tho.

    This is something I'm going to use if I ever write a script, though.

    edit;
    SCAR seems to crash fatally when you pause a script while the threads are running...
    Use ScriptPause and ScriptResume to pause/resume the timer.

  10. #10
    Join Date
    Feb 2007
    Location
    Access Violation at 0x00000000
    Posts
    2,865
    Mentioned
    3 Post(s)
    Quoted
    18 Post(s)

    Default

    Wth I can't use ScriptPause? Gives me an Unknown Identifier...

    EDIT:
    Oh shit, I forgot... That's not how it works

    EDIT2:
    Got it
    SCAR Code:
    Procedure ScriptPause;
    Var
      i : Integer;
    Begin
      For i := 0 To High(Threads) Do
        Threads[i].Enabled := False;
      Disguise('Thread[3] :: SCRIPT PAUSED!');
      PauseTime := GetSystemTime;
    End;

    Procedure ScriptResume;
    Var
      i : Integer;
    Begin
      For i := 0 To High(Threads) Do
        Threads[i].Enabled := True;
      Disguise('Thread[3] :: SCRIPT RESUMED!');
      PauseTime := (GetSystemTime - PauseTime);
    End;

    EDIT2:
    Added 'PauseTime' so it can be subtracted from the total, so you'd get a genuine RUNtime count.
    But still, if you play it a few times after eachother it glitches sometimes and quits somewhere randomly
    Ce ne sont que des gueux


  11. #11
    Join Date
    Dec 2011
    Posts
    249
    Mentioned
    0 Post(s)
    Quoted
    1 Post(s)

    Default

    Can we still use this in scripts? Iv tryed but cant seem to get it working

  12. #12
    Join Date
    Sep 2007
    Location
    British Columbia, Canada
    Posts
    4,047
    Mentioned
    1 Post(s)
    Quoted
    2 Post(s)

    Default

    am sure you can still do this pesudo multithreading, just have a function, but write it as a boolean or integer, and make while running the first function, run the second function.
    Oh Hai Dar

  13. #13
    Join Date
    Oct 2011
    Posts
    805
    Mentioned
    21 Post(s)
    Quoted
    152 Post(s)

    Default

    Just created this:

    Simba Code:
    program Timers;

    {$i SRL/SRL.simba}

    var

      frmDesign: TForm;
      RandomCheck: TTimer;

      a: integer;



    procedure t1(sender: TObject);
    begin
      //FindNormalRandoms;
      writeln('checking for randoms');
    end;


    //Creating the Form
    procedure InitForm;
    begin
      frmDesign := CreateForm;

      RandomCheck := TTimer.Create(frmDesign);

      With RandomCheck do
      begin
        //Function which is run everytime the timer loops
        RandomCheck.OnTimer := @t1;
        //timer interval in ms
        RandomCheck.Interval := 2000;
        //enabled
        RandomCheck.enabled := TRUE;
      end;
    end;


    procedure SafeInitFormandTimer;
    var
      v: TVariantArray;
    begin
      setarraylength(v, 0);
      ThreadSafeCall('InitForm',v);
    end;


    begin

      SafeInitFormandTimer;
        for a:= 1 to 20 do
        begin
          writeln('Do something');

          wait (500);
        end;
      writeln(timerunning);
      FreeForm(frmDesign);
    end.



    I didn't test it in real script yet . I'm a bit afraid it can crash something.

    What happens if Timer call his procedure (t1) in the middle of other function ,like FindColors. For example FindColors have already scanned half of screen ,then Timer is called and interupts it. After Timer's procedure ends FindColors will continue it's work ( scans remaining half od screen) or will crash?

  14. #14
    Join Date
    Nov 2011
    Posts
    1,589
    Mentioned
    9 Post(s)
    Quoted
    17 Post(s)

    Default

    Quote Originally Posted by beginner5 View Post
    Just created this:

    Simba Code:
    program Timers;

    {$i SRL/SRL.simba}

    var

      frmDesign: TForm;
      RandomCheck: TTimer;

      a: integer;



    procedure t1(sender: TObject);
    begin
      //FindNormalRandoms;
      writeln('checking for randoms');
    end;


    //Creating the Form
    procedure InitForm;
    begin
      frmDesign := CreateForm;

      RandomCheck := TTimer.Create(frmDesign);

      With RandomCheck do
      begin
        //Function which is run everytime the timer loops
        RandomCheck.OnTimer := @t1;
        //timer interval in ms
        RandomCheck.Interval := 2000;
        //enabled
        RandomCheck.enabled := TRUE;
      end;
    end;


    procedure SafeInitFormandTimer;
    var
      v: TVariantArray;
    begin
      setarraylength(v, 0);
      ThreadSafeCall('InitForm',v);
    end;


    begin

      SafeInitFormandTimer;
        for a:= 1 to 20 do
        begin
          writeln('Do something');

          wait (500);
        end;
      writeln(timerunning);
      FreeForm(frmDesign);
    end.



    I didn't test it in real script yet . I'm a bit afraid it can crash something.

    What happens if Timer call his procedure (t1) in the middle of other function ,like FindColors. For example FindColors have already scanned half of screen ,then Timer is called and interupts it. After Timer's procedure ends FindColors will continue it's work ( scans remaining half od screen) or will crash?
    With this if you try any function say FindNormalRandoms it ends the script.



    ^^

  15. #15
    Join Date
    Feb 2006
    Posts
    3,044
    Mentioned
    4 Post(s)
    Quoted
    21 Post(s)

    Default

    Timers doesn't work currently on Simba.

    ~Home

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
  •