freepascal.ru

В модуле MMSystem для Delphi есть мультимедийный высокоточный таймер, есть ли в Linux аналог этого таймера? Есть ли готовая процедура запускающая этот таймер и устанавливающая вызываемую по тику таймера процедуру? Или нужно считывать тики процессора? И если нужно тогда как сделать так, чтобы через определенный интервал вызывалась процедура без создания отдельного потока?

Код: Выделить всё

  StartTime : TTimeVal;
  GetTimeOfDay(StartTime, nil);
...
  tv : TTimeVal;
  GetTimeOfDay(tv, nil);
  Result := 1000 * (tv.tv_sec - StartTime.tv_sec) + tv.tv_usec div 1000;

Крутись в цикле и вызывай нужную тебе функцию когда настанет время.

Но так нагрузка на процессор будет 100%. Можно поток создать и в нем считать время и вызывать через определенный интервал процедуру, можно даже приоритет потока понизить, но нагрузка на процессор все равно будет 100%.
Мне нужны таймеры для трехмерного движка, один для перерисовывания окна и еще несколько для запуска остановленных потоков, если нагрузка на процессор будет 100% тогда кроме отсчитывания времени ничего сложного нельзя будет считать, ни физики, ни AI.
В Windows MMTimer'ы вообще не нагружают процессор, можно ли в Linux сделать так же без нагрузки на процессор.

Кажись больше никак..
А зачем прецизионная точность в игре? У меня тож игровой движок под Линукс и в принципе хватает использования потоков и Sleep-ов...

Можно посмотреть, как реализован таймер в MSEIde изнутри, благо все в исходниках. Интервал задан в микросекундах, 1 сек = 1000000 микросекунд. Код таймера занимает 400 строк с небольшим.

Просто потоки нужно останавливать и запускать через определенный промежуток времени, если потоки будут работать все время, это будет нагружать процессор на 100% и физику например обсчитывать нужно не сколько может раз процессор в секунду, а заданное количество раз в секунду, например 20, иначе это лишняя работа для процессора и персонажи в игре будут двигаться слишком быстро, если процессор достаточно мощный.
А сделать как-то можно, в GLUT есть glutTimerFunc, правда ее нужно после каждого интервала перезапускать, но она процессор не нагружает. Правда у меня GLUT глючит, для всех SpecialKeys выдает один и тот же код, разный после каждой перезагрузки компьютера, и мышь работает не совсем правильно: считывает перемещение только по оси X, по оси Y вообще не считывает, пробовал и под стандартным ядром и под собранным, все-равно не работает.
GrayEddy
MSEIde - это ты Delphi имеешь ввиду? Там в модуле MMSystem процедуры создания таймера объявлены как external mmsyst, а mmsyst = 'winmm.dll'.

Я смотрел в МСЕ ИДЭ реализацию CommTimer (я так понял это он должен быть прецизионным). У меня правда MSE немного староватая валяеться (где-то полугодовой давности), но там вся реализация этого модуля обрамлена в {$IFDEF Windows} и используеться обычный виндовый мультимедийный таймер...

Serafim MSE IDE это среда разработки для FPC вроде Лазаруса только со своим не совместимым с Делфи ГЮИ.

FedeX писал(а):MSE немного староватая валяеться

обновляй, там раньше был только гуишный таймер а потом появился еще и работающий без гуи , возможно именно он и подойдет.

Attid, а ты можешь посмотреть, там реализация не GUI таймера для Linux есть?

Можно еще так сделать: использовать Delay из модуля Crt, только я точно не знаю как именно Delay работает, может она на время простоя так же цикл вызывает и прекращает его по истечении промежутка времени. И при использовании Delay консоль ведет себя несколько странно: все, что выводиться в консоль начинает появляться так:
сообщение 1
сообщение 2
сообщение 3
...................
сообщение N,
доходит до конца экрана консоли и вновь начинает с новой строки
сообщение N + 1
..........................

Хотя у меня fpc 2.0.2, может в этом ошибка

Добавлено спустя 2 минуты 19 секунд:
Тут пробелы не отображаются. Суть в том, что просто при включении в uses модуля Crt каждое сообщение печатаемое с новой строки начинает уходить вправо на один символ по сравнению с началом предыдущего сообщения.

Serafim писал(а):Тут пробелы не отображаются. Суть в том, что просто при включении в uses модуля Crt каждое сообщение печатаемое с новой строки начинает уходить вправо на один символ по сравнению с началом предыдущего сообщения.

есть такое и пока не лечется.

Таймер в MSEIde - негуевый.
На всякий случай приведу код. Так сказать, для беглой оценки.

Код: Выделить всё

{ MSEgui Copyright (c) 1999-2008 by Martin Schreiber

    See the file COPYING.MSE, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
}
unit msetimer;

{$ifdef FPC}{$mode objfpc}{$h+}{$interfaces corba}{$endif}

interface
uses
Classes,msetypes,mseevent,mseguiglob,mseclasses;

type
tsimpletimer = class(tnullinterfacedobject)
  private
   fenabled: boolean;
   finterval: integer;
   fontimer: notifyeventty;
   procedure setenabled(const Value: boolean);
   procedure setinterval(const Value: integer);
  protected
   procedure dotimer;
  public
   constructor create(interval: integer; ontimer: notifyeventty; active: boolean);
             //activates timer
   destructor destroy; override;
   property interval: integer read finterval write setinterval;
             //in microseconds, <= 0 -> single shot, max +-2000 seconds
             //restarts timer if active
   property ontimer: notifyeventty read fontimer write fontimer;
   property enabled: boolean read fenabled write setenabled default true;
             //last!
end;

ttimer = class(tmsecomponent)
  private
   ftimer: tsimpletimer;
   fenabled: boolean; //for design
   function getenabled: boolean;
   procedure setenabled(const avalue: boolean);
   function getinterval: integer;
   procedure setinterval(const avalue: integer);
   function getontimer: notifyeventty;
   procedure setontimer(const Value: notifyeventty);
  protected
   procedure doasyncevent(var atag: integer); override;
  public
   constructor create(aowner: tcomponent); override;
   destructor destroy; override;
  published
   property interval: integer read getinterval write setinterval default 1000000;
             //in microseconds, <= 0 -> single shot, max +-2000 seconds
             //restarts timer if enabled
   property ontimer: notifyeventty read getontimer write setontimer;
   property enabled: boolean read getenabled write setenabled default false;
             //last!
end;

procedure tick(sender: tobject);
procedure init;
procedure deinit;

implementation
uses
msesysintf,SysUtils,mseapplication,msesys,msesysutils;

const
enabletimertag = 8346320;

type
ptimerinfoty = ^timerinfoty;
timerinfoty = record
  nexttime: cardinal;
  interval: cardinal;
  prevpo,nextpo: ptimerinfoty;
  ontimer: objectprocty;
end;

var
first: ptimerinfoty;
mutex: mutexty;
rewaked: boolean;

procedure extract(po: ptimerinfoty);
          //mutex has to be locked
begin
if first = po then begin
  first:= po^.nextpo;
  if first <> nil then begin
   first^.prevpo:= nil;
  end;
end;
if po^.prevpo <> nil then begin
  po^.prevpo^.nextpo:= po^.nextpo;
end;
if po^.nextpo <> nil then begin
  po^.nextpo^.prevpo:= po^.prevpo;
end;
end;

procedure insert(po: ptimerinfoty); //mutex has to be locked
var
po1,po2: ptimerinfoty;
ca1: cardinal;
begin
ca1:= po^.nexttime;
po2:= po;
po1:= po^.nextpo;
if po1 = nil then begin
  po1:= first;
end;
// while (po1 <> nil) and (integer(po1^.nexttime-ca1) < 0) do begin //todo!!!!!: FPC bug 4768
while (po1 <> nil) and later(po1^.nexttime,ca1) do begin
  po2:= po1;
  po1:= po1^.nextpo;
end;
if po1 = nil then begin //last
  if po2 = po then begin //single
   po^.prevpo:= nil;
   first:= po;
  end
  else begin //last
   po^.prevpo:= po2;
   po2^.nextpo:= po;
  end;
  po^.nextpo:= nil;
end
else begin
  if po1^.prevpo = nil then begin //first
   po^.prevpo:= nil;
   po1^.prevpo:= po;
   first:= po;
   po^.nextpo:= po1;
  end
  else begin
   po^.prevpo:= po1^.prevpo;
   po^.prevpo^.nextpo:= po;
   po1^.prevpo:= po;
   po^.nextpo:= po1;
  end;
end;
end;

procedure killtimertick(aontimer: objectprocty);
var
po1: ptimerinfoty;
begin
sys_mutexlock(mutex);
po1:= first;
while po1 <> nil do begin
  if issamemethod(tmethod(po1^.ontimer),tmethod(aontimer)) then begin
   po1^.ontimer:= nil;
  end;
  po1:= po1^.nextpo;
end;
sys_mutexunlock(mutex);
end;

procedure starttimer(const reftime: cardinal);
var
int1: integer;
begin
int1:= first^.nexttime-reftime;
if int1 < 1000 then begin
  application.postevent(tevent.create(ek_timer));
end
else begin
  application.settimer(int1);
end;
end;

procedure settimertick(ainterval: integer; aontimer: objectprocty);
var
po: ptimerinfoty;
time: cardinal;
begin
new(po);
sys_mutexlock(mutex);
time:= sys_gettimeus;
fillchar(po^,sizeof(timerinfoty),0);
with po^ do begin
  if ainterval < 0 then begin
   nexttime:= time + cardinal(-ainterval);
   interval:= 0;
  end
  else begin
   nexttime:= time + cardinal(ainterval);
   interval:= ainterval;
  end;
  ontimer:= aontimer;
end;
insert(po);
if first = po then begin
  starttimer(time);
end
else begin
  if later(first^.nexttime,time) then begin
   rewaked:= true;
   application.postevent(tevent.create(ek_timer)); //timerevent is ev. lost
  end;
end;
sys_mutexunlock(mutex);
end;

procedure tick(sender: tobject);
var
time: cardinal;
po,po2: ptimerinfoty;
ontimer: objectprocty;
begin
sys_mutexlock(mutex);
rewaked:= false;
if first <> nil then begin
  time:= sys_gettimeus;
  po:= first;
  while (po <> nil) and laterorsame(po^.nexttime,time) do begin
   extract(po);
   ontimer:= po^.ontimer;
   po2:= po^.nextpo;
   if (po^.interval = 0) or not assigned(ontimer) then begin
                  //single shot or killed, remove item
    dispose(po);
   end
   else begin
    repeat
     inc(po^.nexttime,po^.interval)
    until later(time,po^.nexttime);
    insert(po);
   end;
   if assigned(ontimer) then begin
    try
     ontimer;
    except
     application.handleexception(sender);
    end;
   end;
   po:= po2;
  end;
  if first <> nil then begin
   starttimer(time);
  end;
end;
sys_mutexunlock(mutex);
end;

procedure init;
begin
sys_mutexcreate(mutex);
end;

procedure deinit;
var
po1,po2: ptimerinfoty;
begin
sys_mutexlock(mutex);
po1:= first;
while po1 <> nil do begin
  po2:= po1;
  po1:= po1^.nextpo;
  dispose(po2);
end;
first:= nil;
sys_mutexunlock(mutex);
sys_mutexdestroy(mutex);
end;

{ tsimpletimer }

constructor tsimpletimer.create(interval: integer; ontimer: notifyeventty;
                active: boolean);
begin
finterval:= interval;
fontimer:= ontimer;
setenabled(active);
end;

destructor tsimpletimer.destroy;
begin
enabled:= false;
inherited;
end;

procedure tsimpletimer.dotimer;
begin
if finterval <= 0 then begin
  fenabled:= false;
end;
if assigned(fontimer) then begin
  fontimer(self);
end;
end;

procedure tsimpletimer.setenabled(const Value: boolean);
begin
if fenabled <> value then begin
  sys_mutexlock(mutex);
  fenabled := Value;
  if not value then begin
   killtimertick({$ifdef FPC}@{$endif}dotimer);
  end
  else begin
   settimertick(finterval,{$ifdef FPC}@{$endif}dotimer);
  end;
  sys_mutexunlock(mutex);
end;
end;

procedure tsimpletimer.setinterval(const Value: integer);
begin
if (value > 2000000000) or (value < -2000000000) then begin
  raise exception.create('Invalid timer interval ' + inttostr(value));
end;
finterval:= Value;
if fenabled then begin
  sys_mutexlock(mutex);
  killtimertick({$ifdef FPC}@{$endif}dotimer);
  settimertick(finterval,{$ifdef FPC}@{$endif}dotimer);
  sys_mutexunlock(mutex);
end;
end;

{ ttimer }

constructor ttimer.create(aowner: tcomponent);
begin
ftimer:= tsimpletimer.create(1000000,nil,false);
inherited;
end;

destructor ttimer.destroy;
begin
ftimer.Free;
inherited;
end;

function ttimer.getenabled: boolean;
begin
if csdesigning in componentstate then begin
  result:= fenabled;
end
else begin
  result:= ftimer.enabled;
end;
end;

procedure ttimer.setenabled(const avalue: boolean);
begin
if not (csdesigning in componentstate) then begin
  if not application.ismainthread then begin
   sys_mutexlock(mutex);
   fenabled:= avalue;
   if avalue and not ftimer.enabled then begin
    asyncevent(enabletimertag); //win32 settimer must be in mainthread
    sys_mutexunlock(mutex);
   end
   else begin
    sys_mutexunlock(mutex);
    ftimer.enabled:= avalue;
   end;
  end
  else begin
   ftimer.enabled:= avalue;
  end;
end
else begin
  fenabled:= avalue;
end;
end;

procedure ttimer.doasyncevent(var atag: integer);
begin
if fenabled and (atag = enabletimertag) then begin
  ftimer.enabled:= true;
end;
end;

function ttimer.getinterval: integer;
begin
result:= ftimer.interval;
end;

procedure ttimer.setinterval(const avalue: integer);
begin
if not application.ismainthread and ftimer.enabled then begin
  enabled:= false;
  ftimer.interval:= avalue; //win32 settimer must be in main thread
  enabled:= true;
end
else begin
  ftimer.interval:= avalue;
end;
end;

function ttimer.getontimer: notifyeventty;
begin
result:= ftimer.ontimer;
end;

procedure ttimer.setontimer(const Value: notifyeventty);
begin
ftimer.ontimer:= value;
end;

end.

По моим наблюдениям, если достаточно точности до одной милисекунды - можно довериться Now() и Sleep():

Код: Выделить всё

const mm = 30;
var  a: array[0..mm] of TDateTime;
procedure TForm1.Button1Click(Sender: TObject);
var i: integer;
begin
  Memo1.Lines.Clear;
  for i:=0 to mm do begin
    Sleep(i);
    a[i]:= Now();
  end;
  For i:=1 to mm do Memo1.Lines.Add(FormatDateTime('ss.zzz', (a[i] - a[i-1])*1000.0));
end;

Вывод:
01.000
02.000
03.000
05.000
05.000
06.000
07.000
08.000
09.000
10.000
11.000
12.000
13.000
14.001
14.999
16.000
19.000
18.000
19.000
20.000
21.000
22.000
23.000
24.000
25.000
26.000
27.000
28.000
29.000
30.000

Добавлено спустя 21 минуту 26 секунд:
А рытьё в исходниках даёт

Код: Выделить всё

procedure Sleep(milliseconds: Cardinal);
Var
  timeout,timeoutresult : TTimespec;
begin
  timeout.tv_sec:=milliseconds div 1000;
  timeout.tv_nsec:=1000*1000*(milliseconds mod 1000);
  fpnanosleep(@timeout,@timeoutresult);
end;

function Now: TDateTime;
var
  SystemTime: TSystemTime;
begin
  GetLocalTime(SystemTime);
  result := systemTimeToDateTime(SystemTime);
end;


Выводы?

А выводы вот какие: Линукс по дефолту спит с высоким разрешением, без необходимости всяких извратов вроде TimeBeginPeriod(1) как в виндовсе.

Вот, хороший ответ. С выводами.
К сожалению, Линкуса у меня под рукой нет в данный момент, под Винду таймер у меня нареканий не вызывает.
Можно у debi12345 спросить, и к нему переадресовать. Можно и к самому Мартину обратиться - я подписан на новости, и вижу что он оперативно (даже очень) отвечает на вопросы.