* First public version

packages/asyncio/fpasync/fpasync.inc

@@ -0,0 +1,195 @@
+{
+    $Id$
+
+    fpAsync: Asynchronous event management for Free Pascal
+    Copyright (C) 2001 by
+      Areca Systems GmbH / Sebastian Guenther, [email protected]
+
+    Common implementation
+
+    See the file COPYING.FPC, 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.
+}
+
+
+type
+  PNotifyData = ^TNotifyData;
+  TNotifyData = record
+    Next: PNotifyData;
+    Notify: TNotifyEvent;
+    Sender: TObject;
+    case Boolean of
+      False: (TimerHandle: TAsyncTimer);
+      True: (FileHandle: LongInt);
+  end;
+
+
+procedure EventHandler(Data: Pointer); cdecl;
+begin
+  with PNotifyData(Data)^ do
+    Notify(Sender);
+end;
+
+
+function AddNotifyData(Obj: TEventLoop): PNotifyData;
+begin
+  New(Result);
+  Result^.Next := PNotifyData(Obj.FFirstNotifyData);
+  Obj.FFirstNotifyData := Result;
+end;
+
+procedure FreeNotifyData(Obj: TEventLoop; Data: PNotifyData);
+var
+  CurData, PrevData, NextData: PNotifyData;
+begin
+  PrevData := nil;
+  CurData := Obj.FFirstNotifyData;
+  while Assigned(CurData) do
+  begin
+    NextData := CurData^.Next;
+    if CurData = Data then
+      if Assigned(PrevData) then
+        PrevData^.Next := NextData
+      else
+        Obj.FFirstNotifyData := NextData;
+    PrevData := CurData;
+    CurData := NextData;
+  end;
+
+  Dispose(Data);
+end;
+
+
+
+constructor TEventLoop.Create;
+begin
+  asyncInit(Handle);
+end;
+
+destructor TEventLoop.Destroy;
+var
+  NotifyData, NextNotifyData: PNotifyData;
+begin
+  asyncFree(Handle);
+  NotifyData := FFirstNotifyData;
+  while Assigned(NotifyData) do
+  begin
+    NextNotifyData := NotifyData^.Next;
+    Dispose(NotifyData);
+    NotifyData := NextNotifyData;
+  end;
+end;
+
+function TEventLoop.Handle: TAsyncHandle;
+begin
+  Result := TAsyncHandle(Self);
+end;
+
+procedure TEventLoop.Run;
+begin
+  asyncRun(Handle);
+end;
+
+procedure TEventLoop.Break;
+begin
+  asyncBreak(Handle);
+end;
+
+function TEventLoop.AddTimerCallback(AMSec: LongInt; APeriodic: Boolean;
+  ACallback: TAsyncCallback; AUserData: Pointer): TAsyncTimer;
+begin
+  Result := asyncAddTimer(Handle, AMSec, APeriodic, ACallback, AUserData);
+end;
+
+procedure TEventLoop.RemoveTimerCallback(ATimer: TAsyncTimer);
+begin
+  asyncRemoveTimer(Handle, ATimer);
+end;
+
+function TEventLoop.AddTimerNotify(AMSec: LongInt; APeriodic: Boolean;
+  ANotify: TNotifyEvent; ASender: TObject): Pointer;
+var
+  UserData: PNotifyData;
+begin
+  UserData := AddNotifyData(Self);
+  UserData^.Notify := ANotify;
+  UserData^.Sender := ASender;
+  UserData^.TimerHandle :=
+    asyncAddTimer(Handle, AMSec, APeriodic, @EventHandler, UserData);
+  Result := UserData;
+end;
+
+procedure TEventLoop.RemoveTimerNotify(AHandle: Pointer);
+var
+  Data: PNotifyData;
+begin
+  Data := PNotifyData(AHandle);
+  asyncRemoveTimer(Handle, Data^.TimerHandle);
+  FreeNotifyData(Self, Data);
+end;
+
+procedure TEventLoop.SetIOCallback(AHandle: Integer; ACallback: TAsyncCallback;
+  AUserData: Pointer);
+begin
+  asyncSetIOCallback(Handle, AHandle, ACallback, AUserData);
+end;
+
+procedure TEventLoop.ClearIOCallback(AHandle: Integer);
+begin
+  asyncClearIOCallback(Handle, AHandle);
+end;
+
+function TEventLoop.SetIONotify(AHandle: Integer; ANotify: TNotifyEvent;
+  ASender: TObject): Pointer;
+var
+  UserData: PNotifyData;
+begin
+  UserData := AddNotifyData(Self);
+  UserData^.Notify := ANotify;
+  UserData^.Sender := ASender;
+  UserData^.FileHandle := AHandle;
+  asyncSetIOCallback(Handle, AHandle, @EventHandler, UserData);
+  Result := UserData;
+end;
+
+procedure TEventLoop.ClearIONotify(AHandle: Pointer);
+var
+  Data: PNotifyData;
+begin
+  Data := PNotifyData(AHandle);
+  asyncClearIOCallback(Handle, Data^.FileHandle);
+  FreeNotifyData(Self, Data);
+end;
+
+function TEventLoop.TimerTicks: Int64;
+begin
+  Result := asyncGetTicks;
+end;
+
+function TEventLoop.GetIsRunning: Boolean;
+begin
+  Result := asyncIsRunning(Handle);
+end;
+
+procedure TEventLoop.SetIsRunning(AIsRunning: Boolean);
+begin
+  if IsRunning then
+  begin
+    if not AIsRunning then
+      Run;
+  end else
+    if AIsRunning then
+      Break;
+end;
+
+
+{
+  $Log$
+  Revision 1.1.2.1  2001-09-08 15:43:24  sg
+  * First public version
+
+}

packages/asyncio/fpasync/fpasynch.inc

@@ -0,0 +1,63 @@
+{
+    $Id$
+
+    fpAsync: Asynchronous event management for Free Pascal
+    Copyright (C) 2001 by
+      Areca Systems GmbH / Sebastian Guenther, [email protected]
+
+    Common interface
+
+    See the file COPYING.FPC, 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.
+}
+
+type
+
+  TEventLoop = class
+  private
+    FData: TAsyncData;
+    FFirstNotifyData: Pointer;
+    function GetIsRunning: Boolean;
+    procedure SetIsRunning(AIsRunning: Boolean);
+  public
+    constructor Create;
+    destructor Destroy; override;
+    function Handle: TAsyncHandle;
+
+    // Main loop control
+    procedure Run;
+    procedure Break;
+
+    // Timer support
+    function AddTimerCallback(AMSec: LongInt; APeriodic: Boolean;
+      ACallback: TAsyncCallback; AUserData: Pointer): TAsyncTimer;
+    procedure RemoveTimerCallback(ATimer: TAsyncTimer);
+    function AddTimerNotify(AMSec: LongInt; APeriodic: Boolean;
+      ANotify: TNotifyEvent; ASender: TObject): Pointer;
+    procedure RemoveTimerNotify(AHandle: Pointer);
+
+    // I/O notification support (for files, sockets etc.)
+    procedure SetIOCallback(AHandle: Integer; ACallback: TAsyncCallback;
+      AUserData: Pointer);
+    procedure ClearIOCallback(AHandle: Integer);
+    function SetIONotify(AHandle: Integer; ANotify: TNotifyEvent;
+      ASender: TObject): Pointer;
+    procedure ClearIONotify(AHandle: Pointer);
+
+    class function TimerTicks: Int64;
+
+    // Properties
+    property IsRunning: Boolean read GetIsRunning write SetIsRunning;
+  end;
+
+
+{
+  $Log$
+  Revision 1.1.2.1  2001-09-08 15:43:24  sg
+  * First public version
+
+}

packages/asyncio/fpasync/unix/fpasync.pp

@@ -0,0 +1,47 @@
+{
+    $Id$
+
+    fpAsync: Asynchronous event management for Free Pascal
+    Copyright (C) 2001 by
+      Areca Systems GmbH / Sebastian Guenther, [email protected]
+
+    Unix implementation
+
+    See the file COPYING.FPC, 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 fpAsync;
+
+{$MODE objfpc}
+
+interface
+
+uses libasync;
+
+type
+
+  TNotifyEvent = procedure(Sender: TObject) of object;
+
+{$INCLUDE fpasynch.inc}
+
+
+implementation
+
+
+{$INCLUDE fpasync.inc}
+
+
+end.
+
+
+{
+  $Log$
+  Revision 1.1.2.1  2001-09-08 15:43:24  sg
+  * First public version
+
+}

packages/asyncio/libasync/libasync.inc

@@ -0,0 +1,90 @@
+{
+    $Id$
+
+    libasync: Asynchronous event management
+    Copyright (C) 2001 by
+      Areca Systems GmbH / Sebastian Guenther, [email protected]
+
+    Common interface declaration
+
+    See the file COPYING.FPC, 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.
+}
+
+type
+  TAsyncHandleStruct = packed record
+    UserData: Pointer;
+    Data: TAsyncData;
+  end;
+  TAsyncHandle = ^TAsyncHandleStruct;
+
+  TAsyncTimer = Pointer;
+
+  TAsyncCallback = procedure(UserData: Pointer); cdecl;
+
+
+// Construction and destruction
+
+procedure asyncInit(
+  Handle: TAsyncHandle); cdecl;
+
+procedure asyncFree(
+  Handle: TAsyncHandle); cdecl;
+
+
+// Running and stopping the event loop
+
+procedure asyncRun(
+  Handle: TAsyncHandle); cdecl;
+
+procedure asyncBreak(
+  Handle: TAsyncHandle); cdecl;
+
+
+// Status information
+
+function asyncIsRunning(
+  Handle: TAsyncHandle
+  ): Boolean; cdecl;
+
+function asyncGetTicks: Int64; cdecl;
+
+
+// Timer management
+
+function asyncAddTimer(
+  Handle: TAsyncHandle;
+  MSec: LongInt;
+  Periodic: Boolean;		// False = One-shot timer, True = Periodic timer
+  Callback: TAsyncCallback;
+  UserData: Pointer		// User data for callback
+  ): TAsyncTimer; cdecl;
+
+procedure asyncRemoveTimer(
+  Handle: TAsyncHandle;
+  Timer: TASyncTimer); cdecl;
+
+
+// I/O callback management
+
+procedure asyncSetIOCallback(
+  Handle: TAsyncHandle;
+  IOHandle: LongInt;
+  Callback: TAsyncCallback;
+  UserData: Pointer); cdecl;
+
+procedure asyncClearIOCallback(
+  Handle: TAsyncHandle;
+  IOHandle: LongInt); cdecl;
+
+
+{
+  $Log$
+  Revision 1.1.2.1  2001-09-08 15:43:24  sg
+  * First public version
+
+}

packages/asyncio/libasync/unix/libasync.pp

@@ -0,0 +1,402 @@
+{
+    $Id$
+
+    libasync: Asynchronous event management
+    Copyright (C) 2001 by
+      Areca Systems GmbH / Sebastian Guenther, [email protected]
+
+    Unix implementation
+
+    See the file COPYING.FPC, 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 libasync;
+
+{$MODE objfpc}
+
+interface
+
+type
+
+  TAsyncData = record
+    IsRunning, DoBreak: Boolean;
+    FirstTimer: Pointer;
+    FirstIOCallback: Pointer;
+    FDData: Pointer;
+    HighestHandle: LongInt;
+  end;
+
+{$INCLUDE libasync.inc}
+
+
+
+implementation
+
+uses Linux;
+
+const
+  MaxHandle = SizeOf(TFDSet) * 8 - 1;
+
+type
+  PTimerData = ^TTimerData;
+  TTimerData = record
+    Next: PTimerData;
+    MSec: LongInt;
+    NextTick: Int64;
+    Callback: TAsyncCallback;
+    UserData: Pointer;
+    Periodic: Boolean;
+  end;
+
+  PIOCallbackData = ^TIOCallbackData;
+  TIOCallbackData = record
+    Next: PIOCallbackData;
+    IOHandle: LongInt;
+    ReadCallback, WriteCallback: TAsyncCallback;
+    ReadUserData, WriteUserData: Pointer;
+    SavedHandleFlags: LongInt;
+  end;
+
+
+
+procedure InitIOCallback(Handle: TAsyncHandle; IOHandle: LongInt;
+  ARead: Boolean; ReadCallback: TAsyncCallback; ReadUserData: Pointer;
+  AWrite: Boolean; WriteCallback: TAsyncCallback; WriteUserData: Pointer);
+var
+  Data: PIOCallbackData;
+  i: LongInt;
+begin
+  if IOHandle > MaxHandle then
+    exit;
+
+  Data := Handle^.Data.FirstIOCallback;
+  while Assigned(Data) do
+  begin
+    if Data^.IOHandle = IOHandle then
+    begin
+      if ARead then
+      begin
+        Data^.ReadCallback := ReadCallback;
+	Data^.ReadUserData := ReadUserData;
+      end;
+      if AWrite then
+      begin
+        Data^.WriteCallback := WriteCallback;
+	Data^.WriteUserData := WriteUserData;
+      end;
+      exit;
+    end;
+    Data := Data^.Next;
+  end;
+
+  New(Data);
+  Data^.Next := Handle^.Data.FirstIOCallback;
+  Handle^.Data.FirstIOCallback := Data;
+  Data^.IOHandle := IOHandle;
+  if ARead then
+  begin
+    Data^.ReadCallback := ReadCallback;
+    Data^.ReadUserData := ReadUserData;
+  end;
+  if AWrite then
+  begin
+    Data^.WriteCallback := WriteCallback;
+    Data^.WriteUserData := WriteUserData;
+  end;
+
+  if not Assigned(Handle^.Data.FDData) then
+  begin
+    GetMem(Handle^.Data.FDData, SizeOf(TFDSet) * 2);
+    FD_Zero(PFDSet(Handle^.Data.FDData)[0]);
+    FD_Zero(PFDSet(Handle^.Data.FDData)[1]);
+  end;
+  if IOHandle > Handle^.Data.HighestHandle then
+    Handle^.Data.HighestHandle := IOHandle;
+
+  Data^.SavedHandleFlags := fcntl(IOHandle, F_GetFl);
+  fcntl(IOHandle, F_SetFl, Data^.SavedHandleFlags or Open_NonBlock);
+
+  case IOHandle of
+    StdInputHandle:
+      i := Open_RdOnly;
+    StdOutputHandle, StdErrorHandle:
+      i := Open_WrOnly;
+    else
+      i := Data^.SavedHandleFlags and Open_Accmode;
+  end;
+
+  case i of
+    Open_RdOnly:
+      if ARead then
+        FD_Set(IOHandle, PFDSet(Handle^.Data.FDData)[0]);
+    Open_WrOnly:
+      if AWrite then
+        FD_Set(IOHandle, PFDSet(Handle^.Data.FDData)[1]);
+    Open_RdWr:
+      begin
+        if ARead then
+	  FD_Set(IOHandle, PFDSet(Handle^.Data.FDData)[0]);
+	if AWrite then
+	  FD_Set(IOHandle, PFDSet(Handle^.Data.FDData)[1]);
+      end;
+  end;
+end;
+
+
+
+
+procedure asyncInit(Handle: TAsyncHandle); cdecl;
+begin
+  Handle^.Data.HighestHandle := -1;
+end;
+
+procedure asyncFree(Handle: TAsyncHandle); cdecl;
+var
+  Timer, NextTimer: PTimerData;
+  IOCallback, NextIOCallback: PIOCallbackData;
+begin
+  Timer := PTimerData(Handle^.Data.FirstTimer);
+  while Assigned(Timer) do
+  begin
+    NextTimer := Timer^.Next;
+    Dispose(Timer);
+    Timer := NextTimer;
+  end;
+
+  IOCallback := PIOCallbackData(Handle^.Data.FirstIOCallback);
+  while Assigned(IOCallback) do
+  begin
+    if (IOCallback^.SavedHandleFlags and Open_NonBlock) = 0 then
+      fcntl(IOCallback^.IOHandle, F_SetFl, IOCallback^.SavedHandleFlags);
+    NextIOCallback := IOCallback^.Next;
+    Dispose(IOCallback);
+    IOCallback := NextIOCallback;
+  end;
+
+  if Assigned(Handle^.Data.FDData) then
+    FreeMem(Handle^.Data.FDData);
+end;
+
+procedure asyncRun(Handle: TAsyncHandle); cdecl;
+var
+  Timer, NextTimer: PTimerData;
+  TimeOut, AsyncResult: Integer;
+  CurTime, NextTick: Int64;
+  CurReadFDSet, CurWriteFDSet: TFDSet;
+  IOCallback: PIOCallbackData;
+begin
+  Handle^.Data.DoBreak := False;
+  Handle^.Data.IsRunning := True;
+
+  // Prepare timers
+  if Assigned(Handle^.Data.FirstTimer) then
+  begin
+    CurTime := asyncGetTicks;
+    Timer := Handle^.Data.FirstTimer;
+    while Assigned(Timer) do
+    begin
+      Timer^.NextTick := CurTime + Timer^.MSec;
+      Timer := Timer^.Next;
+    end;
+  end;
+
+  while not Handle^.Data.DoBreak do
+  begin
+    Timer := Handle^.Data.FirstTimer;
+    if Assigned(Handle^.Data.FirstTimer) then
+    begin
+      // Determine when the next timer tick will happen
+      CurTime := asyncGetTicks;
+      NextTick := High(Int64);
+      Timer := Handle^.Data.FirstTimer;
+      while Assigned(Timer) do
+      begin
+        if Timer^.NextTick < NextTick then
+	  NextTick := Timer^.NextTick;
+	Timer := Timer^.Next;
+      end;
+      TimeOut := NextTick - CurTime;
+      if TimeOut < 0 then
+        TimeOut := 0;
+    end else
+      TimeOut := -1;
+
+    if Handle^.Data.HighestHandle >= 0 then
+    begin
+      CurReadFDSet := PFDSet(Handle^.Data.FDData)[0];
+      CurWriteFDSet := PFDSet(Handle^.Data.FDData)[1];
+      AsyncResult := Select(Handle^.Data.HighestHandle + 1,
+        @CurReadFDSet, @CurWriteFDSet, nil, TimeOut);
+    end else
+      AsyncResult := Select(0, nil, nil, nil, TimeOut);
+
+    if Assigned(Handle^.Data.FirstTimer) then
+    begin
+      // Check for triggered timers
+      CurTime := asyncGetTicks;
+      Timer := Handle^.Data.FirstTimer;
+      while Assigned(Timer) do
+      begin
+        if Timer^.NextTick <= CurTime then
+	begin
+	  Timer^.Callback(Timer^.UserData);
+	  NextTimer := Timer^.Next;
+	  if Timer^.Periodic then
+	    Inc(Timer^.NextTick, Timer^.MSec)
+	  else
+	    asyncRemoveTimer(Handle, Timer);
+	  if Handle^.Data.DoBreak then
+	    break;
+	  Timer := NextTimer;
+	end else
+	  Timer := Timer^.Next;
+      end;
+    end;
+
+    if (AsyncResult > 0) and not Handle^.Data.DoBreak then
+    begin
+      // Check for I/O events
+      IOCallback := Handle^.Data.FirstIOCallback;
+      while Assigned(IOCallback) do
+      begin
+	if FD_IsSet(IOCallback^.IOHandle, CurReadFDSet) and
+	  FD_IsSet(IOCallback^.IOHandle, PFDSet(Handle^.Data.FDData)[0]) then
+	begin
+	  IOCallback^.ReadCallback(IOCallback^.ReadUserData);
+	  if Handle^.Data.DoBreak then
+	    break;
+	end;
+
+	if FD_IsSet(IOCallback^.IOHandle, CurWriteFDSet) and
+	  FD_IsSet(IOCallback^.IOHandle, PFDSet(Handle^.Data.FDData)[1]) then
+	begin
+	  IOCallback^.WriteCallback(IOCallback^.WriteUserData);
+	  if Handle^.Data.DoBreak then
+	    break;
+	end;
+
+	IOCallback := IOCallback^.Next;
+      end;
+    end;
+  end;
+  Handle^.Data.IsRunning := False;
+end;
+
+procedure asyncBreak(Handle: TAsyncHandle); cdecl;
+begin
+  Handle^.Data.DoBreak := True;
+end;
+
+function asyncIsRunning(Handle: TAsyncHandle): Boolean; cdecl;
+begin
+  Result := Handle^.Data.IsRunning;
+end;
+
+function asyncGetTicks: Int64; cdecl;
+var
+  Time: TimeVal;
+begin
+  GetTimeOfDay(Time);
+  Result := Int64(Time.Sec) * 1000 + Int64(Time.USec div 1000);
+end;
+
+function asyncAddTimer(
+  Handle: TAsyncHandle;
+  MSec: LongInt;
+  Periodic: Boolean;
+  Callback: TAsyncCallback;
+  UserData: Pointer
+  ): TAsyncTimer; cdecl;
+var
+  Data: PTimerData;
+begin
+  if not Assigned(Callback) then
+    exit;
+
+  New(Data);
+  Result := Data;
+  Data^.Next := Handle^.Data.FirstTimer;
+  Handle^.Data.FirstTimer := Data;
+  Data^.MSec := MSec;
+  Data^.Periodic := Periodic;
+  Data^.Callback := Callback;
+  Data^.UserData := UserData;
+  if Handle^.Data.IsRunning then
+    Data^.NextTick := asyncGetTicks + MSec;
+end;
+
+procedure asyncRemoveTimer(
+  Handle: TAsyncHandle;
+  Timer: TASyncTimer); cdecl;
+var
+  Data, CurData, PrevData, NextData: PTimerData;
+begin
+  Data := PTimerData(Timer);
+  CurData := Handle^.Data.FirstTimer;
+  PrevData := nil;
+  while Assigned(CurData) do
+  begin
+    NextData := CurData^.Next;
+    if CurData = Data then
+    begin
+      if Assigned(PrevData) then
+        PrevData^.Next := NextData
+      else
+        Handle^.Data.FirstTimer := NextData;
+      break;
+    end;
+    PrevData := CurData;
+    CurData := NextData;
+  end;
+  Dispose(Data);
+end;
+
+procedure asyncSetIOCallback(
+  Handle: TAsyncHandle;
+  IOHandle: LongInt;
+  Callback: TAsyncCallback;
+  UserData: Pointer); cdecl;
+begin
+  InitIOCallback(Handle, IOHandle, True, Callback, UserData,
+    True, Callback, UserData);
+end;
+
+procedure asyncClearIOCallback(Handle: TAsyncHandle;
+  IOHandle: LongInt); cdecl;
+var
+  CurData, PrevData, NextData: PIOCallbackData;
+begin
+  CurData := Handle^.Data.FirstTimer;
+  PrevData := nil;
+  while Assigned(CurData) do
+  begin
+    NextData := CurData^.Next;
+    if CurData^.IOHandle = IOHandle then
+    begin
+      if Assigned(PrevData) then
+        PrevData^.Next := NextData
+      else
+        Handle^.Data.FirstTimer := NextData;
+      Dispose(CurData);
+      break;
+    end;
+    PrevData := CurData;
+    CurData := NextData;
+  end;
+end;
+
+
+end.
+
+
+{
+  $Log$
+  Revision 1.1.2.1  2001-09-08 15:43:24  sg
+  * First public version
+
+}

packages/asyncio/tests/async1.pp

@@ -0,0 +1,104 @@
+{
+    $Id$
+
+    fpAsync: Asynchronous event management for Free Pascal
+    Copyright (C) 2001 by
+      Areca Systems GmbH / Sebastian Guenther, [email protected]
+
+    Test program 1: Timers
+
+    See the file COPYING.FPC, 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.
+}
+
+
+program Async1;
+
+{$MODE objfpc}
+{$H+}
+
+uses fpAsync;
+
+type
+
+  TMyApplication = class
+    EventLoop: TEventLoop;
+    procedure Timer1Event(Sender: TObject);
+    procedure Timer2Event(Sender: TObject);
+    procedure Timer3Event(Sender: TObject);
+    procedure TerminateTimerEvent(Sender: TObject);
+  protected
+    StartTimerTicks: Int64;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure Run;
+  end;
+
+
+constructor TMyApplication.Create;
+begin
+  EventLoop := TEventLoop.Create;
+  EventLoop.AddTimerNotify(500, True, @Timer1Event, nil);
+  EventLoop.AddTimerNotify(2000, True, @Timer2Event, nil);
+  EventLoop.AddTimerNotify(1200, True, @Timer3Event, nil);
+end;
+
+destructor TMyApplication.Destroy;
+begin
+  EventLoop.Free;
+  inherited Destroy;
+end;
+
+procedure TMyApplication.Run;
+begin
+  WriteLn('Will terminate in 10 seconds...');
+  EventLoop.AddTimerNotify(10000, False, @TerminateTimerEvent, nil);
+  StartTimerTicks := EventLoop.TimerTicks;
+  EventLoop.Run;
+end;
+
+procedure TMyApplication.Timer1Event(Sender: TObject);
+begin
+  WriteLn('Timer 1 after ', EventLoop.TimerTicks - StartTimerTicks, ' ms');
+end;
+
+procedure TMyApplication.Timer2Event(Sender: TObject);
+begin
+  WriteLn('Timer 2 after ', EventLoop.TimerTicks - StartTimerTicks, ' ms');
+end;
+
+procedure TMyApplication.Timer3Event(Sender: TObject);
+begin
+  WriteLn('Timer 3 after ', EventLoop.TimerTicks - StartTimerTicks, ' ms');
+end;
+
+procedure TMyApplication.TerminateTimerEvent(Sender: TObject);
+begin
+  WriteLn('Terminating');
+  EventLoop.Break;
+end;
+
+
+var
+  App: TMyApplication;
+begin
+  App := TMyApplication.Create;
+  try
+    App.Run;
+  finally
+    App.Free;
+  end;
+end.
+
+
+{
+  $Log$
+  Revision 1.1.2.1  2001-09-08 15:43:24  sg
+  * First public version
+
+}

packages/asyncio/tests/async2.pp

@@ -0,0 +1,100 @@
+{
+    $Id$
+
+    fpEvents: Asynchronous event management for Free Pascal
+    Copyright (C) 2001 by
+      Areca Systems GmbH / Sebastian Guenther, [email protected]
+
+    Test program 2: File handles
+
+    See the file COPYING.FPC, 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.
+}
+
+
+program Async2;
+
+{$MODE objfpc}
+{$H+}
+
+uses CRT, Classes, fpAsync;
+
+type
+
+  TMyApplication = class
+    EventLoop: TEventLoop;
+    procedure TimerEvent(Sender: TObject);
+    procedure KeyboardEvent(Sender: TObject);
+  protected
+    StartTimerTicks: Int64;
+    Keyboard: THandleStream;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure Run;
+  end;
+
+
+constructor TMyApplication.Create;
+begin
+  Keyboard := THandleStream.Create(StdInputHandle);
+  EventLoop := TEventLoop.Create;
+  EventLoop.AddTimerNotify(1000, True, @TimerEvent, nil);
+  EventLoop.SetIONotify(StdInputHandle, @KeyboardEvent, nil);
+end;
+
+destructor TMyApplication.Destroy;
+begin
+  EventLoop.Free;
+  Keyboard.Free;
+  inherited Destroy;
+end;
+
+procedure TMyApplication.Run;
+begin
+  WriteLn('Break with Ctrl-C...');
+  StartTimerTicks := EventLoop.TimerTicks;
+  EventLoop.Run;
+end;
+
+procedure TMyApplication.TimerEvent(Sender: TObject);
+begin
+  WriteLn('Timer tick after ', EventLoop.TimerTicks - StartTimerTicks, ' ms');
+end;
+
+procedure TMyApplication.KeyboardEvent(Sender: TObject);
+var
+  b: Byte;
+begin
+  b := Keyboard.ReadByte;
+  WriteLn('Keyboard data available: #', b, '  ', Chr(b));
+  if b = 3 then		// Ctrl-C pressed?
+  begin
+    WriteLn('Breaking...');
+    EventLoop.Break;
+  end;
+end;
+
+
+var
+  App: TMyApplication;
+begin
+  App := TMyApplication.Create;
+  try
+    App.Run;
+  finally
+    App.Free;
+  end;
+end.
+
+
+{
+  $Log$
+  Revision 1.1.2.1  2001-09-08 15:43:24  sg
+  * First public version
+
+}