]> gb7djk.dxcluster.net Git - spider.git/blob - gtkconsole/gtkconsole
554d19840466c2b21686702e1e7a3d9b793e5168
[spider.git] / gtkconsole / gtkconsole
1 #!/usr/bin/perl -w
2 #
3 # A GTK based console program
4 #
5 # Copyright (c) 2001-6 Dirk Koopman G1TLH
6 #
7 # $Id$
8 #
9
10 # search local then perl directories
11 BEGIN {
12         # root of directory tree for this system
13         $root = "/spider"; 
14         $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
15         
16         unshift @INC, "$root/perl";     # this IS the right way round!
17         unshift @INC, "$root/gtkconsole";
18         unshift @INC, "$root/local";
19 }
20
21 use strict;
22
23 use Glib;
24 use Gtk2 qw(-init);
25 use Gtk2::Helper;
26 use Gtk2::SimpleList;
27
28 use vars qw(@modules $font);                    
29
30 @modules = ();                                  # is the list of modules that need init calling
31                                                                 # on them. It is set up by each  'use'ed module
32                                                                 # that has Gtk stuff in it
33 use DXVars;
34 use DXUtil;
35 use IO::Socket::INET;
36 use Text;
37 use DebugHandler;
38
39 #
40 # main initialisation
41 #
42 my $call = uc shift @ARGV if @ARGV;
43 $call = uc $main::myalias unless $call;
44 my ($scall, $ssid) = split /-/, $call;
45 $ssid = undef unless $ssid && $ssid =~ /^\d+$/;  
46 if ($ssid) {
47         $ssid = 15 if $ssid > 15;
48         $call = "$scall-$ssid";
49 }
50
51 die "You cannot connect as your cluster callsign ($main::mycall)\n" if $call eq $main::mycall;
52
53 my $host = 'gb7djk.dxcluster.net';
54 my $port = 7300;
55
56 my $sock = IO::Socket::INET->new(PeerAddr=>$host, PeerPort=>$port);
57 die "Cannot connect to  $host/$port ($!)\n" unless $sock;
58 sendmsg('I', $call);
59 sendmsg('I', 'set/gtk');
60 #sendmsg('A', 'local');
61 #sendmsg('G', '2');
62 sendmsg('I', 'set/page 500');
63 sendmsg('I', 'set/nobeep');
64
65 #
66 # start of GTK stuff
67 #
68
69
70
71 # +--------+-------+------------------------------------------------------------------------------------+
72 # | _File  | _Help |                                                                                    |
73 # +--------+-------+------------------------------------------------------------------------------------+
74 #
75 # main window
76 my $main = new Gtk2::Window('toplevel');
77 $main->set_default_size(600, 600);
78 $main->signal_connect('delete_event', sub { Gtk2->main_quit; });
79 $main->set_title("gtkconsole - The DXSpider Console - $call");
80
81 # the main vbox
82 my $vbox = new Gtk2::VBox(0, 1);
83 $main->add($vbox);
84
85
86 # the menu bar
87 my @menu = ( 
88                         {path => '/_File', type => '<Branch>'},
89                         {path => '/_File/Quit', callback => sub {Gtk2->main_quit}},
90                         {path => '/_Help', type => '<LastBranch>'},
91                         {path => '/_Help/About'},
92                    );
93 my $itemf = new Gtk2::ItemFactory('Gtk2::MenuBar', '<main>');
94 $itemf->create_items(@menu);
95 my $menu = $itemf->get_widget('<main>');
96 $vbox->pack_start($menu, 0, 1, 0);
97
98
99 # another hbox is packed as the bottom of the vbox
100 my $bhbox = Gtk2::HBox->new(0, 1);
101 $vbox->pack_end($bhbox, 1, 1, 0);
102
103 # now pack two vboxes into the hbox
104 my $lhvbox = Gtk2::VBox->new(0, 1);
105 my $rhvbox = Gtk2::VBox->new(0, 1);
106 $bhbox->pack_start($lhvbox, 1, 1, 5);
107 $bhbox->pack_start(Gtk2::VSeparator->new, 0, 1, 0);
108 $bhbox->pack_end($rhvbox, 1, 1, 5);
109
110 # first add a column type for the QRG
111 my $font = 'monospace 10';
112 my $oddbg = 'light blue';
113 my $evenbg = 'white';
114
115 Gtk2::SimpleList->add_column_type( 'qrg',
116                      type     => 'Glib::Scalar',
117                      renderer => 'Gtk2::CellRendererText',
118                      attr     => sub {
119                           my ($treecol, $cell, $model, $iter, $col_num) = @_;
120                           my $info = $model->get ($iter, $col_num);
121                           $cell->set(text => sprintf("%.1f", $info), font => $font, xalign => 1.0);
122                      }
123                 );
124
125
126 Gtk2::SimpleList->add_column_type( 'tt',
127                      type     => 'Glib::Scalar',
128                      renderer => 'Gtk2::CellRendererText',
129                      attr     => sub {
130                           my ($treecol, $cell, $model, $iter, $col_num) = @_;
131                           my $info = $model->get ($iter, $col_num);
132                           $cell->set(text => $info, font => $font);
133                      }
134                 );
135
136
137 #
138 # LEFT HAND SIDE
139 #
140
141 # DX window
142 my $dxlist = Gtk2::SimpleList->new(
143                                                                    'RxTime' => 'tt',
144                                                                    'QRG' => 'qrg',
145                                                                    'DX Call' => 'tt',
146                                                                    'Grid' => 'tt',
147                                                                    'Remarks' => 'tt',
148                                                                    'By' => 'tt',
149                                                                    'Grid' => 'tt',
150                                                                    'TxTime' => 'tt',
151                                                                   );
152 $dxlist->set_rules_hint(1);
153 my $dxscroll = Gtk2::ScrolledWindow->new (undef, undef);
154 $dxscroll->set_shadow_type ('etched-out');
155 $dxscroll->set_policy ('never', 'automatic');
156 #$dxscroll->set_size_request (700, 400);
157 $dxscroll->add($dxlist);
158 $dxscroll->set_border_width(5);
159 $lhvbox->pack_start($dxscroll, 1, 1, 0);
160
161 # The command list
162 my $cmdlist = Gtk2::SimpleList->new(
163                                                                         RxTime => 'tt',
164                                                                         Information => 'tt',
165                                                                    );
166 my $cmdscroll = Gtk2::ScrolledWindow->new (undef, undef);
167 $cmdscroll->set_shadow_type ('etched-out');
168 $cmdscroll->set_policy ('never', 'automatic');
169 #$cmdscroll->set_size_request (700, 400);
170 $cmdscroll->add($cmdlist);
171 $cmdscroll->set_border_width(5);
172 $lhvbox->pack_start($cmdscroll, 1, 1, 0);
173
174
175 # nice little separator
176 $lhvbox->pack_start(Gtk2::HSeparator->new, 0, 1, 0 );
177
178 # callsign and current date and time
179 my $hbox = new Gtk2::HBox;
180 my $calllabel = new Gtk2::Label($call);
181 my $date = new Gtk2::Label(cldatetime(time));
182 $date->{tick} = Glib::Timeout->add(1000, \&updatetime, 0);
183 $hbox->pack_start( $calllabel, 0, 1, 0 );
184 $hbox->pack_end($date, 0, 1, 0);
185 $lhvbox->pack_start($hbox, 0, 1, 0);
186 $lhvbox->pack_start(Gtk2::HSeparator->new, 0, 1, 0);
187
188 # the bottom handler
189 my $bot = new Gtk2::Entry;
190 $bot->set_editable(1);
191 $bot->signal_connect('activate', \&bothandler);
192 $bot->can_default(1);
193 $lhvbox->pack_end($bot, 0, 1, 0);
194 $bot->grab_default;
195
196 #
197 # RIGHT HAND SIDE
198 #
199
200 # The announce list
201 my $annlist = Gtk2::SimpleList->new(
202                                                                         RxTime => 'tt',
203                                                                         From => 'tt',
204                                                                         To => 'tt',
205                                                                         Announcement => 'tt',
206                                                                    );
207 $annlist->set_rules_hint(1);
208 my $annscroll = Gtk2::ScrolledWindow->new (undef, undef);
209 $annscroll->set_shadow_type ('etched-out');
210 $annscroll->set_policy ('automatic', 'automatic');
211 #$annscroll->set_size_request (700, 400);
212 $annscroll->add($annlist);
213 $annscroll->set_border_width(5);
214 $rhvbox->pack_start($annscroll, 0, 1, 0);
215
216 # The wwv list
217 my $wwvlist = Gtk2::SimpleList->new(
218                                                                         RxTime => 'tt',
219                                                                         From => 'tt',
220                                                                         SFI => 'int',
221                                                                         A => 'int',
222                                                                         K => 'int',
223                                                                         Remarks => 'tt',
224                                                                         Hour => 'tt'
225                                                                    );
226 $wwvlist->set_rules_hint(1);
227 my $wwvscroll = Gtk2::ScrolledWindow->new (undef, undef);
228 $wwvscroll->set_shadow_type ('etched-out');
229 $wwvscroll->set_policy ('never', 'automatic');
230 #$wwvscroll->set_size_request (700, 200);
231 $wwvscroll->add($wwvlist);
232 $wwvscroll->set_border_width(5);
233 $rhvbox->pack_start($wwvscroll, 1, 1, 0);
234
235 # The wcy list
236 my $wcylist = Gtk2::SimpleList->new(
237                                                                         RxTime => 'tt',
238                                                                         From => 'tt',
239                                                                         K => 'int',
240                                                                         ExpK => 'int',
241                                                                         A => 'int',
242                                                                         R => 'int',
243                                                                         SFI => 'int', 
244                                                                         SA => 'tt',
245                                                                         GMF => 'tt',
246                                                                         Aurora => 'tt',
247                                                                         Time => 'tt'
248                                                                    );
249 $wcylist->set_rules_hint(1);
250 my $wcyscroll = Gtk2::ScrolledWindow->new (undef, undef);
251 $wcyscroll->set_shadow_type ('etched-out');
252 $wcyscroll->set_policy ('never', 'automatic');
253 #$wcyscroll->set_size_request (700, 200);
254 $wcyscroll->add($wcylist);
255 $wcyscroll->set_border_width(5);
256 $rhvbox->pack_start($wcyscroll, 1, 1, 0);
257
258 my $sock_helper = Gtk2::Helper->add_watch($sock->fileno, 'in', \&tophandler, $sock);
259  
260 # the main loop
261 $main->show_all;
262 $bot->grab_focus;
263 Gtk2->main;
264 exit(0);
265
266 #
267 # handlers
268 #
269
270 sub updatetime
271 {
272         $date->set_text(cldatetime(time));
273         1;
274 }
275
276 sub bothandler
277 {
278         my ($self, $data) = @_;
279         my $msg = $self->get_text;
280         $msg =~ s/\r?\n$//;
281         $self->set_text('');
282         $self->grab_focus;
283         senddata($msg);
284 }
285
286 my $rbuf;
287
288 sub tophandler
289 {
290         my ($fd, $condx, $socket) = @_;
291
292         my $offset = length $rbuf;
293         my $l = sysread($socket, $rbuf, 1024, $offset);
294         if (defined $l) {
295                 if ($l) {
296                         while ($rbuf =~ s/^([^\015\012]*)\015?\012//) {
297                                 my $msg = $1;
298                                 handlemsg($msg);
299                         }
300                 } else {
301                         Gtk2->main_quit;
302                 }
303         } else {
304                 Gtk2->main_quit;
305         }
306         1;
307         
308 }
309
310 sub handlemsg
311 {
312         my $line = shift;
313
314         # this is truely evil and I bet there is a better way...
315         chomp $line;
316         my $list;
317         if ($line =~ /^'\w{2,4}',/) {
318                 $list = eval qq([$line]);
319         } else {
320                 $list = ['cmd', $line];
321         }
322         unless ($@) {
323                 no strict 'refs';
324                 my $cmd = shift @$list;
325                 my $handle = "handle_$cmd";
326                 if (__PACKAGE__->can($handle)) {
327                         __PACKAGE__->$handle($list);
328                 } else {
329                         push @$list, $cmd;
330                         __PACKAGE__->handle_def($list);
331                 }
332         }
333 }
334
335 sub handle_cmd
336 {
337         my $self = shift;
338         my $ref = shift;
339         my ($t, $ts) = (time, '');
340         my $s;
341         $s = ref $ref ? join ', ',@$ref : $ref;
342
343         if (($cmdscroll->{lasttime}||0) != $t) {
344                 $ts = tim($t);
345                 $cmdscroll->{lasttime} = $t;
346         }
347
348         chomp $s;
349         push @{$cmdlist->{data}}, [$ts,  $s];
350 }
351
352 sub handle_def
353 {
354         my $self = shift;
355         my $ref = shift;
356         my $s;
357         $s = ref $ref ? join ', ',@$ref : $ref;
358         my ($t, $ts) = (time, '');
359
360         if (($cmdscroll->{lasttime}||0) != $t) {
361                 $ts = tim($t);
362                 $cmdscroll->{lasttime} = $t;
363         }
364         
365         chomp $s;
366         push @{$cmdlist->{data}}, [$ts,  $s];
367 }
368
369 sub handle_dx
370 {
371         my $self = shift;
372         my $ref = shift;
373         my ($t, $ts) = (time, '');
374
375         if (($dxscroll->{lasttime}||0) != $t) {
376                 $ts = tim($t);
377                 $dxscroll->{lasttime} = $t;
378         }
379         push @{$dxlist->{data}}, [$ts,  @$ref[0,1,15,3,4,16], stim($ref->[2]) ];
380         
381 }
382
383 sub handle_ann
384 {
385         my $self = shift;
386         my $ref = shift;
387         my ($t, $ts) = (time, '');
388         my $s;
389         $s = ref $ref ? join ', ',@$ref : $ref;
390
391         if (($annscroll->{lasttime}||0) != $t) {
392                 $ts = tim($t);
393                 $annscroll->{lasttime} = $t;
394         }
395
396         chomp $s;
397         push @{$annlist->{data}}, [$ts,  @$ref[0,1,2]];
398 }
399
400 sub handle_wcy
401 {
402         my $self = shift;
403         my $ref = shift;
404         my $s;
405         $s = ref $ref ? join ', ',@$ref : $ref;
406
407         chomp $s;
408         push @{$wcylist->{data}}, [tim(),  @$ref[10,4,5,3,6,2,7,8,9,1] ];
409 }
410
411 sub handle_wwv
412 {
413         my $self = shift;
414         my $ref = shift;
415         my $s;
416         $s = ref $ref ? join ', ',@$ref : $ref;
417
418         chomp $s;
419         push @{$wwvlist->{data}}, [tim(),  @$ref[6,2,3,4,5,1] ];
420 }
421
422 #
423 # subroutine
424 #
425
426 sub senddata
427 {
428         my $msg = shift;
429         sendmsg('I', $msg);
430 }
431
432 sub sendmsg
433 {
434         my ($let, $msg) = @_;
435 #       $msg =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg; 
436 #       $sock->print("$let$call|$msg\n");
437         $sock->print("$msg\n");
438 }
439
440 sub tim
441 {
442         my $t = shift || time;
443         return sprintf "%02d:%02d:%02d", (gmtime($t))[2,1,0];
444 }
445
446 sub stim
447 {
448         my $t = shift || time;
449         return sprintf "%02d:%02d", (gmtime($t))[2,1];
450 }