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 #
  10 #
  11
  12 use strict;
  13
  14 our $root;
  15
  16 # search local then perl directories
  17 BEGIN {
  18         # root of directory tree for this system
  19         $root = "/spider";
  20         $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
  21 }
  22
  23 use Glib;
  24 use Gtk2 qw(-init);
  25 use Gtk2::Helper;
  26 use Gtk2::SimpleMenu;
  27 use Data::Dumper;
  28 use IO::File;
  29
  30 use Screen;
  31
  32 use vars qw(@modules $font);
  33
  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
  37 use IO::Socket::INET;
  38
  39 our @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
  40
  41 # various GTK handles
  42 our $main;                                              # the main screen
  43 our $scr_width;                                 # calculated screen dimensions
  44 our $scr_height;
  45 our ($dx, $cmd, $ann, $wcy, $wwv, $chat); # scrolling list windows
  46 our $bot;                                               # the cmd entry window
  47 our $date;                                              # the current date
  48
  49 # other windows
  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
  55
  56 require "$root/local/DXVars.pm" if -e "$root/local/DXVars.pm";
  57
  58 our ($version, $subversion, $build);
  59 require "$root/perl/Version.pm";
  60
  61 our $VERSION = "$version.$subversion build $build";
  62
  63 # read in the user data
  64 our $userfn = "$ENV{HOME}/.gtkconsole_data";
  65 our $user = read_user_data();
  66 our $call;
  67 our $passwd;
  68 our $host = 'localhost';
  69 our $port = 7300;
  70
  71 #
  72 # read in gtkconsole file
  73 #
  74
  75 Gtk2::Rc->set_default_files("$root/gtkconsole/gtkconsolerc", "$ENV{HOME}/.gtkconsolerc", ".gtkconsolerc");
  76 Gtk2::Rc->reparse_all;
  77
  78 # sort out a callsign, host and port, looking in order
  79 #  1. the command line
  80 #  2. any defaults in the user data;
  81 #  3. poke about in any spider tree that we can find
  82 #
  83
  84 if (@ARGV) {
  85         $call = uc shift @ARGV;
  86         $host = shift @ARGV if @ARGV;
  87         $port = shift @ARGV if @ARGV;
  88 }
  89
  90 unless ($call) {
  91         $call = $main::myalias;
  92 }
  93
  94 unless ($host) {
  95         my $node = $user->{clusters}->{$user->{node}};
  96
  97         if ($node->{call} || $user->{call}) {
  98                 $host = $node->{host};
  99                 $port ||= $node->{port};
 100         }
 101
 102         unless ($host) {
 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 '::');
 109                         $port ||= 7300;
 110                 }
 111         }
 112 }
 113
 114 $call ||= '';
 115 $host ||= '';
 116 $port ||= '';
 117 die "You need a callsign ($call), a hostname($host) and a port($port) to proceed" unless $call && $host && $port;
 118
 119 #
 120 # start of GTK stuff
 121 #
 122
 123 gtk_create_main_screen();
 124
 125 $main->set_title("DXSpider gtkconsole $VERSION - $call \@ $host:$port");
 126
 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;
 130 sendmsg($call);
 131 sendmsg($passwd) if $passwd;
 132 sendmsg('set/gtk');
 133 sendmsg('set/page 500');
 134 sendmsg('set/nobeep');
 135
 136 my $sock_helper = Gtk2::Helper->add_watch($sock->fileno, 'in', \&tophandler, $sock);
 137
 138 # the main loop
 139 $main->show_all;
 140 $bot->grab_focus;
 141 Gtk2->main;
 142 exit(0);
 143
 144 #
 145 # handlers
 146 #
 147
 148 sub updatetime
 149 {
 150         $_[0]->set_text(cldatetime(time));
 151         1;
 152 }
 153
 154 sub bothandler
 155 {
 156         my ($self, $data) = @_;
 157         my $msg = $self->get_text;
 158         $msg =~ s/\r?\n$//;
 159         $self->set_text('');
 160         $self->grab_focus;
 161         sendmsg($msg);
 162 }
 163
 164 my $rbuf = '';
 165
 166 sub tophandler
 167 {
 168         my ($fd, $condx, $socket) = @_;
 169
 170         my $offset = defined $rbuf ? length $rbuf : 0;
 171         my $l = sysread($socket, $rbuf, 1024, $offset);
 172         if (defined $l) {
 173                 if ($l) {
 174                         while ($rbuf =~ s/^([^\015\012]*)\015?\012//) {
 175                                 my $msg = $1;
 176                                 handlemsg($msg);
 177                         }
 178                 } else {
 179                         Gtk2->main_quit;
 180                 }
 181         } else {
 182                 Gtk2->main_quit;
 183         }
 184         1;
 185
 186 }
 187
 188 sub handlemsg
 189 {
 190         my $line = shift;
 191
 192         # this is truely evil and I bet there is a better way...
 193         chomp $line;
 194         my $list;
 195         if ($line =~ /^'\w{2,4}',/) {
 196                 $list = eval qq([$line]);
 197         } else {
 198                 $list = ['cmd', $line];
 199         }
 200         unless ($@) {
 201                 no strict 'refs';
 202                 my $cmd = shift @$list;
 203                 my $handle = "handle_$cmd";
 204                 if (__PACKAGE__->can($handle)) {
 205                         __PACKAGE__->$handle($list);
 206                 } else {
 207                         unshift @$list, $cmd;
 208                         __PACKAGE__->handle_def($list);
 209                 }
 210         }
 211 }
 212
 213 sub handle_cmd
 214 {
 215         my $self = shift;
 216         my $ref = shift;
 217         my ($t, $ts) = (time, '');
 218         my $s;
 219         $s = ref $ref ? join ', ',@$ref : $ref;
 220
 221         if (($cmd->{lasttime}||0) != $t) {
 222                 $ts = tim($t);
 223                 $cmd->{lasttime} = $t;
 224         }
 225
 226         chomp $s;
 227         $cmd->add_data([$ts,  $s]);
 228 }
 229
 230 sub handle_def
 231 {
 232         my $self = shift;
 233         my $ref = shift;
 234         my ($t, $ts) = (time, '');
 235         my $s;
 236         $s = ref $ref ? join(', ', @$ref) : $ref;
 237         if (($cmd->{lasttime}||0) != $t) {
 238                 $ts = tim($t);
 239                 $cmd->{lasttime} = $t;
 240         }
 241         $cmd->add_data([$ts,  $s]);
 242 }
 243
 244 sub handle_dx
 245 {
 246         my $self = shift;
 247         my $ref = shift;
 248         my ($t, $ts) = (time, '');
 249
 250         if (($dx->{lasttime}||0) != $t) {
 251                 $ts = tim($t);
 252                 $dx->{lasttime} = $t;
 253         }
 254         $dx->add_data([$ts,  @$ref[0,1,15,3,4,16], stim($ref->[2]) ]);
 255         $dxwin->show_all;
 256 }
 257
 258 sub handle_ann
 259 {
 260         my $self = shift;
 261         my $ref = shift;
 262         my ($t, $ts) = (time, '');
 263 #       my $s;
 264 #       $s = ref $ref ? (join ', ',@$ref) : $ref;
 265
 266         if (($ann->{lasttime}||0) != $t) {
 267                 $ts = tim($t);
 268                 $ann->{lasttime} = $t;
 269         }
 270
 271 #       chomp $s;
 272         $ann->add_data([$ts,  @$ref[3,1,2]]);
 273         $annwin->show_all;
 274 }
 275
 276 sub handle_wcy
 277 {
 278         my $self = shift;
 279         my $ref = shift;
 280 #       my $s;
 281 #       $s = ref $ref ? join ', ',@$ref : $ref;
 282
 283 #       chomp $s;
 284
 285         $wcy->add_data([tim(),  @$ref[10,4,5,3,6,2,7,8,9,1] ]);
 286         $wcywin->show_all;
 287 }
 288
 289 sub handle_wwv
 290 {
 291         my $self = shift;
 292         my $ref = shift;
 293 #       my $s;
 294 #       $s = ref $ref ? join ', ',@$ref : $ref;
 295
 296 #       chomp $s;
 297         $wwv->add_data([tim(),  @$ref[6,2,3,4,5,1] ]);
 298         $wwvwin->show_all;
 299 }
 300
 301
 302 sub handle_chat
 303 {
 304         my $self = shift;
 305         my $ref = shift;
 306         my ($t, $ts) = (time, '');
 307         my $s;
 308         $s = ref $ref ? (join ', ',@$ref) : $ref;
 309
 310         if (($ann->{lasttime}||0) != $t) {
 311                 $ts = tim($t);
 312                 $ann->{lasttime} = $t;
 313         }
 314
 315         chomp $s;
 316         $chat->add_data([$ts,  @$ref[3,1,2]]);
 317         $chatwin->show_all;
 318 }
 319
 320
 321
 322 #
 323 # subroutine
 324 #
 325
 326 sub sendmsg
 327 {
 328         my $msg = shift;
 329         $sock->print("$msg\n");
 330 }
 331
 332 sub tim
 333 {
 334         my $t = shift || time;
 335         return sprintf "%02d:%02d:%02d", (gmtime($t))[2,1,0];
 336 }
 337
 338 sub stim
 339 {
 340         my $t = shift || time;
 341         return sprintf "%02d:%02d", (gmtime($t))[2,1];
 342 }
 343
 344 # get a zulu time in cluster format (2300Z)
 345 sub ztime
 346 {
 347         my $t = shift;
 348         $t = defined $t ? $t : time;
 349         my $dst = shift;
 350         my ($sec,$min,$hour) = $dst ? localtime($t): gmtime($t);
 351         my $buf = sprintf "%02d%02d%s", $hour, $min, ($dst) ? '' : 'Z';
 352         return $buf;
 353 }
 354
 355 # get a cluster format date (23-Jun-1998)
 356 sub cldate
 357 {
 358         my $t = shift;
 359         $t = defined $t ? $t : time;
 360         my $dst = shift;
 361         my ($sec,$min,$hour,$mday,$mon,$year) = $dst ? localtime($t) : gmtime($t);
 362         $year += 1900;
 363         my $buf = sprintf "%2d-%s-%04d", $mday, $month[$mon], $year;
 364         return $buf;
 365 }
 366
 367 # return a cluster style date time
 368 sub cldatetime
 369 {
 370         my $t = shift;
 371         my $dst = shift;
 372         my $date = cldate($t, $dst);
 373         my $time = ztime($t, $dst);
 374         return "$date $time";
 375 }
 376
 377 sub read_user_data
 378 {
 379         my $u;
 380
 381         if (-e $userfn) {
 382                 my $fh = new IO::File $userfn;
 383                 my $s = undef;
 384                 if ($fh) {
 385                         local $/ = undef;
 386                         $s = <$fh>;
 387                         $fh->close;
 388                 }
 389                 eval "\$u = $s";
 390         }
 391         unless ($u) {
 392                 print "$userfn missing or unreadable, starting afresh!\n";
 393
 394                 $u = {
 395                           clusters => {
 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},
 400                                                   },
 401                           node => 'LOCAL',
 402                           call => $main::myalias,
 403                          };
 404                 write_user_data($u);
 405         }
 406         return $u;
 407 }
 408
 409 sub write_user_data
 410 {
 411         my $u = shift;
 412
 413         my $fh = new IO::File ">$userfn";
 414         if ($fh) {
 415                 my $dd = new Data::Dumper([ $u ]);
 416                 $dd->Indent(1);
 417                 $dd->Quotekeys(0);
 418                 $dd->Terse(1);
 419                 $fh->print($dd->Dumpxs);
 420                 $fh->close;
 421                 return 1;
 422         }
 423         return 0;
 424 }
 425
 426 sub def_menu_callback
 427 {
 428
 429 }
 430
 431 sub gtk_create_main_screen
 432 {
 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; });
 440
 441         # the main vbox
 442         my $vbox = new Gtk2::VBox(0, 1);
 443         $main->add($vbox);
 444
 445         my $menutree = [
 446                                         _File => {
 447                                                           item_type => '<Branch>',
 448                                                           children => [
 449                                                                                    _Quit => {
 450                                                                                                          callback => sub { Gtk2->main_quit; },
 451                                                                                                          callback_action => 1,
 452                                                                                                          accelerator => '<ctrl>Q',
 453                                                                                                         }
 454                                                                                   ],
 455                                                          },
 456
 457                                         _Help => {
 458                                                           item_type => '<Branch>',
 459                                                           children => [
 460                                                                                    _About => {
 461                                                                                                           callback_action => 9,
 462                                                                                                          },
 463                                                                                   ],
 464                                                          },
 465
 466                                    ];
 467
 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);
 470
 471
 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);
 475
 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);
 481
 482
 483         # The command list
 484 #       my $lhvbox = Gtk2::VBox->new(0, 1);
 485         $cmd = Screen::List->new(fields => [
 486                                                                                 RxTime => 'tt',
 487                                                                                 Information => 'ttlong',
 488                                                                            ],
 489                                                          size => [$scr_width, $scr_height * 0.66],
 490                                                         );
 491         $vbox->pack_start($cmd->widget, 1, 1, 0);
 492
 493
 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);
 503
 504         # the bottom handler
 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);
 511         $bot->grab_default;
 512
 513         #
 514         #
 515         #
 516
 517         #
 518         # The announce list
 519         $annwin = new Gtk2::Window('toplevel');
 520         $ann = Screen::List->new(fields =>[
 521                                                                            RxTime => 'tt',
 522                                                                            From => 'tt',
 523                                                                            To => 'tt',
 524                                                                            Announcement => 'ttlesslong',
 525                                                                           ],
 526                                                          hint => 1,
 527                                                          frame => 'Announcements',
 528                                                          size => [$scr_width * 0.85, $scr_height * 0.25],
 529                                                         );
 530         $annwin->add($ann->widget);
 531 #       $annwin->show_all;
 532
 533         # The announce list
 534         $chatwin = new Gtk2::Window('toplevel');
 535         $chat = Screen::List->new(fields =>[
 536                                                                            RxTime => 'tt',
 537                                                                            From => 'tt',
 538                                                                            To => 'tt',
 539                                                                            Chat => 'ttlesslong',
 540                                                                           ],
 541                                                          hint => 1,
 542                                                          frame => 'Chat',
 543                                                          size => [$scr_width * 0.85, $scr_height * 0.25],
 544                                                         );
 545         $chatwin->add($chat->widget);
 546 #       $annwin->show_all;
 547
 548         # DX window
 549         $dxwin = new Gtk2::Window('toplevel');
 550         $dx = Screen::List->new(fields => [
 551                                                                            'RxTime' => 'tt',
 552                                                                            'QRG' => 'qrg',
 553                                                                            'DX Call' => 'tt',
 554                                                                            'Grid' => 'tt',
 555                                                                            'Remarks' => 'ttshort',
 556                                                                            'By' => 'tt',
 557                                                                            'Grid' => 'tt',
 558                                                                            'TxTime' => 'tt',
 559                                                                           ],
 560                                                         policy => [qw(never automatic)],
 561                                                         hint => 1,
 562                                                         frame => "DX Spots",
 563                                                         maxsize => 500,
 564                                                         size => [$scr_width * 0.9, $scr_height * 0.25],
 565                                                    );
 566 #       $rhvpane->pack1($dx->widget, 1, 0);
 567         $dxwin->add($dx->widget);
 568 #       $dxwin->show_all;
 569
 570         # The wwv list
 571         $wwvwin = new Gtk2::Window('toplevel');
 572         #       my $rhvbox = Gtk2::VBox->new(0, 1);
 573         $wwv = Screen::List->new( fields =>[
 574                                                                                 RxTime => 'tt',
 575                                                                                 From => 'tt',
 576                                                                                 SFI => 'int',
 577                                                                                 A => 'int',
 578                                                                                 K => 'int',
 579                                                                                 Remarks => 'ttshort',
 580                                                                                 Hour => 'tt'
 581                                                                            ],
 582                                                           hint => 1,
 583                                                           policy => ['never', 'automatic'],
 584                                                           frame => 'WWV Data',
 585                                                         );
 586         $wwvwin->add($wwv->widget);
 587 #       $wwvwin->show_all;
 588
 589 #       $rhvbox->pack_start($wwv->widget, 1, 1, 0);
 590
 591         # The wcy list
 592         $wcywin = new Gtk2::Window('toplevel');
 593         $wcy = Screen::List->new(fields => [
 594                                                                                 RxTime => 'tt',
 595                                                                                 From => 'tt',
 596                                                                                 K => 'int',
 597                                                                                 ExpK => 'int',
 598                                                                                 A => 'int',
 599                                                                                 R => 'int',
 600                                                                                 SFI => 'int',
 601                                                                                 SA => 'tt',
 602                                                                                 GMF => 'tt',
 603                                                                                 Aurora => 'tt',
 604                                                                                 Hour => 'tt'
 605                                                                            ],
 606                                                          hint => 1,
 607                                                          policy => ['never', 'automatic'],
 608                                                          frame => 'WCY Data',
 609                                                         );
 610
 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);
 615 #       $wcywin->show_all;
 616 }