lcoregtklaz.pas

   1 { Copyright (C) 2005 Bas Steendijk and Peter Green\r
   2   For conditions of distribution and use, see copyright notice in zlib_license.txt\r
   3   which is included in the package\r
   4   ----------------------------------------------------------------------------- }\r
   5       \r
   6 unit lcoregtklaz;\r
   7 {$mode delphi}\r
   8 interface\r
   9         \r
  10 uses baseunix,unix,glib, gdk, gtk,lcore,forms,fd_utils,classes;\r
  11 //procedure lcoregtklazrun;\r
  12 const\r
  13   G_IO_IN=1;\r
  14   G_IO_OUT=4;\r
  15   G_IO_PRI=2;\r
  16   G_IO_ERR=8;\r
  17 \r
  18   G_IO_HUP=16;\r
  19   G_IO_NVAL=32;\r
  20 type\r
  21   tlaztimerwrapperinterface=class(ttimerwrapperinterface)\r
  22   public\r
  23     function createwrappedtimer : tobject;override;\r
  24 //    procedure setinitialevent(wrappedtimer : tobject;newvalue : boolean);override;\r
  25     procedure setontimer(wrappedtimer : tobject;newvalue:tnotifyevent);override;\r
  26     procedure setenabled(wrappedtimer : tobject;newvalue : boolean);override;\r
  27     procedure setinterval(wrappedtimer : tobject;newvalue : integer);override;\r
  28   end;\r
  29 \r
  30 procedure lcoregtklazinit;\r
  31 implementation\r
  32   uses\r
  33     ExtCtrls;\r
  34 {$I unixstuff.inc}\r
  35 var\r
  36   giochannels : array[0..absoloutemaxs] of pgiochannel;\r
  37 \r
  38 function iocallback(source:PGIOChannel; condition:TGIOCondition; data:gpointer):gboolean;cdecl;\r
  39 // return true if we want the callback to stay\r
  40 var\r
  41   fd                    : integer ;\r
  42   fdsrlocal , fdswlocal : fdset   ;\r
  43   currentasio           : tlasio  ;\r
  44 begin\r
  45   fd := g_io_channel_unix_get_fd(source);\r
  46   fd_zero(fdsrlocal);\r
  47   fd_set(fd,fdsrlocal);\r
  48   fdswlocal := fdsrlocal;\r
  49   select(fd+1,@fdsrlocal,@fdswlocal,nil,0);\r
  50   if fd_isset(fd,fdsrlocal) or fd_isset(fd,fdsrlocal) then begin\r
  51     currentasio := fdreverse[fd];\r
  52     if assigned(currentasio) then begin\r
  53       currentasio.handlefdtrigger(fd_isset(currentasio.fdhandlein,fdsrlocal),fd_isset(currentasio.fdhandleout,fdswlocal));\r
  54     end else begin\r
  55       rmasterclr(fd);\r
  56       wmasterclr(fd);\r
  57     end;\r
  58   end;\r
  59   case condition of\r
  60     G_IO_IN : begin\r
  61       result := rmasterisset(fd);\r
  62     end;\r
  63     G_IO_OUT : begin\r
  64       result := wmasterisset(fd);\r
  65     end;\r
  66   end;\r
  67 end;\r
  68 \r
  69 procedure gtkrmasterset(fd : integer);\r
  70 begin\r
  71   if not assigned(giochannels[fd]) then giochannels[fd] := g_io_channel_unix_new(fd);\r
  72   g_io_add_watch(giochannels[fd],G_IO_IN,iocallback,nil);\r
  73 end;\r
  74 \r
  75 procedure gtkrmasterclr(fd: integer);\r
  76 begin\r
  77 end;\r
  78   \r
  79 procedure gtkwmasterset(fd : integer);\r
  80 begin\r
  81   if not assigned(giochannels[fd]) then giochannels[fd] := g_io_channel_unix_new(fd);\r
  82   g_io_add_watch(giochannels[fd],G_IO_OUT,iocallback,nil);\r
  83 end;\r
  84 \r
  85 procedure gtkwmasterclr(fd: integer);\r
  86 begin\r
  87 end;\r
  88 \r
  89 type\r
  90   tsc = class\r
  91     procedure dotasksandsink(sender:tobject;error:word);\r
  92   end;\r
  93 var\r
  94   taskloopback : tlloopback;\r
  95   sc           : tsc;\r
  96 procedure tsc.dotasksandsink(sender:tobject;error:word);\r
  97 begin\r
  98   with tlasio(sender) do begin\r
  99     sinkdata(sender,error);\r
 100     processtasks;\r
 101   end;\r
 102 end;\r
 103 procedure gtkaddtask(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);\r
 104 begin\r
 105   taskloopback.sendstr(' ');\r
 106   \r
 107 end;\r
 108 \r
 109 procedure lcoregtklazinit;\r
 110 begin\r
 111   onrmasterset := gtkrmasterset;\r
 112   onrmasterclr := gtkrmasterclr;\r
 113   onwmasterset := gtkwmasterset;\r
 114   onwmasterclr := gtkwmasterclr;\r
 115   onaddtask := gtkaddtask;\r
 116   taskloopback := tlloopback.create(nil);\r
 117   taskloopback.ondataavailable := sc.dotasksandsink;\r
 118   timerwrapperinterface := tlaztimerwrapperinterface.create(nil);\r
 119 end;\r
 120 \r
 121 function tlaztimerwrapperinterface.createwrappedtimer : tobject;\r
 122 begin\r
 123   result := ttimer.create(nil);\r
 124 end;\r
 125 procedure tlaztimerwrapperinterface.setontimer(wrappedtimer : tobject;newvalue:tnotifyevent);\r
 126 begin\r
 127   ttimer(wrappedtimer).ontimer := newvalue;\r
 128 end;\r
 129 procedure tlaztimerwrapperinterface.setenabled(wrappedtimer : tobject;newvalue : boolean);\r
 130 begin\r
 131   ttimer(wrappedtimer).enabled := newvalue;\r
 132 end;\r
 133 \r
 134 \r
 135 procedure tlaztimerwrapperinterface.setinterval(wrappedtimer : tobject;newvalue : integer);\r
 136 begin\r
 137   ttimer(wrappedtimer).interval := newvalue;\r
 138 end;\r
 139 \r
 140 \r
 141 end.\r
 142 \r