123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142 |
- { Copyright (C) 2005 Bas Steendijk and Peter Green
- For conditions of distribution and use, see copyright notice in zlib_license.txt
- which is included in the package
- ----------------------------------------------------------------------------- }
-
- unit lcoregtklaz;
- {$mode delphi}
- interface
-
- uses baseunix,unix,glib, gdk, gtk,lcore,forms,fd_utils,classes;
- //procedure lcoregtklazrun;
- const
- G_IO_IN=1;
- G_IO_OUT=4;
- G_IO_PRI=2;
- G_IO_ERR=8;
-
- G_IO_HUP=16;
- G_IO_NVAL=32;
- type
- 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;
-
- procedure lcoregtklazinit;
- implementation
- uses
- ExtCtrls;
- {$I unixstuff.inc}
- var
- giochannels : array[0..absoloutemaxs] of pgiochannel;
-
- function iocallback(source:PGIOChannel; condition:TGIOCondition; data:gpointer):gboolean;cdecl;
- // return true if we want the callback to stay
- var
- fd : integer ;
- fdsrlocal , fdswlocal : fdset ;
- currentasio : tlasio ;
- begin
- fd := g_io_channel_unix_get_fd(source);
- fd_zero(fdsrlocal);
- fd_set(fd,fdsrlocal);
- fdswlocal := fdsrlocal;
- select(fd+1,@fdsrlocal,@fdswlocal,nil,0);
- if fd_isset(fd,fdsrlocal) or fd_isset(fd,fdsrlocal) then begin
- currentasio := fdreverse[fd];
- if assigned(currentasio) then begin
- currentasio.handlefdtrigger(fd_isset(currentasio.fdhandlein,fdsrlocal),fd_isset(currentasio.fdhandleout,fdswlocal));
- end else begin
- rmasterclr(fd);
- wmasterclr(fd);
- end;
- end;
- case condition of
- G_IO_IN : begin
- result := rmasterisset(fd);
- end;
- G_IO_OUT : begin
- result := wmasterisset(fd);
- end;
- end;
- end;
-
- procedure gtkrmasterset(fd : integer);
- begin
- if not assigned(giochannels[fd]) then giochannels[fd] := g_io_channel_unix_new(fd);
- g_io_add_watch(giochannels[fd],G_IO_IN,iocallback,nil);
- end;
-
- procedure gtkrmasterclr(fd: integer);
- begin
- end;
-
- procedure gtkwmasterset(fd : integer);
- begin
- if not assigned(giochannels[fd]) then giochannels[fd] := g_io_channel_unix_new(fd);
- g_io_add_watch(giochannels[fd],G_IO_OUT,iocallback,nil);
- end;
-
- procedure gtkwmasterclr(fd: integer);
- begin
- end;
-
- type
- tsc = class
- procedure dotasksandsink(sender:tobject;error:word);
- end;
- var
- taskloopback : tlloopback;
- sc : tsc;
- procedure tsc.dotasksandsink(sender:tobject;error:word);
- begin
- with tlasio(sender) do begin
- sinkdata(sender,error);
- processtasks;
- end;
- end;
- procedure gtkaddtask(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
- begin
- taskloopback.sendstr(' ');
-
- end;
-
- procedure lcoregtklazinit;
- begin
- onrmasterset := gtkrmasterset;
- onrmasterclr := gtkrmasterclr;
- onwmasterset := gtkwmasterset;
- onwmasterclr := gtkwmasterclr;
- onaddtask := gtkaddtask;
- taskloopback := tlloopback.create(nil);
- taskloopback.ondataavailable := sc.dotasksandsink;
- timerwrapperinterface := tlaztimerwrapperinterface.create(nil);
- 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;
-
-
- end.
-
|