procedure is not procedure of object

[hakelm]

I need timers for non gui programs and since procedure is not procedure of object I had to introduce an otherwise unnecessary object that I can leave uninstantiated, see code below.

I feel this is a bit clumsy.
Is there a better way?

Code: Pascal  [Select][+][-]

1.  
2. program Project1;
3. {$mode objfpc}{$H+}
4. uses
5.   cthreads, Classes, sysutils, fptimer;
6. type
7.   tdummy=class (tobject)
8.   procedure ontimer(Sender: TObject);
9. end;
10. var Timer: TFPTimer;  var dumb:tdummy;
11.  
12. procedure tdummy.ontimer(Sender: TObject);
13. begin
14.    writeln('time is up');
15. end;
16.  
17. begin
18.   Timer:= TFPTimer.Create(nil);
19.   Timer.OnTimer:=@dumb.ontimer;
20.   Timer.UseTimerThread:=true;
21.   Timer.Interval:=1000;
22.   Timer.Enabled:=true;
23.   while true do begin
24.     sleep(100);
25.   end;
26. end.
27.  
28.  
29.  

[Thaddy]

Well, for one you need a message loop, not a dumb loop, if you want the timer events to be processed...... As your code stands it is never going to work.

Try this (uses a little trick for the message loop):

Code: Pascal  [Select][+][-]

1. {$mode objfpc}{$H+}
2. uses
3.   Classes, sysutils, fptimer;
4.  
5. type
6.   tdummy = class(TObject)
7.     procedure ontimer(Sender: TObject);
8.   end;
9.  
10. var
11.   Timer: TFPTimer;
12.   dumb: tdummy;
13.  
14. procedure tdummy.ontimer(Sender: TObject);
15. begin
16.   Writeln('time is up');
17. end;
18.  
19. begin
20.   dumb := tdummy.Create;
21.   Timer := TFPTimer.Create(nil);
22.   Timer.OnTimer := @dumb.ontimer;
23.   Timer.UseTimerThread := False;    // timer works on the main thread
24.   Timer.Interval := 1000;
25.   Timer.Enabled := True;
26.  
27.   // Message loop: repeatedly check for timer events
28.   while True do
29.   begin
30.     // For a TFPTimer, the timer event is triggered during
31.     // CheckSynchronize (or any other "idle" processing).
32.     CheckSynchronize;  // trick! CheckSynchronize has all the code we need
33.     Sleep(10);   // small pause to avoid busy‑wait
34.   end;
35. end.

[Fibonacci]

If you are using FPC trunk (3.3.1), you can use:

Code: Pascal  [Select][+][-]

1. {$modeswitch anonymousfunctions}
2. {$modeswitch functionreferences} // optionally
3.  
4. // ...
5.  
6. Timer.OnTimer := procedure(Sender: TObject)
7. begin
8.   writeln('time is up');
9. end;

[Thaddy]

@Fibonacci

With due respect, that ain't working without a message loop in a console application.
I added a working example, with a neat little trick, to my answer.
(btw: in mode delphi, you don't need the modeswitches: these are included)

[Xenno]

We can use a thread; preferably in a reusable unit. For example:

Code: Pascal  [Select][+][-]

1. unit uTimeoutThread;
2.  
3. ...
4.  
5. type
6.   TSimpleProc = procedure;
7.  
8.   TTimeoutThread = class(TThread)
9.   private
10.     FProcedure: TSimpleProc;
11.     FTimeoutMS: Integer;
12.   protected
13.     procedure Execute; override;
14.   public
15.     constructor Create(PrmMS: Integer; PrmPrc: TSimpleProc);
16.     destructor Destory; override;
17.   end;      
18.  
19. implementation
20.  
21. { TTimeoutThread }
22.  
23. constructor TTimeoutThread.Create(PrmMS: Integer; PrmPrc: TSimpleProc);
24. begin
25.   inherited Create(True);
26.   FreeOnTerminate := True;
27.   FTimeoutMS := PrmMS;
28.   FProcedure := PrmPrc;
29. end;          
30.  
31.  
32. destructor TTimeoutThread.Destory;
33. begin
34.   FProcedure();
35. end;    
36.  
37.  
38. procedure TTimeoutThread.Execute;
39. begin
40.   Sleep(FTimeoutMS);
41. end;  
42.  
43. end.

Usage

Code: Pascal  [Select][+][-]

1. procedure PrcTimesUp;
2. begin
3.    writeln('time is up');
4. end;
5.  
6. var
7.   MyTimeout: TTimeoutThread;
8. begin
9.   MyTimeout := TTimeoutThread.Create(1000, @PrcTimesUp);
10.   MyTimeout.Start;
11.   // or maybe:
12.   TTimeoutThread.Create(1000, @PrcTimesUp).Start;
13. end.

                   

[Thaddy]

@Xenno

WHERE IS YOUR MESSAGE LOOP

This about processing messages in a console application.
Ofcourse you can use a thread, but the TTimer already provides an option for that and it is not relevant!

That said, I have to explain my code a bit:
- normally you would write your message loop with PeekMessage / DispatchMessage on Windows and would maybe inadvertently draw in the LCL for that reason.
- CheckSynchronize is cross-platform, does the same and does not rely on the LCL

Hence the code works in console applications, but is much more lightweight than pulling in the LCL.

[Fibonacci]

@Fibonacci

With due respect, that ain't working without a message loop in a console application.

Weird, works for me

Code: Pascal  [Select][+][-]

1. program test;
2.  
3. {$mode objfpc}{$H+}
4. {$modeswitch anonymousfunctions}
5.  
6. uses SysUtils, fpTimer;
7.  
8. var
9.   Timer: TFPTimer;
10.  
11. begin
12.   Timer := TFPTimer.Create(nil);
13.   Timer.OnTimer := procedure(Sender: TObject)
14.   begin
15.     writeln('time is up');
16.   end;
17.   Timer.UseTimerThread := true;
18.   Timer.Interval := 1000;
19.   Timer.Enabled := true;
20.  
21.   while true do begin
22.     writeln('main loop');
23.     sleep(1000);
24.   end;
25. end.

[hakelm]

If you observe that there is a separate thread for the timer you may understand that the code works exactly as expected, at least with Free Pascal Compiler version 3.2.2 on Ubuntu 22:

he@x2:/home/nisse/p/hep/test/ipc$ ./clitimer
time is up
time is up
time is up
time is up
time is up
time is up
time is up
^C
he@x2:/home/nisse/p/hep/test/ipc$

My question remains, is there a more elegant solution?
H

[Thaddy]

@Fibonacci
Ah, I missed you had timerthread as true: that does a message loop indeed.
My example was using the main thread only: Timer.UseTimerThread := False

[Xenno]

@Thaddy

It is an alternative using timeout. The caller may repeat when needed; works like js's setTimeout. Sorry, for not relevant.

[cdbc]

Hi
I dunno, but this works for me:

Code: Pascal  [Select][+][-]

1.  
2. program test;
3.  
4. uses
5.   {$ifdef linux}
6.   cthreads,
7.   {$endif}
8.   sysutils, fptimer;
9.  
10. type
11.   TEventHandlers = object
12.     procedure TimerEvent(Sender: TObject);
13.   end;
14.  
15. var
16.   Count  : integer = 0;
17.  
18. procedure TEventHandlers.TimerEvent(Sender: TObject);
19. begin
20.   writeln('timer event fired');
21.   inc(count);
22. end;
23.  
24.  
25. var
26.   Events : TEventHandlers;
27.   Timer  : TFPTimer;
28.  
29.  
30. begin
31.   Timer                := TFPTimer.Create(nil);
32.   Timer.Enabled        := false;
33.   Timer.UseTimerThread := true;
34.   Timer.Interval       := 1000;
35.   Timer.OnTimer        := @Events.TimerEvent;
36.   Timer.Enabled        := true;
37.  
38.   writeln('waiting... ');
39.   while count < 5 do
40.   begin
41.     sleep(1);
42.   end;
43.  
44.   Timer.Free;
45. end.
46.  

Regards Benny

[Fred vS]

I need timers for non gui programs and since procedure is not procedure of object I had to introduce an otherwise unnecessary object that I can leave uninstantiated, see code below.
Is there a better way?

You may use TCustomApplication from CustApp:

Code: Pascal  [Select][+][-]

1. program Project1;
2. {$mode objfpc}{$H+}
3. uses
4.   cthreads, Classes, sysutils, CustApp, fptimer;
5.  
6. type
7. { TCustConsole }
8.  
9.   TcustConsole = class(TCustomApplication)
10.     private
11.       procedure ConsoleRun;
12.     protected
13.       procedure doRun;
14.       override;
15.     public
16.       procedure ontimer(Sender: TObject);  // here procedure of object.
17.       constructor Create(TheOwner: TComponent);
18.       override;
19.   end;
20.  
21. var Timer: TFPTimer;
22.        x : integer = 0;
23.  
24.  { TCustConsole }
25.  
26. procedure TCustConsole.ConsoleRun;
27. begin
28.   Timer:= TFPTimer.Create(nil);
29.   Timer.OnTimer:=@ontimer;
30.   Timer.UseTimerThread:=true;
31.   Timer.Interval:=1000;
32.   Timer.Enabled:=true;
33.   while true and (x < 5) do begin
34.     sleep(100);
35.     end;
36. end;
37.  
38. procedure TCustConsole.ontimer(Sender: TObject);
39. begin
40.    writeln('time is up');
41.    inc(x);
42. end;
43.  
44. procedure TCustConsole.doRun;
45. begin
46.    ConsoleRun;
47.    writeln('Ciao...');
48.    Timer.free;
49.    Terminate;
50. end;
51.  
52. constructor TCustConsole.Create(TheOwner: TComponent);
53. begin
54.   inherited Create(TheOwner);
55.   StopOnException := True;
56. end;
57.  
58. var
59.   Application: TCustConsole;
60. begin
61.   Application       := TCustConsole.Create(Nil);
62.   Application.Title := 'Custom Console';
63.   Application.Run;
64.   Application.Free;
65. end.

[hakelm]

For Thaddy
I have the same problem but my new unusable tongue comes from my left arm.
Cheers and just face it and sail on.

[hakelm]

Thanks,
My objective is simply to clean up some old fpc-programs. Introducing TCustomApplication would be to much work.
H

[ccrause]

I need timers for non gui programs and since procedure is not procedure of object I had to introduce an otherwise unnecessary object that I can leave uninstantiated, see code below.

There is a trick one can use: put the procedure pointer in the Code field of a TMethod record, set the Data pointer to nil (not necessary for this example, but try to be explicit anyway) then cast the record as a TNotifyEvent and assign to the event handler:

Code: Pascal  [Select][+][-]

1. program Project1;
2. {$mode objfpc}{$H+}
3. uses
4.   cthreads, Classes, SysUtils, fptimer;
5.  
6. var
7.   Timer: TFPTimer;
8.   methodHack: TMethod;
9.  
10. procedure onTimerProcedure;
11. begin
12.   writeln('time is up');
13. end;
14.  
15. begin
16.   Timer := TFPTimer.Create(nil);
17.   methodHack.Code := @onTimerProcedure;
18.   methodHack.Data := nil;
19.   Timer.OnTimer := TNotifyEvent(methodHack);
20.   Timer.UseTimerThread := True;
21.   Timer.Interval := 1000;
22.   Timer.Enabled := True;
23.   while True do
24.   begin
25.     sleep(100);
26.   end;
27. end.

Whether this is good practice is debatable, but sometimes wrapping trivial contextless handlers in a class is overkill.

Use with care.