Replace obsolete/broken lcoregtklaz with new lcorelazarus

[lcore.git] / lcorelazarus.pas

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