]> scm.dxcluster.org Git - spider.git/blob - gtkconsole/gtkconsole
2af1c4e94c6bf3fcae3658fdaf99b3703912a960
[spider.git] / gtkconsole / gtkconsole
1 #!/usr/bin/perl -w
2 #
3 # A GTK based console program
4 #
5 # usage: gtkconsole [<callsign>] [<host> <port>]
6
7 # Copyright (c) 2006-2007 Dirk Koopman G1TLH
8 #
9 # $Id$
10 #
11
12 use strict;
13
14 our $VERSION = '$Revision$';
15 $VERSION =~ s|[^\d\.]+||g;
16
17 our $root;
18
19 # search local then perl directories
20 BEGIN {
21         # root of directory tree for this system
22         $root = "/spider"; 
23         $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
24 }
25
26 use Glib;
27 use Gtk2 qw(-init);
28 use Gtk2::Helper;
29 use Gtk2::SimpleMenu;
30 use Data::Dumper;
31 use IO::File;
32
33 use Screen;
34
35 use vars qw(@modules $font);                    
36
37 @modules = ();                                  # is the list of modules that need init calling
38                                                                 # on them. It is set up by each  'use'ed module
39                                                                 # that has Gtk stuff in it
40 use IO::Socket::INET;
41
42 our @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
43
44 # various GTK handles
45 our $main;                                              # the main screen
46 our $scr_width;                                 # calculated screen dimensions
47 our $scr_height;
48 our ($dx, $cmd, $ann, $wcy, $wwv); # scrolling list windows
49 our $bot;                                               # the cmd entry window
50 our $date;                                              # the current date
51
52 require "$root/local/DXVars.pm" if -e "$root/local/DXVars.pm";
53
54 # read in the user data
55 our $userfn = "$ENV{HOME}/.gtkconsole_data";
56 our $user = read_user_data();
57 our $call;
58 our $passwd;
59 our $host;
60 our $port = 7300;
61
62
63 # read in gtkconsole file
64 #
65
66 Gtk2::Rc->set_default_files("$root/gtkconsole/gtkconsolerc", "$ENV{HOME}/.gtkconsolerc", ".gtkconsolerc");
67 Gtk2::Rc->reparse_all;
68  
69 # sort out a callsign, host and port, looking in order
70 #  1. the command line
71 #  2. any defaults in the user data;
72 #  3. poke about in any spider tree that we can find
73 #
74
75 if (@ARGV) {
76         $call = uc shift @ARGV;
77         $host = shift @ARGV if @ARGV;
78         $port = shift @ARGV if @ARGV;
79 }
80
81 unless ($call && $host) {
82         my $node = $user->{clusters}->{$user->{node}};
83         
84         if ($node->{call} || $user->{call}) {
85                 $call = $node->{call} || $user->{call} || $main::myalias;
86                 $host = $node->{passwd};
87                 $host = $node->{host};
88                 $port = $node->{port};
89         }
90 }
91
92 unless ($call && $host) {
93         if (-e "$root/local/Listeners.pm") {
94                 require  "$root/local/Listeners.pm";
95                 $host = $main::listen->[0]->[0];
96                 $port = $main::listen->[0]->[1];
97                 $host ||= '127.0.0.1';
98                 $host = "127.0.0.1" if $host eq '0.0.0.0';
99                 $port ||= 7300;
100         }
101 }
102
103 unless ($host) {
104         $host = $user->{clusters}->{$user->{node}}->{host};
105         $port = $user->{clusters}->{$user->{node}}->{port};
106 }
107
108 $call ||= '';
109 $host ||= '';
110 $port ||= '';
111 die "You need a callsign ($call), a hostname($host) and a port($port) to proceed" unless $call && $host;
112
113 #
114 # start of GTK stuff
115 #
116
117 gtk_create_main_screen();
118
119 $main->set_title("gtkconsole $VERSION - DXSpider Console - $call \@ $host:$port");
120
121 # connect and send stuff
122 my $sock = IO::Socket::INET->new(PeerAddr=>$host, PeerPort=>$port);
123 die "Cannot connect to  $/$port ($!)\n" unless $sock;
124 sendmsg($call);
125 sendmsg($passwd) if $passwd;
126 sendmsg('set/gtk');
127 sendmsg('set/page 500');
128 sendmsg('set/nobeep');
129
130 my $sock_helper = Gtk2::Helper->add_watch($sock->fileno, 'in', \&tophandler, $sock);
131  
132 # the main loop
133 $main->show_all;
134 $bot->grab_focus;
135 Gtk2->main;
136 exit(0);
137
138 #
139 # handlers
140 #
141
142 sub updatetime
143 {
144         $_[0]->set_text(cldatetime(time));
145         1;
146 }
147
148 sub bothandler
149 {
150         my ($self, $data) = @_;
151         my $msg = $self->get_text;
152         $msg =~ s/\r?\n$//;
153         $self->set_text('');
154         $self->grab_focus;
155         sendmsg($msg);
156 }
157
158 my $rbuf = '';
159
160 sub tophandler
161 {
162         my ($fd, $condx, $socket) = @_;
163
164         my $offset = length $rbuf;
165         my $l = sysread($socket, $rbuf, 1024, $offset);
166         if (defined $l) {
167                 if ($l) {
168                         while ($rbuf =~ s/^([^\015\012]*)\015?\012//) {
169                                 my $msg = $1;
170                                 handlemsg($msg);
171                         }
172                 } else {
173                         Gtk2->main_quit;
174                 }
175         } else {
176                 Gtk2->main_quit;
177         }
178         1;
179         
180 }
181
182 sub handlemsg
183 {
184         my $line = shift;
185
186         # this is truely evil and I bet there is a better way...
187         chomp $line;
188         my $list;
189         if ($line =~ /^'\w{2,4}',/) {
190                 $list = eval qq([$line]);
191         } else {
192                 $list = ['cmd', $line];
193         }
194         unless ($@) {
195                 no strict 'refs';
196                 my $cmd = shift @$list;
197                 my $handle = "handle_$cmd";
198                 if (__PACKAGE__->can($handle)) {
199                         __PACKAGE__->$handle($list);
200                 } else {
201                         unshift @$list, $cmd;
202                         __PACKAGE__->handle_def($list);
203                 }
204         }
205 }
206
207 sub handle_cmd
208 {
209         my $self = shift;
210         my $ref = shift;
211         my ($t, $ts) = (time, '');
212         my $s;
213         $s = ref $ref ? join ', ',@$ref : $ref;
214
215         if (($cmd->{lasttime}||0) != $t) {
216                 $ts = tim($t);
217                 $cmd->{lasttime} = $t;
218         }
219
220         chomp $s;
221         $cmd->add_data([$ts,  $s]);
222 }
223
224 sub handle_def
225 {
226         my $self = shift;
227         my $ref = shift;
228         my ($t, $ts) = (time, '');
229         my $s;
230         $s = ref $ref ? join(', ', @$ref) : $ref;
231         if (($cmd->{lasttime}||0) != $t) {
232                 $ts = tim($t);
233                 $cmd->{lasttime} = $t;
234         }
235         $cmd->add_data([$ts,  $s]);
236 }
237
238 sub handle_dx
239 {
240         my $self = shift;
241         my $ref = shift;
242         my ($t, $ts) = (time, '');
243
244         if (($dx->{lasttime}||0) != $t) {
245                 $ts = tim($t);
246                 $dx->{lasttime} = $t;
247         }
248         $dx->add_data([$ts,  @$ref[0,1,15,3,4,16], stim($ref->[2]) ]);
249         
250 }
251
252 sub handle_ann
253 {
254         my $self = shift;
255         my $ref = shift;
256         my ($t, $ts) = (time, '');
257         my $s;
258         $s = ref $ref ? join ', ',@$ref : $ref;
259
260         if (($ann->{lasttime}||0) != $t) {
261                 $ts = tim($t);
262                 $ann->{lasttime} = $t;
263         }
264
265         chomp $s;
266         $ann->add_data([$ts,  @$ref[3,1,2]]);
267 }
268
269 sub handle_wcy
270 {
271         my $self = shift;
272         my $ref = shift;
273         my $s;
274         $s = ref $ref ? join ', ',@$ref : $ref;
275
276         chomp $s;
277
278         $wcy->add_data([tim(),  @$ref[10,4,5,3,6,2,7,8,9,1] ]);
279 }
280
281 sub handle_wwv
282 {
283         my $self = shift;
284         my $ref = shift;
285         my $s;
286         $s = ref $ref ? join ', ',@$ref : $ref;
287
288         chomp $s;
289         $wwv->add_data([tim(),  @$ref[6,2,3,4,5,1] ]);
290 }
291
292
293
294 #
295 # subroutine
296 #
297
298 sub sendmsg
299 {
300         my $msg = shift;
301         $sock->print("$msg\n");
302 }
303
304 sub tim
305 {
306         my $t = shift || time;
307         return sprintf "%02d:%02d:%02d", (gmtime($t))[2,1,0];
308 }
309
310 sub stim
311 {
312         my $t = shift || time;
313         return sprintf "%02d:%02d", (gmtime($t))[2,1];
314 }
315
316 # get a zulu time in cluster format (2300Z)
317 sub ztime
318 {
319         my $t = shift;
320         $t = defined $t ? $t : time;
321         my $dst = shift;
322         my ($sec,$min,$hour) = $dst ? localtime($t): gmtime($t);
323         my $buf = sprintf "%02d%02d%s", $hour, $min, ($dst) ? '' : 'Z';
324         return $buf;
325 }
326
327 # get a cluster format date (23-Jun-1998)
328 sub cldate
329 {
330         my $t = shift;
331         $t = defined $t ? $t : time;
332         my $dst = shift;
333         my ($sec,$min,$hour,$mday,$mon,$year) = $dst ? localtime($t) : gmtime($t);
334         $year += 1900;
335         my $buf = sprintf "%2d-%s-%04d", $mday, $month[$mon], $year;
336         return $buf;
337 }
338
339 # return a cluster style date time
340 sub cldatetime
341 {
342         my $t = shift;
343         my $dst = shift;
344         my $date = cldate($t, $dst);
345         my $time = ztime($t, $dst);
346         return "$date $time";
347 }
348
349 sub read_user_data
350 {
351         my $u;
352         
353         if (-e $userfn) {
354                 my $fh = new IO::File $userfn;
355                 my $s = undef;
356                 if ($fh) {
357                         local $/ = undef;
358                         $s = <$fh>;
359                         $fh->close;
360                 }
361                 eval "\$u = $s";
362         }
363         unless ($u) {
364                 print "$userfn missing or unreadable, starting afresh!\n";
365                 
366                 $u = {
367                           clusters => {
368                                                    'LOCAL' => {host => '127.0.0.1', port => 7300},
369                                                    'GB7DJK' => {host => 'gb7djk.dxcluster.net', port => 7300},
370                                                    'WR3D' => {host => 'wr3d.dxcluster.net', port => 7300},
371                                                    'GB7BAA' => {host => 'gb7baa.dxcluster.net', port => 7300},
372                                                   },
373                           node => 'LOCAL',
374                           call => $main::myalias,
375                          };
376                 write_user_data($u);
377         }
378         return $u;
379 }
380
381 sub write_user_data
382 {
383         my $u = shift;
384         
385         my $fh = new IO::File ">$userfn";
386         if ($fh) {
387                 my $dd = new Data::Dumper([ $u ]);
388                 $dd->Indent(1);
389                 $dd->Terse(1);
390                 $dd->Quotekeys(0);
391                 $fh->print($dd->Dumpxs);
392                 $fh->close;
393                 return 1;
394         }
395         return 0;
396 }
397
398 sub def_menu_callback
399 {
400
401 }
402
403 sub gtk_create_main_screen
404 {
405         $main = new Gtk2::Window('toplevel');
406         my $scr = $main->get_screen;
407         $scr_width = int ($scr->get_width > 1280 ? 1280 : $scr->get_width) * 0.99;
408         $scr_height = int $scr->get_height * 0.5;
409         $main->set_default_size($scr_width, $scr_height);
410         $main->signal_connect('delete_event', sub { Gtk2->main_quit; });
411
412         # the main vbox
413         my $vbox = new Gtk2::VBox(0, 1);
414         $main->add($vbox);
415
416         my $menutree = [
417                                         _File => {
418                                                           item_type => '<Branch>',
419                                                           children => [
420                                                                                    _Quit => {
421                                                                                                          callback => sub { Gtk2->main_quit; },
422                                                                                                          callback_action => 1,
423                                                                                                          accelerator => '<ctrl>Q',
424                                                                                                         }
425                                                                                   ],
426                                                          },
427
428                                         _Help => {
429                                                           item_type => '<Branch>',
430                                                           children => [
431                                                                                    _About => {
432                                                                                                           callback_action => 9,
433                                                                                                          },
434                                                                                   ],
435                                                          },
436
437                                    ];
438         
439         my $menu = Gtk2::SimpleMenu->new(menu_tree => $menutree, default_callback => \&def_menu_callback, user_data => $user);
440         $vbox->pack_start($menu->{widget}, 0, 1, 0);
441
442
443         # a paned hbox is packed as the bottom of the vbox
444         my $bhpane = Gtk2::HPaned->new;
445         $vbox->pack_end($bhpane, 1, 1, 0);
446
447         # now create the lh and rh panes
448         my $lhvpane = Gtk2::VPaned->new;
449         my $rhvpane = Gtk2::VPaned->new;
450         $bhpane->pack1($lhvpane, 1, 0);
451         $bhpane->pack2($rhvpane, 1, 0);
452
453         #
454         # LEFT HAND SIDE
455         #
456         # The announce list
457         $ann = Screen::List->new(fields =>[
458                                                                            RxTime => 'tt',
459                                                                            From => 'tt',
460                                                                            To => 'tt',
461                                                                            Announcement => 'ttlesslong',
462                                                                           ],
463                                                          hint => 1,
464                                                          frame => 'Announcements',
465                                                          size => [$scr_width * 0.45, $scr_height * 0.33],
466                                                         );
467
468         $lhvpane->pack1($ann->widget, 1, 0);
469
470         # The command list
471         my $lhvbox = Gtk2::VBox->new(0, 1);
472         $cmd = Screen::List->new(fields => [
473                                                                                 RxTime => 'tt',
474                                                                                 Information => 'ttlong',
475                                                                            ],
476                                                          size => [$scr_width * 0.45, $scr_height * 0.66],
477                                                         );
478         $lhvbox->pack_start($cmd->widget, 1, 1, 0);
479
480
481         # callsign and current date and time
482         my $hbox = new Gtk2::HBox;
483         my $calllabel = new Gtk2::Label($call);
484         my $date = new Gtk2::Label(cldatetime(time));
485         $date->{tick} = Glib::Timeout->add(1000, \&updatetime, $date);
486         $hbox->pack_start( $calllabel, 0, 1, 0 );
487         $hbox->pack_end($date, 0, 1, 0);
488         $lhvbox->pack_start($hbox, 0, 1, 0);
489         $lhvbox->pack_start(Gtk2::HSeparator->new, 0, 1, 0);
490
491         # the bottom handler
492         $bot = new Gtk2::Entry;
493         $bot->set_editable(1);
494         $bot->signal_connect('activate', \&bothandler);
495         $bot->can_default(1);
496         $lhvbox->pack_end($bot, 0, 1, 0);
497         $lhvpane->pack2($lhvbox, 1, 0);
498         $bot->grab_default;
499
500         #
501         # RIGHT HAND SIDE
502         #
503
504         # DX window
505         $dx = Screen::List->new(fields => [
506                                                                            'RxTime' => 'tt',
507                                                                            'QRG' => 'qrg',
508                                                                            'DX Call' => 'tt',
509                                                                            'Grid' => 'tt',
510                                                                            'Remarks' => 'ttshort',
511                                                                            'By' => 'tt',
512                                                                            'Grid' => 'tt',
513                                                                            'TxTime' => 'tt',
514                                                                           ],
515                                                         policy => [qw(never automatic)],
516                                                         hint => 1,
517                                                         frame => "DX Spots",
518                                                         maxsize => 500,
519                                                         size => [$scr_width * 0.45, $scr_height * 0.45],
520                                                    );
521         $rhvpane->pack1($dx->widget, 1, 0);
522
523         # The wwv list
524         my $rhvbox = Gtk2::VBox->new(0, 1);
525         $wwv = Screen::List->new( fields =>[
526                                                                                 RxTime => 'tt',
527                                                                                 From => 'tt',
528                                                                                 SFI => 'int',
529                                                                                 A => 'int',
530                                                                                 K => 'int',
531                                                                                 Remarks => 'ttshort',
532                                                                                 Hour => 'tt'
533                                                                            ],
534                                                           hint => 1,
535                                                           policy => ['never', 'automatic'],
536                                                           frame => 'WWV Data',
537                                                         );
538         $rhvbox->pack_start($wwv->widget, 1, 1, 0);
539
540         # The wcy list
541         $wcy = Screen::List->new(fields => [
542                                                                                 RxTime => 'tt',
543                                                                                 From => 'tt',
544                                                                                 K => 'int',
545                                                                                 ExpK => 'int',
546                                                                                 A => 'int',
547                                                                                 R => 'int',
548                                                                                 SFI => 'int', 
549                                                                                 SA => 'tt',
550                                                                                 GMF => 'tt',
551                                                                                 Aurora => 'tt',
552                                                                                 Hour => 'tt' 
553                                                                            ],
554                                                          hint => 1,
555                                                          policy => ['never', 'automatic'],
556                                                          frame => 'WCY Data',
557                                                         );
558
559         $rhvbox->pack_start($wcy->widget, 1, 1, 0);
560         $rhvbox->set_size_request($scr_width * 0.45, $scr_height * 0.33);
561         $rhvpane->pack2($rhvbox, 1, 0);
562 }