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 # wants
  57 our ($wantann, $wantdx, $wantwwv, $wantwcy, $wantchat) = (1, 1, 1, 1, 1);
  58
  59 require "$root/local/DXVars.pm" if -e "$root/local/DXVars.pm";
  60
  61 our ($version, $subversion, $build);
  62 require "$root/perl/Version.pm";
  63
  64 our $VERSION = "$version.$subversion build $build";
  65
  66 # read in the user data
  67 our $userfn = "$ENV{HOME}/.gtkconsole_data";
  68 our $user = read_user_data();
  69 our $call;
  70 our $passwd;
  71 our $host = 'localhost';
  72 our $port = 7300;
  73
  74 #
  75 # read in gtkconsole file
  76 #
  77
  78 Gtk2::Rc->set_default_files("$root/gtkconsole/gtkconsolerc", "$ENV{HOME}/.gtkconsolerc", ".gtkconsolerc");
  79 Gtk2::Rc->reparse_all;
  80
  81 # sort out a callsign, host and port, looking in order
  82 #  1. the command line
  83 #  2. any defaults in the user data;
  84 #  3. poke about in any spider tree that we can find
  85 #
  86
  87 if (@ARGV) {
  88         $call = uc shift @ARGV;
  89         $host = shift @ARGV if @ARGV;
  90         $port = shift @ARGV if @ARGV;
  91 }
  92
  93 unless ($call) {
  94         $call = $main::myalias;
  95 }
  96
  97 unless ($host) {
  98         my $node = $user->{clusters}->{$user->{node}};
  99
 100         if ($node->{call} || $user->{call}) {
 101                 $host = $node->{host};
 102                 $port ||= $node->{port};
 103         }
 104
 105         unless ($host) {
 106                 if (-e "$root/local/Listeners.pm") {
 107                         require  "$root/local/Listeners.pm";
 108                         $host = $main::listen->[0]->[0];
 109                         $port = $main::listen->[0]->[1];
 110                         $host ||= '127.0.0.1';
 111                         $host = "127.0.0.1" if !$host && ($host eq '0.0.0.0' || $host eq '::');
 112                         $port ||= 7300;
 113                 }
 114         }
 115 }
 116
 117 $call ||= '';
 118 $host ||= '';
 119 $port ||= '';
 120 die "You need a callsign ($call), a hostname($host) and a port($port) to proceed" unless $call && $host && $port;
 121
 122 #
 123 # start of GTK stuff
 124 #
 125
 126 gtk_create_main_screen();
 127
 128 $main->set_title("DXSpider gtkconsole $VERSION - $call \@ $host:$port");
 129
 130 # connect and send stuff
 131 my $sock = IO::Socket::INET->new(PeerAddr=>$host, PeerPort=>$port);
 132 die "Cannot connect to  $/$port ($!)\n" unless $sock;
 133 sendmsg($call);
 134 sendmsg($passwd) if $passwd;
 135 sendmsg('set/gtk');
 136 sendmsg('set/page 500');
 137 sendmsg('set/nobeep');
 138
 139 my $sock_helper = Gtk2::Helper->add_watch($sock->fileno, 'in', \&tophandler, $sock);
 140
 141 # the main loop
 142 $main->show_all;
 143 $bot->grab_focus;
 144 Gtk2->main;
 145 exit(0);
 146
 147 #
 148 # handlers
 149 #
 150
 151 sub updatetime
 152 {
 153         $_[0]->set_text(cldatetime(time));
 154         1;
 155 }
 156
 157 sub bothandler
 158 {
 159         my ($self, $data) = @_;
 160         my $msg = $self->get_text;
 161         $msg =~ s/\r?\n$//;
 162         $self->set_text('');
 163         $self->grab_focus;
 164         sendmsg($msg);
 165 }
 166
 167 my $rbuf = '';
 168
 169 sub tophandler
 170 {
 171         my ($fd, $condx, $socket) = @_;
 172
 173         my $offset = defined $rbuf ? length $rbuf : 0;
 174         my $l = sysread($socket, $rbuf, 1024, $offset);
 175         if (defined $l) {
 176                 if ($l) {
 177                         while ($rbuf =~ s/^([^\015\012]*)\015?\012//) {
 178                                 my $msg = $1;
 179                                 handlemsg($msg);
 180                         }
 181                 } else {
 182                         Gtk2->main_quit;
 183                 }
 184         } else {
 185                 Gtk2->main_quit;
 186         }
 187         1;
 188
 189 }
 190
 191 sub handlemsg
 192 {
 193         my $line = shift;
 194
 195         # this is truely evil and I bet there is a better way...
 196         chomp $line;
 197         my $list;
 198         if ($line =~ /^'\w{2,4}',/) {
 199                 $list = eval qq([$line]);
 200         } else {
 201                 $list = ['cmd', $line];
 202         }
 203         unless ($@) {
 204                 no strict 'refs';
 205                 my $cmd = shift @$list;
 206                 my $handle = "handle_$cmd";
 207                 if (__PACKAGE__->can($handle)) {
 208                         __PACKAGE__->$handle($list);
 209                 } else {
 210                         unshift @$list, $cmd;
 211                         __PACKAGE__->handle_def($list);
 212                 }
 213         }
 214 }
 215
 216 sub handle_cmd
 217 {
 218         my $self = shift;
 219         my $ref = shift;
 220         my ($t, $ts) = (time, '');
 221         my $s;
 222         $s = ref $ref ? join ', ',@$ref : $ref;
 223
 224         if (($cmd->{lasttime}||0) != $t) {
 225                 $ts = tim($t);
 226                 $cmd->{lasttime} = $t;
 227         }
 228
 229         chomp $s;
 230         $cmd->add_data([$ts,  $s]);
 231 }
 232
 233 sub handle_def
 234 {
 235         my $self = shift;
 236         my $ref = shift;
 237         my ($t, $ts) = (time, '');
 238         my $s;
 239         $s = ref $ref ? join(', ', @$ref) : $ref;
 240         if (($cmd->{lasttime}||0) != $t) {
 241                 $ts = tim($t);
 242                 $cmd->{lasttime} = $t;
 243         }
 244         $cmd->add_data([$ts,  $s]);
 245 }
 246
 247 sub handle_dx
 248 {
 249         my $self = shift;
 250         my $ref = shift;
 251         my ($t, $ts) = (time, '');
 252
 253         if (($dx->{lasttime}||0) != $t) {
 254                 $ts = tim($t);
 255                 $dx->{lasttime} = $t;
 256         }
 257         $dx->add_data([$ts,  @$ref[0,1,15,3,4,16], stim($ref->[2]) ]);
 258         $dxwin->show_all;
 259 }
 260
 261 sub handle_ann
 262 {
 263         my $self = shift;
 264         my $ref = shift;
 265         my ($t, $ts) = (time, '');
 266 #       my $s;
 267 #       $s = ref $ref ? (join ', ',@$ref) : $ref;
 268
 269         if (($ann->{lasttime}||0) != $t) {
 270                 $ts = tim($t);
 271                 $ann->{lasttime} = $t;
 272         }
 273
 274 #       chomp $s;
 275         $ann->add_data([$ts,  @$ref[3,1,2]]);
 276         $annwin->show_all;
 277 }
 278
 279 sub handle_wcy
 280 {
 281         my $self = shift;
 282         my $ref = shift;
 283 #       my $s;
 284 #       $s = ref $ref ? join ', ',@$ref : $ref;
 285
 286 #       chomp $s;
 287
 288         $wcy->add_data([tim(),  @$ref[10,4,5,3,6,2,7,8,9,1] ]);
 289         $wcywin->show_all;
 290 }
 291
 292 sub handle_wwv
 293 {
 294         my $self = shift;
 295         my $ref = shift;
 296 #       my $s;
 297 #       $s = ref $ref ? join ', ',@$ref : $ref;
 298
 299 #       chomp $s;
 300         $wwv->add_data([tim(),  @$ref[6,2,3,4,5,1] ]);
 301         $wwvwin->show_all;
 302 }
 303
 304
 305 sub handle_chat
 306 {
 307         my $self = shift;
 308         my $ref = shift;
 309         my ($t, $ts) = (time, '');
 310         my $s;
 311         $s = ref $ref ? (join ', ',@$ref) : $ref;
 312
 313         if (($ann->{lasttime}||0) != $t) {
 314                 $ts = tim($t);
 315                 $ann->{lasttime} = $t;
 316         }
 317
 318         chomp $s;
 319         $chat->add_data([$ts,  @$ref[3,1,2]]);
 320         $chatwin->show_all;
 321 }
 322
 323
 324
 325 #
 326 # subroutine
 327 #
 328
 329 sub sendmsg
 330 {
 331         my $msg = shift;
 332         $sock->print("$msg\n");
 333 }
 334
 335 sub tim
 336 {
 337         my $t = shift || time;
 338         return sprintf "%02d:%02d:%02d", (gmtime($t))[2,1,0];
 339 }
 340
 341 sub stim
 342 {
 343         my $t = shift || time;
 344         return sprintf "%02d:%02d", (gmtime($t))[2,1];
 345 }
 346
 347 # get a zulu time in cluster format (2300Z)
 348 sub ztime
 349 {
 350         my $t = shift;
 351         $t = defined $t ? $t : time;
 352         my $dst = shift;
 353         my ($sec,$min,$hour) = $dst ? localtime($t): gmtime($t);
 354         my $buf = sprintf "%02d%02d%s", $hour, $min, ($dst) ? '' : 'Z';
 355         return $buf;
 356 }
 357
 358 # get a cluster format date (23-Jun-1998)
 359 sub cldate
 360 {
 361         my $t = shift;
 362         $t = defined $t ? $t : time;
 363         my $dst = shift;
 364         my ($sec,$min,$hour,$mday,$mon,$year) = $dst ? localtime($t) : gmtime($t);
 365         $year += 1900;
 366         my $buf = sprintf "%2d-%s-%04d", $mday, $month[$mon], $year;
 367         return $buf;
 368 }
 369
 370 # return a cluster style date time
 371 sub cldatetime
 372 {
 373         my $t = shift;
 374         my $dst = shift;
 375         my $date = cldate($t, $dst);
 376         my $time = ztime($t, $dst);
 377         return "$date $time";
 378 }
 379
 380 sub read_user_data
 381 {
 382         my $u;
 383
 384         if (-e $userfn) {
 385                 my $fh = new IO::File $userfn;
 386                 my $s = undef;
 387                 if ($fh) {
 388                         local $/ = undef;
 389                         $s = <$fh>;
 390                         $fh->close;
 391                 }
 392                 eval "\$u = $s";
 393         }
 394         unless ($u) {
 395                 print "$userfn missing or unreadable, starting afresh!\n";
 396
 397                 $u = {
 398                           clusters => {
 399                                                    'LOCAL' => {host => '127.0.0.1', port => 7300},
 400                                                    'GB7DJK' => {host => 'gb7djk.dxcluster.net', port => 7300},
 401                                                    'WR3D' => {host => 'wr3d.dxcluster.net', port => 7300},
 402                                                    'GB7BAA' => {host => 'gb7baa.dxcluster.net', port => 7300},
 403                                                   },
 404                           node => 'LOCAL',
 405                           call => $main::myalias,
 406                          };
 407                 write_user_data($u);
 408         }
 409         return $u;
 410 }
 411
 412 sub write_user_data
 413 {
 414         my $u = shift;
 415
 416         my $fh = new IO::File ">$userfn";
 417         if ($fh) {
 418                 my $dd = new Data::Dumper([ $u ]);
 419                 $dd->Indent(1);
 420                 $dd->Quotekeys(0);
 421                 $dd->Terse(1);
 422                 $fh->print($dd->Dumpxs);
 423                 $fh->close;
 424                 return 1;
 425         }
 426         return 0;
 427 }
 428
 429 sub def_menu_callback
 430 {
 431
 432 }
 433
 434 sub set_win
 435 {
 436         my $var = shift;
 437         $$var = shift;
 438 }
 439
 440 sub gtk_create_main_screen
 441 {
 442         $main = new Gtk2::Window('toplevel');
 443         my $scr = $main->get_screen;
 444         $scr_width = $scr->get_width;
 445         $scr_width = 700 if $scr_width > 700;
 446         $scr_height = int ($scr->get_height * 0.66);
 447         $main->set_default_size($scr_width, $scr_height);
 448         $main->signal_connect('delete_event', sub { Gtk2->main_quit; });
 449
 450         # the main vbox
 451         my $vbox = new Gtk2::VBox(0, 1);
 452         $main->add($vbox);
 453
 454         my $menutree = [
 455                                         _File => {
 456                                                           item_type => '<Branch>',
 457                                                           children => [
 458                                                                                    _Quit => {
 459                                                                                                          callback => sub { Gtk2->main_quit; },
 460                                                                                                          callback_action => 1,
 461                                                                                                          accelerator => '<ctrl>Q',
 462                                                                                                         }
 463                                                                                   ],
 464                                                          },
 465                                         _Screens => {
 466                                                                  item_type =>'<Branch>',
 467                                                                  children => [
 468                                                                                           _Dx => {
 469                                                                                                           item_type => '<CheckMenuItem>',
 470                                                                                                           callback => sub { set_win(\$wantdx, $@)},
 471                                                                                                          },
 472                                                                                           _Announce => {
 473                                                                                                                         item_type => '<CheckItem>',
 474                                                                                                                         callback => sub { set_win(\$wantann, $@)},
 475                                                                                                                    },
 476                                                                                           _Chat => {
 477                                                                                                                 item_type => '<CheckItem>',
 478                                                                                                                 callback => sub { set_win(\$wantchat, $@)},
 479                                                                                                            },
 480                                                                                           _WWV => {
 481                                                                                                            item_type => '<CheckItem>',
 482                                                                                                            callback => sub { set_win(\$wantwwv, $@)},
 483                                                                                                           },
 484                                                                                           _WCY => {
 485                                                                                                            item_type => '<CheckItem>',
 486                                                                                                            callback => sub { set_win(\$wantwcy, $@)},
 487                                                                                                           },
 488                                                                                          ],
 489                                                                 },
 490
 491                                         _Help => {
 492                                                           item_type => '<Branch>',
 493                                                           children => [
 494                                                                                    _About => {
 495                                                                                                           callback_action => 9,
 496                                                                                                          },
 497                                                                                   ],
 498                                                          },
 499
 500                                    ];
 501
 502         my $menu = Gtk2::SimpleMenu->new(menu_tree => $menutree, default_callback => \&def_menu_callback, user_data => $user);
 503         $vbox->pack_start($menu->{widget}, 0, 1, 0);
 504
 505
 506         # a paned hbox is packed as the bottom of the vbox
 507 #       my $bhpane = Gtk2::HPaned->new;
 508 #       $vbox->pack_end($bhpane, 1, 1, 0);
 509
 510         # now create the lh and rh panes
 511 #       my $lhvpane = Gtk2::VPaned->new;
 512 #       my $rhvpane = Gtk2::VPaned->new;
 513 #       $bhpane->pack1($lhvpane, 1, 0);
 514 #       $bhpane->pack2($rhvpane, 1, 0);
 515
 516
 517         # The command list
 518 #       my $lhvbox = Gtk2::VBox->new(0, 1);
 519         $cmd = Screen::List->new(fields => [
 520                                                                                 RxTime => 'tt',
 521                                                                                 Information => 'ttlong',
 522                                                                            ],
 523                                                          size => [$scr_width, $scr_height * 0.66],
 524                                                         );
 525         $vbox->pack_start($cmd->widget, 1, 1, 0);
 526
 527
 528         # callsign and current date and time
 529         my $hbox = new Gtk2::HBox;
 530         my $calllabel = new Gtk2::Label($call);
 531         my $date = new Gtk2::Label(cldatetime(time));
 532         $date->{tick} = Glib::Timeout->add(1000, \&updatetime, $date);
 533         $hbox->pack_start( $calllabel, 0, 1, 0 );
 534         $hbox->pack_end($date, 0, 1, 0);
 535         $vbox->pack_start($hbox, 0, 1, 0);
 536         $vbox->pack_start(Gtk2::HSeparator->new, 0, 1, 0);
 537
 538         # the bottom handler
 539         $bot = new Gtk2::Entry;
 540         $bot->set_editable(1);
 541         $bot->signal_connect('activate', \&bothandler);
 542         $bot->can_default(1);
 543         $vbox->pack_end($bot, 0, 1, 0);
 544 #       $lhvpane->pack2($lhvbox, 1, 0);
 545         $bot->grab_default;
 546
 547         #
 548         #
 549         #
 550
 551         #
 552         # The announce list
 553         $annwin = new Gtk2::Window('toplevel');
 554         $ann = Screen::List->new(fields =>[
 555                                                                            RxTime => 'tt',
 556                                                                            From => 'tt',
 557                                                                            To => 'tt',
 558                                                                            Announcement => 'ttlesslong',
 559                                                                           ],
 560                                                          hint => 1,
 561                                                          frame => 'Announcements',
 562                                                          size => [$scr_width * 0.85, $scr_height * 0.25],
 563                                                         );
 564         $annwin->add($ann->widget);
 565 #       $annwin->show_all;
 566
 567         # The announce list
 568         $chatwin = new Gtk2::Window('toplevel');
 569         $chat = Screen::List->new(fields =>[
 570                                                                            RxTime => 'tt',
 571                                                                            From => 'tt',
 572                                                                            To => 'tt',
 573                                                                            Chat => 'ttlesslong',
 574                                                                           ],
 575                                                          hint => 1,
 576                                                          frame => 'Chat',
 577                                                          size => [$scr_width * 0.85, $scr_height * 0.25],
 578                                                         );
 579         $chatwin->add($chat->widget);
 580 #       $annwin->show_all;
 581
 582         # DX window
 583         $dxwin = new Gtk2::Window('toplevel');
 584         $dx = Screen::List->new(fields => [
 585                                                                            'RxTime' => 'tt',
 586                                                                            'QRG' => 'qrg',
 587                                                                            'DX Call' => 'tt',
 588                                                                            'Grid' => 'tt',
 589                                                                            'Remarks' => 'ttshort',
 590                                                                            'By' => 'tt',
 591                                                                            'Grid' => 'tt',
 592                                                                            'TxTime' => 'tt',
 593                                                                           ],
 594                                                         policy => [qw(never automatic)],
 595                                                         hint => 1,
 596                                                         frame => "DX Spots",
 597                                                         maxsize => 500,
 598                                                         size => [$scr_width * 0.9, $scr_height * 0.25],
 599                                                    );
 600 #       $rhvpane->pack1($dx->widget, 1, 0);
 601         $dxwin->add($dx->widget);
 602 #       $dxwin->show_all;
 603
 604         # The wwv list
 605         $wwvwin = new Gtk2::Window('toplevel');
 606         #       my $rhvbox = Gtk2::VBox->new(0, 1);
 607         $wwv = Screen::List->new( fields =>[
 608                                                                                 RxTime => 'tt',
 609                                                                                 From => 'tt',
 610                                                                                 SFI => 'int',
 611                                                                                 A => 'int',
 612                                                                                 K => 'int',
 613                                                                                 Remarks => 'ttshort',
 614                                                                                 Hour => 'tt'
 615                                                                            ],
 616                                                           hint => 1,
 617                                                           policy => ['never', 'automatic'],
 618                                                           frame => 'WWV Data',
 619                                                         );
 620         $wwvwin->add($wwv->widget);
 621 #       $wwvwin->show_all;
 622
 623 #       $rhvbox->pack_start($wwv->widget, 1, 1, 0);
 624
 625         # The wcy list
 626         $wcywin = new Gtk2::Window('toplevel');
 627         $wcy = Screen::List->new(fields => [
 628                                                                                 RxTime => 'tt',
 629                                                                                 From => 'tt',
 630                                                                                 K => 'int',
 631                                                                                 ExpK => 'int',
 632                                                                                 A => 'int',
 633                                                                                 R => 'int',
 634                                                                                 SFI => 'int',
 635                                                                                 SA => 'tt',
 636                                                                                 GMF => 'tt',
 637                                                                                 Aurora => 'tt',
 638                                                                                 Hour => 'tt'
 639                                                                            ],
 640                                                          hint => 1,
 641                                                          policy => ['never', 'automatic'],
 642                                                          frame => 'WCY Data',
 643                                                         );
 644
 645 #       $rhvbox->pack_start($wcy->widget, 1, 1, 0);
 646 #       $rhvbox->set_size_request($scr_width * 0.45, $scr_height * 0.33);
 647 #       $rhvpane->pack2($rhvbox, 1, 0);
 648         $wcywin->add($wcy->widget);
 649 #       $wcywin->show_all;
 650 }