X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/21410d99e1361e5474a47bb0bd0bc6e939f91b7d..7b8a26e75924ecff47d3e347eb4e2685656c728e:/lcorelazarus.pas?ds=inline

diff --git a/lcorelazarus.pas b/lcorelazarus.pas
new file mode 100644
index 0000000..d347703
--- /dev/null
+++ b/lcorelazarus.pas
@@ -0,0 +1,166 @@
+{ Copyright (C) 2005-2017 Robin Green, Bas Steendijk, Peter Green
+  For conditions of distribution and use, see copyright notice in zlib_license.
+txt
+  which is included in the package
+  -----------------------------------------------------------------------------
+}
+
+unit lcorelazarus;
+{$mode delphi}
+interface
+
+uses
+  lcore,
+  Classes, SysUtils,Forms,fd_utils,LCLIntf,InterfaceBase,ExtCtrls;
+
+
+procedure lcoreinit;
+
+implementation
+const
+  absolutemaxs_select = (sizeof(fdset)*8)-1;
+
+var
+  fdreverse:array[0..absolutemaxs_select] of tlasio;
+  fdEventHandlers:array[0..absolutemaxs_select] of PEventHandler;
+  fdflags:array[0..absolutemaxs_select] of byte;
+  tasksoutstanding : boolean;
+type
+  tlazaruseventcore=class(teventcore)
+  public
+    procedure processmessages; override;
+    procedure messageloop; override;
+    procedure exitmessageloop;override;
+    procedure setfdreverse(fd : integer;reverseto : tlasio); override;
+    procedure rmasterset(fd : integer;islistensocket : boolean); override;
+    procedure rmasterclr(fd: integer); override;
+    procedure wmasterset(fd : integer); override;
+    procedure wmasterclr(fd: integer); override;
+    procedure WaitHandleEvent(AData: PtrInt; AFlags: dword);
+    procedure taskcb(Data: PtrInt);
+  end;
+
+  tlaztimerwrapperinterface=class(ttimerwrapperinterface)
+  public
+    function createwrappedtimer : tobject;override;
+//    procedure setinitialevent(wrappedtimer : tobject;newvalue : boolean);override;
+    procedure setontimer(wrappedtimer : tobject;newvalue:tnotifyevent);override;
+    procedure setenabled(wrappedtimer : tobject;newvalue : boolean);override;
+    procedure setinterval(wrappedtimer : tobject;newvalue : integer);override;
+  end;
+const
+  G_IO_IN  = 1;
+  G_IO_OUT = 4;
+
+procedure tlazaruseventcore.taskcb(Data: PtrInt);
+begin
+
+   tasksoutstanding := false;
+   processtasks;
+end;
+
+procedure tlazaruseventcore.WaitHandleEvent(AData: PtrInt; AFlags: dword);
+var lasio:tlasio;
+begin
+   lasio:=fdreverse[AData];
+   if lasio<>nil then lasio.handlefdtrigger((AFlags and G_IO_IN)<>0,(AFlags and G_IO_OUT)<>0);
+end;
+
+procedure tlazaruseventcore.processmessages;
+begin
+   Application.ProcessMessages;
+end;
+procedure tlazaruseventcore.messageloop;
+begin
+   Application.Run;
+end;
+procedure tlazaruseventcore.exitmessageloop;
+begin
+   Application.Terminate;
+end;
+procedure tlazaruseventcore.setfdreverse(fd : integer;reverseto : tlasio);
+begin
+  fdreverse[fd] := reverseto;
+
+end;
+procedure addfdflags(fd : integer;flags:byte);
+begin
+   fdflags[fd]:=fdflags[fd] or flags;
+   if fdEventHandlers[fd]=nil then  begin
+      fdEventHandlers[fd]:=AddEventHandler(fd,flags,tlazaruseventcore(eventcore).WaitHandleEvent,fd);
+   end else begin
+
+      SetEventHandlerFlags(fdEventHandlers[fd], fdflags[fd]);
+   end;
+end;
+
+procedure removefdflags(fd : integer;flags:byte);
+begin
+   if fdEventHandlers[fd]<>nil then  begin
+      fdflags[fd]:=fdflags[fd] and (not flags);
+      if fdflags[fd]=0 then begin
+         RemoveEventHandler(fdEventHandlers[fd]);
+         fdEventHandlers[fd]:=nil;
+      end else begin
+
+         SetEventHandlerFlags(fdEventHandlers[fd], fdflags[fd]);
+      end;
+   end;
+end;
+
+procedure tlazaruseventcore.rmasterset(fd : integer;islistensocket : boolean);
+begin
+   addfdflags(fd,G_IO_IN);
+end;
+procedure tlazaruseventcore.rmasterclr(fd: integer);
+begin
+   removefdflags(fd,G_IO_IN);
+end;
+procedure tlazaruseventcore.wmasterset(fd : integer);
+begin
+   addfdflags(fd,G_IO_OUT);
+
+end;
+procedure tlazaruseventcore.wmasterclr(fd: integer);
+begin
+   removefdflags(fd,G_IO_OUT);
+end;
+
+procedure lazaddtask(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
+begin
+  if not tasksoutstanding then  Application.QueueAsyncCall(tlazaruseventcore(eventcore).taskcb,0);
+  tasksoutstanding := true;
+end;
+
+function tlaztimerwrapperinterface.createwrappedtimer : tobject;
+begin
+  result := ttimer.create(nil);
+end;
+procedure tlaztimerwrapperinterface.setontimer(wrappedtimer : tobject;newvalue:tnotifyevent);
+begin
+  ttimer(wrappedtimer).ontimer := newvalue;
+end;
+procedure tlaztimerwrapperinterface.setenabled(wrappedtimer : tobject;newvalue : boolean);
+begin
+  ttimer(wrappedtimer).enabled := newvalue;
+end;
+
+
+procedure tlaztimerwrapperinterface.setinterval(wrappedtimer : tobject;newvalue : integer);
+begin
+  ttimer(wrappedtimer).interval := newvalue;
+end;
+var
+  inited:boolean;
+procedure lcoreinit;
+begin
+  if (inited) then exit;
+  eventcore := tlazaruseventcore.create;
+  onaddtask := lazaddtask;
+
+  absolutemaxs := absolutemaxs_select;
+  inited := true;
+end;
+
+end.
+