3 # A GTK based console program
5 # usage: gtkconsole [<callsign>] [<host> <port>]
7 # Copyright (c) 2006-2007 Dirk Koopman G1TLH
16 # search local then perl directories
18 # root of directory tree for this system
20 $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
32 use vars qw(@modules $font);
34 @modules = (); # is the list of modules that need init calling
35 # on them. It is set up by each 'use'ed module
36 # that has Gtk stuff in it
39 our @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
42 our $main; # the main screen
43 our $scr_width; # calculated screen dimensions
45 our ($dx, $cmd, $ann, $wcy, $wwv, $chat); # scrolling list windows
46 our $bot; # the cmd entry window
47 our $date; # the current date
50 our $annwin; # the announcement window handle
51 our $dxwin; # the dx spot window handle
52 our $wwvwin; # wwv window handle
53 our $wcywin; # wcy window handle
54 our $chatwin; # chat window handle
56 require "$root/local/DXVars.pm" if -e "$root/local/DXVars.pm";
58 our ($version, $subversion, $build);
59 require "$root/perl/Version.pm";
61 our $VERSION = "$version.$subversion build $build";
63 # read in the user data
64 our $userfn = "$ENV{HOME}/.gtkconsole_data";
65 our $user = read_user_data();
68 our $host = 'localhost';
72 # read in gtkconsole file
75 Gtk2::Rc->set_default_files("$root/gtkconsole/gtkconsolerc", "$ENV{HOME}/.gtkconsolerc", ".gtkconsolerc");
76 Gtk2::Rc->reparse_all;
78 # sort out a callsign, host and port, looking in order
80 # 2. any defaults in the user data;
81 # 3. poke about in any spider tree that we can find
85 $call = uc shift @ARGV;
86 $host = shift @ARGV if @ARGV;
87 $port = shift @ARGV if @ARGV;
91 $call = $main::myalias;
95 my $node = $user->{clusters}->{$user->{node}};
97 if ($node->{call} || $user->{call}) {
98 $host = $node->{host};
99 $port ||= $node->{port};
103 if (-e "$root/local/Listeners.pm") {
104 require "$root/local/Listeners.pm";
105 $host = $main::listen->[0]->[0];
106 $port = $main::listen->[0]->[1];
107 $host ||= '127.0.0.1';
108 $host = "127.0.0.1" if !$host && ($host eq '0.0.0.0' || $host eq '::');
117 die "You need a callsign ($call), a hostname($host) and a port($port) to proceed" unless $call && $host && $port;
123 gtk_create_main_screen();
125 $main->set_title("DXSpider gtkconsole $VERSION - $call \@ $host:$port");
127 # connect and send stuff
128 my $sock = IO::Socket::INET->new(PeerAddr=>$host, PeerPort=>$port);
129 die "Cannot connect to $/$port ($!)\n" unless $sock;
131 sendmsg($passwd) if $passwd;
133 sendmsg('set/page 500');
134 sendmsg('set/nobeep');
136 my $sock_helper = Gtk2::Helper->add_watch($sock->fileno, 'in', \&tophandler, $sock);
150 $_[0]->set_text(cldatetime(time));
156 my ($self, $data) = @_;
157 my $msg = $self->get_text;
168 my ($fd, $condx, $socket) = @_;
170 my $offset = defined $rbuf ? length $rbuf : 0;
171 my $l = sysread($socket, $rbuf, 1024, $offset);
174 while ($rbuf =~ s/^([^\015\012]*)\015?\012//) {
192 # this is truely evil and I bet there is a better way...
195 if ($line =~ /^'\w{2,4}',/) {
196 $list = eval qq([$line]);
198 $list = ['cmd', $line];
202 my $cmd = shift @$list;
203 my $handle = "handle_$cmd";
204 if (__PACKAGE__->can($handle)) {
205 __PACKAGE__->$handle($list);
207 unshift @$list, $cmd;
208 __PACKAGE__->handle_def($list);
217 my ($t, $ts) = (time, '');
219 $s = ref $ref ? join ', ',@$ref : $ref;
221 if (($cmd->{lasttime}||0) != $t) {
223 $cmd->{lasttime} = $t;
227 $cmd->add_data([$ts, $s]);
234 my ($t, $ts) = (time, '');
236 $s = ref $ref ? join(', ', @$ref) : $ref;
237 if (($cmd->{lasttime}||0) != $t) {
239 $cmd->{lasttime} = $t;
241 $cmd->add_data([$ts, $s]);
248 my ($t, $ts) = (time, '');
250 if (($dx->{lasttime}||0) != $t) {
252 $dx->{lasttime} = $t;
254 $dx->add_data([$ts, @$ref[0,1,15,3,4,16], stim($ref->[2]) ]);
262 my ($t, $ts) = (time, '');
264 # $s = ref $ref ? (join ', ',@$ref) : $ref;
266 if (($ann->{lasttime}||0) != $t) {
268 $ann->{lasttime} = $t;
272 $ann->add_data([$ts, @$ref[3,1,2]]);
281 # $s = ref $ref ? join ', ',@$ref : $ref;
285 $wcy->add_data([tim(), @$ref[10,4,5,3,6,2,7,8,9,1] ]);
294 # $s = ref $ref ? join ', ',@$ref : $ref;
297 $wwv->add_data([tim(), @$ref[6,2,3,4,5,1] ]);
306 my ($t, $ts) = (time, '');
308 $s = ref $ref ? (join ', ',@$ref) : $ref;
310 if (($ann->{lasttime}||0) != $t) {
312 $ann->{lasttime} = $t;
316 $chat->add_data([$ts, @$ref[3,1,2]]);
329 $sock->print("$msg\n");
334 my $t = shift || time;
335 return sprintf "%02d:%02d:%02d", (gmtime($t))[2,1,0];
340 my $t = shift || time;
341 return sprintf "%02d:%02d", (gmtime($t))[2,1];
344 # get a zulu time in cluster format (2300Z)
348 $t = defined $t ? $t : time;
350 my ($sec,$min,$hour) = $dst ? localtime($t): gmtime($t);
351 my $buf = sprintf "%02d%02d%s", $hour, $min, ($dst) ? '' : 'Z';
355 # get a cluster format date (23-Jun-1998)
359 $t = defined $t ? $t : time;
361 my ($sec,$min,$hour,$mday,$mon,$year) = $dst ? localtime($t) : gmtime($t);
363 my $buf = sprintf "%2d-%s-%04d", $mday, $month[$mon], $year;
367 # return a cluster style date time
372 my $date = cldate($t, $dst);
373 my $time = ztime($t, $dst);
374 return "$date $time";
382 my $fh = new IO::File $userfn;
392 print "$userfn missing or unreadable, starting afresh!\n";
396 'LOCAL' => {host => '127.0.0.1', port => 7300},
397 'GB7DJK' => {host => 'gb7djk.dxcluster.net', port => 7300},
398 'WR3D' => {host => 'wr3d.dxcluster.net', port => 7300},
399 'GB7BAA' => {host => 'gb7baa.dxcluster.net', port => 7300},
402 call => $main::myalias,
413 my $fh = new IO::File ">$userfn";
415 my $dd = new Data::Dumper([ $u ]);
419 $fh->print($dd->Dumpxs);
426 sub def_menu_callback
431 sub gtk_create_main_screen
433 $main = new Gtk2::Window('toplevel');
434 my $scr = $main->get_screen;
435 $scr_width = $scr->get_width;
436 $scr_width = 700 if $scr_width > 700;
437 $scr_height = int ($scr->get_height * 0.66);
438 $main->set_default_size($scr_width, $scr_height);
439 $main->signal_connect('delete_event', sub { Gtk2->main_quit; });
442 my $vbox = new Gtk2::VBox(0, 1);
447 item_type => '<Branch>',
450 callback => sub { Gtk2->main_quit; },
451 callback_action => 1,
452 accelerator => '<ctrl>Q',
458 item_type => '<Branch>',
461 callback_action => 9,
468 my $menu = Gtk2::SimpleMenu->new(menu_tree => $menutree, default_callback => \&def_menu_callback, user_data => $user);
469 $vbox->pack_start($menu->{widget}, 0, 1, 0);
472 # a paned hbox is packed as the bottom of the vbox
473 # my $bhpane = Gtk2::HPaned->new;
474 # $vbox->pack_end($bhpane, 1, 1, 0);
476 # now create the lh and rh panes
477 # my $lhvpane = Gtk2::VPaned->new;
478 # my $rhvpane = Gtk2::VPaned->new;
479 # $bhpane->pack1($lhvpane, 1, 0);
480 # $bhpane->pack2($rhvpane, 1, 0);
484 # my $lhvbox = Gtk2::VBox->new(0, 1);
485 $cmd = Screen::List->new(fields => [
487 Information => 'ttlong',
489 size => [$scr_width, $scr_height * 0.66],
491 $vbox->pack_start($cmd->widget, 1, 1, 0);
494 # callsign and current date and time
495 my $hbox = new Gtk2::HBox;
496 my $calllabel = new Gtk2::Label($call);
497 my $date = new Gtk2::Label(cldatetime(time));
498 $date->{tick} = Glib::Timeout->add(1000, \&updatetime, $date);
499 $hbox->pack_start( $calllabel, 0, 1, 0 );
500 $hbox->pack_end($date, 0, 1, 0);
501 $vbox->pack_start($hbox, 0, 1, 0);
502 $vbox->pack_start(Gtk2::HSeparator->new, 0, 1, 0);
505 $bot = new Gtk2::Entry;
506 $bot->set_editable(1);
507 $bot->signal_connect('activate', \&bothandler);
508 $bot->can_default(1);
509 $vbox->pack_end($bot, 0, 1, 0);
510 # $lhvpane->pack2($lhvbox, 1, 0);
519 $annwin = new Gtk2::Window('toplevel');
520 $ann = Screen::List->new(fields =>[
524 Announcement => 'ttlesslong',
527 frame => 'Announcements',
528 size => [$scr_width * 0.85, $scr_height * 0.25],
530 $annwin->add($ann->widget);
534 $chatwin = new Gtk2::Window('toplevel');
535 $chat = Screen::List->new(fields =>[
539 Chat => 'ttlesslong',
543 size => [$scr_width * 0.85, $scr_height * 0.25],
545 $chatwin->add($chat->widget);
549 $dxwin = new Gtk2::Window('toplevel');
550 $dx = Screen::List->new(fields => [
555 'Remarks' => 'ttshort',
560 policy => [qw(never automatic)],
564 size => [$scr_width * 0.9, $scr_height * 0.25],
566 # $rhvpane->pack1($dx->widget, 1, 0);
567 $dxwin->add($dx->widget);
571 $wwvwin = new Gtk2::Window('toplevel');
572 # my $rhvbox = Gtk2::VBox->new(0, 1);
573 $wwv = Screen::List->new( fields =>[
579 Remarks => 'ttshort',
583 policy => ['never', 'automatic'],
586 $wwvwin->add($wwv->widget);
589 # $rhvbox->pack_start($wwv->widget, 1, 1, 0);
592 $wcywin = new Gtk2::Window('toplevel');
593 $wcy = Screen::List->new(fields => [
607 policy => ['never', 'automatic'],
611 # $rhvbox->pack_start($wcy->widget, 1, 1, 0);
612 # $rhvbox->set_size_request($scr_width * 0.45, $scr_height * 0.33);
613 # $rhvpane->pack2($rhvbox, 1, 0);
614 $wcywin->add($wcy->widget);