/[lcore]/trunk/lcoregtklaz.pas
ViewVC logotype

Contents of /trunk/lcoregtklaz.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 10 - (show annotations)
Sun Mar 30 21:39:57 2008 UTC (11 years, 7 months ago) by plugwash
File size: 3975 byte(s)
* make disabling/enabling a timer on windows reset it like on linux
* fix some line ending issues

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

Properties

Name Value
svn:executable

No admin address has been configured">No admin address has been configured
ViewVC Help
Powered by ViewVC 1.1.22