3 # A GTK based console program
5 # usage: gtkconsole [<callsign>] [<host> <port>]
7 # Copyright (c) 2001-6 Dirk Koopman G1TLH
14 our $VERSION = '$Revision$';
18 # search local then perl directories
20 # root of directory tree for this system
22 $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
34 use vars qw(@modules $font);
36 @modules = (); # is the list of modules that need init calling
37 # on them. It is set up by each 'use'ed module
38 # that has Gtk stuff in it
41 our @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
44 our $main; # the main screen
45 our $scr_width; # calculated screen dimensions
47 our ($dx, $cmd, $ann, $wcy, $wwv); # scrolling list windows
48 our $bot; # the cmd entry window
49 our $date; # the current date
51 # read in the user data
52 our $userfn = "$ENV{HOME}/.gtkconsole_data";
53 our $user = read_user_data();
60 # read in gtkconsole file
63 Gtk2::Rc->set_default_files("$root/gtkconsole/gtkconsolerc", "$ENV{HOME}/.gtkconsolerc", ".gtkconsolerc");
64 Gtk2::Rc->reparse_all;
66 # sort out a callsign, host and port, looking in order
68 # 2. any defaults in the user data;
69 # 3. poke about in any spider tree that we can find
73 $call = uc shift @ARGV;
74 $host = shift @ARGV if @ARGV;
75 $port = shift @ARGV if @ARGV;
78 unless ($call && $host) {
79 my $node = $user->{clusters}->{$user->{node}};
81 if ($node->{call} || $user->{call}) {
82 $call = $node->{call} || $user->{call};
83 $host = $node->{passwd};
84 $host = $node->{host};
85 $port = $node->{port};
89 unless ($call && $host) {
90 if (-e "$root/local/DXVars.pm") {
91 require "$root/local/DXVars.pm";
92 $call = $main::myalias;
93 $call = $main::myalias; # for the warning
95 if (-e "$root/local/Listeners.pm") {
96 require "$root/local/Listeners.pm";
97 $host = $main::listen->[0]->[0];
98 $port = $main::listen->[0]->[1];
103 $host = $user->{clusters}->{$user->{node}}->{host};
104 $port = $user->{clusters}->{$user->{node}}->{port};
110 die "You need a callsign ($call), a hostname($host) and a port($port) to proceed" unless $call && $host;
116 gtk_create_main_screen();
118 $main->set_title("gtkconsole $VERSION - DXSpider Console - $call \@ $host:$port");
120 # connect and send stuff
121 my $sock = IO::Socket::INET->new(PeerAddr=>$host, PeerPort=>$port);
122 die "Cannot connect to $/$port ($!)\n" unless $sock;
124 sendmsg($passwd) if $passwd;
126 sendmsg('set/page 500');
127 sendmsg('set/nobeep');
129 my $sock_helper = Gtk2::Helper->add_watch($sock->fileno, 'in', \&tophandler, $sock);
143 $_[0]->set_text(cldatetime(time));
149 my ($self, $data) = @_;
150 my $msg = $self->get_text;
161 my ($fd, $condx, $socket) = @_;
163 my $offset = length $rbuf;
164 my $l = sysread($socket, $rbuf, 1024, $offset);
167 while ($rbuf =~ s/^([^\015\012]*)\015?\012//) {
185 # this is truely evil and I bet there is a better way...
188 if ($line =~ /^'\w{2,4}',/) {
189 $list = eval qq([$line]);
191 $list = ['cmd', $line];
195 my $cmd = shift @$list;
196 my $handle = "handle_$cmd";
197 if (__PACKAGE__->can($handle)) {
198 __PACKAGE__->$handle($list);
200 unshift @$list, $cmd;
201 __PACKAGE__->handle_def($list);
210 my ($t, $ts) = (time, '');
212 $s = ref $ref ? join ', ',@$ref : $ref;
214 if (($cmd->{lasttime}||0) != $t) {
216 $cmd->{lasttime} = $t;
220 $cmd->add_data([$ts, $s]);
227 my ($t, $ts) = (time, '');
229 $s = ref $ref ? join(', ', @$ref) : $ref;
230 if (($cmd->{lasttime}||0) != $t) {
232 $cmd->{lasttime} = $t;
234 $cmd->add_data([$ts, $s]);
241 my ($t, $ts) = (time, '');
243 if (($dx->{lasttime}||0) != $t) {
245 $dx->{lasttime} = $t;
247 $dx->add_data([$ts, @$ref[0,1,15,3,4,16], stim($ref->[2]) ]);
255 my ($t, $ts) = (time, '');
257 $s = ref $ref ? join ', ',@$ref : $ref;
259 if (($ann->{lasttime}||0) != $t) {
261 $ann->{lasttime} = $t;
265 $ann->add_data([$ts, @$ref[3,1,2]]);
273 $s = ref $ref ? join ', ',@$ref : $ref;
277 $wcy->add_data([tim(), @$ref[10,4,5,3,6,2,7,8,9,1] ]);
285 $s = ref $ref ? join ', ',@$ref : $ref;
288 $wwv->add_data([tim(), @$ref[6,2,3,4,5,1] ]);
300 $sock->print("$msg\n");
305 my $t = shift || time;
306 return sprintf "%02d:%02d:%02d", (gmtime($t))[2,1,0];
311 my $t = shift || time;
312 return sprintf "%02d:%02d", (gmtime($t))[2,1];
315 # get a zulu time in cluster format (2300Z)
319 $t = defined $t ? $t : time;
321 my ($sec,$min,$hour) = $dst ? localtime($t): gmtime($t);
322 my $buf = sprintf "%02d%02d%s", $hour, $min, ($dst) ? '' : 'Z';
326 # get a cluster format date (23-Jun-1998)
330 $t = defined $t ? $t : time;
332 my ($sec,$min,$hour,$mday,$mon,$year) = $dst ? localtime($t) : gmtime($t);
334 my $buf = sprintf "%2d-%s-%04d", $mday, $month[$mon], $year;
338 # return a cluster style date time
343 my $date = cldate($t, $dst);
344 my $time = ztime($t, $dst);
345 return "$date $time";
353 my $fh = new IO::File $userfn;
363 print "$userfn missing or unreadable, starting afresh!\n";
367 'GB7DJK' => {host => 'gb7djk.dxcluster.net', port => 7300},
368 'WR3D' => {host => 'wr3d.dxcluster.net', port => 7300},
369 'GB7BAA' => {host => 'gb7baa.dxcluster.net', port => 7300},
382 my $fh = new IO::File ">$userfn";
384 my $dd = new Data::Dumper([ $u ]);
388 $fh->print($dd->Dumpxs);
395 sub def_menu_callback
400 sub gtk_create_main_screen
402 $main = new Gtk2::Window('toplevel');
403 my $scr = $main->get_screen;
404 $scr_width = int ($scr->get_width > 1280 ? 1280 : $scr->get_width) * 0.99;
405 $scr_height = int $scr->get_height * 0.5;
406 $main->set_default_size($scr_width, $scr_height);
407 $main->signal_connect('delete_event', sub { Gtk2->main_quit; });
410 my $vbox = new Gtk2::VBox(0, 1);
415 item_type => '<Branch>',
418 callback => sub { Gtk2->main_quit; },
419 callback_action => 1,
420 accelerator => '<ctrl>Q',
426 item_type => '<Branch>',
429 callback_action => 9,
436 my $menu = Gtk2::SimpleMenu->new(menu_tree => $menutree, default_callback => \&def_menu_callback, user_data => $user);
437 $vbox->pack_start($menu->{widget}, 0, 1, 0);
440 # a paned hbox is packed as the bottom of the vbox
441 my $bhpane = Gtk2::HPaned->new;
442 $vbox->pack_end($bhpane, 1, 1, 0);
444 # now create the lh and rh panes
445 my $lhvpane = Gtk2::VPaned->new;
446 my $rhvpane = Gtk2::VPaned->new;
447 $bhpane->pack1($lhvpane, 1, 0);
448 $bhpane->pack2($rhvpane, 1, 0);
454 $ann = Screen::List->new(fields =>[
458 Announcement => 'ttlesslong',
461 frame => 'Announcements',
462 size => [$scr_width * 0.45, $scr_height * 0.33],
465 $lhvpane->pack1($ann->widget, 1, 0);
468 my $lhvbox = Gtk2::VBox->new(0, 1);
469 $cmd = Screen::List->new(fields => [
471 Information => 'ttlong',
473 size => [$scr_width * 0.45, $scr_height * 0.66],
475 $lhvbox->pack_start($cmd->widget, 1, 1, 0);
478 # callsign and current date and time
479 my $hbox = new Gtk2::HBox;
480 my $calllabel = new Gtk2::Label($call);
481 my $date = new Gtk2::Label(cldatetime(time));
482 $date->{tick} = Glib::Timeout->add(1000, \&updatetime, $date);
483 $hbox->pack_start( $calllabel, 0, 1, 0 );
484 $hbox->pack_end($date, 0, 1, 0);
485 $lhvbox->pack_start($hbox, 0, 1, 0);
486 $lhvbox->pack_start(Gtk2::HSeparator->new, 0, 1, 0);
489 $bot = new Gtk2::Entry;
490 $bot->set_editable(1);
491 $bot->signal_connect('activate', \&bothandler);
492 $bot->can_default(1);
493 $lhvbox->pack_end($bot, 0, 1, 0);
494 $lhvpane->pack2($lhvbox, 1, 0);
502 $dx = Screen::List->new(fields => [
507 'Remarks' => 'ttshort',
512 policy => [qw(never automatic)],
516 size => [$scr_width * 0.45, $scr_height * 0.45],
518 $rhvpane->pack1($dx->widget, 1, 0);
521 my $rhvbox = Gtk2::VBox->new(0, 1);
522 $wwv = Screen::List->new( fields =>[
528 Remarks => 'ttshort',
532 policy => ['never', 'automatic'],
535 $rhvbox->pack_start($wwv->widget, 1, 1, 0);
538 $wcy = Screen::List->new(fields => [
552 policy => ['never', 'automatic'],
556 $rhvbox->pack_start($wcy->widget, 1, 1, 0);
557 $rhvbox->set_size_request($scr_width * 0.45, $scr_height * 0.33);
558 $rhvpane->pack2($rhvbox, 1, 0);