DMDirc-Client/libwin/lcore/lcoregtklaz.pas

{ 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.