gtkconsole/gtkconsole

   1 #!/usr/bin/perl -w
   2 #
   3 # A GTK based console program
   4 #
   5 # Copyright (c) 2001-6 Dirk Koopman G1TLH
   6 #
   7 # $Id$
   8 #
   9
  10 use strict;
  11
  12 our $root;
  13
  14 # search local then perl directories
  15 BEGIN {
  16         # root of directory tree for this system
  17         $root = "/spider";
  18         $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
  19
  20         unshift @INC, "$root/perl";     # this IS the right way round!
  21         unshift @INC, "$root/gtkconsole";
  22         unshift @INC, "$root/local";
  23 }
  24
  25 use Glib;
  26 use Gtk2 qw(-init);
  27 use Gtk2::Helper;
  28 use Gtk2::SimpleList;
  29
  30 use Text::Wrap;
  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 DXVars;
  38 use DXUtil;
  39 use IO::Socket::INET;
  40
  41 #
  42 # read in gtkconsole file
  43
  44 Gtk2::Rc->set_default_files("$root/gtkconsole/gtkconsolerc", "$ENV{HOME}/.gtkconsolerc", ".gtkconsolerc");
  45 print join(', ', Gtk2::Rc->get_default_files), "\n";
  46 Gtk2::Rc->reparse_all;
  47
  48 #
  49 # main initialisation
  50 #
  51 my $call = uc shift @ARGV if @ARGV;
  52 $call = uc $main::myalias unless $call;
  53 my ($scall, $ssid) = split /-/, $call;
  54 $ssid = undef unless $ssid && $ssid =~ /^\d+$/;
  55 if ($ssid) {
  56         $ssid = 15 if $ssid > 15;
  57         $call = "$scall-$ssid";
  58 }
  59
  60 die "You cannot connect as your cluster callsign ($main::mycall)\n" if $call eq $main::mycall;
  61
  62 my $host = 'gb7djk.dxcluster.net';
  63 my $port = 7300;
  64
  65 my $sock = IO::Socket::INET->new(PeerAddr=>$host, PeerPort=>$port);
  66 die "Cannot connect to  $host/$port ($!)\n" unless $sock;
  67 sendmsg('I', $call);
  68 sendmsg('I', 'set/gtk');
  69 #sendmsg('A', 'local');
  70 #sendmsg('G', '2');
  71 sendmsg('I', 'set/page 500');
  72 sendmsg('I', 'set/nobeep');
  73
  74 #
  75 # start of GTK stuff
  76 #
  77
  78
  79 #
  80 # +--------+-------+------------------------------------------------------------------------------------+
  81 # | _File  | _Help |                                                                                    |
  82 # +--------+-------+------------------------------------------------------------------------------------+
  83 #
  84 # main window
  85 my $main = new Gtk2::Window('toplevel');
  86 my $scr = $main->get_screen;
  87 my $scr_width = $scr->get_width;
  88 my $scr_height = $scr->get_height;
  89 $main->set_default_size($scr_width, $scr_height/2);
  90 $main->signal_connect('delete_event', sub { Gtk2->main_quit; });
  91 $main->set_title("gtkconsole - The DXSpider Console - $call");
  92
  93 # the main vbox
  94 my $vbox = new Gtk2::VBox(0, 1);
  95 $main->add($vbox);
  96
  97
  98 # the menu bar
  99 my @menu = (
 100                         {path => '/_File', type => '<Branch>'},
 101                         {path => '/_File/Quit', callback => sub {Gtk2->main_quit}},
 102                         {path => '/_Help', type => '<LastBranch>'},
 103                         {path => '/_Help/About'},
 104                    );
 105 my $itemf = new Gtk2::ItemFactory('Gtk2::MenuBar', '<main>');
 106 $itemf->create_items(@menu);
 107 my $menu = $itemf->get_widget('<main>');
 108 $vbox->pack_start($menu, 0, 1, 0);
 109
 110
 111 # a paned hbox is packed as the bottom of the vbox
 112 my $bhpane = Gtk2::HPaned->new;
 113 $vbox->pack_end($bhpane, 1, 1, 0);
 114
 115 # now create the lh and rh panes
 116 my $lhvpane = Gtk2::VPaned->new;
 117 my $rhvpane = Gtk2::VPaned->new;
 118 $bhpane->pack1($lhvpane, 1, 0);
 119 $bhpane->pack2($rhvpane, 1, 0);
 120
 121 # first add a column type for the QRG
 122 my $font = 'monospace 9';
 123 my $oddbg = 'light blue';
 124 my $evenbg = 'white';
 125
 126 Gtk2::SimpleList->add_column_type( 'qrg',
 127                      type     => 'Glib::Scalar',
 128                      renderer => 'Gtk2::CellRendererText',
 129                      attr     => sub {
 130                           my ($treecol, $cell, $model, $iter, $col_num) = @_;
 131                           my $info = $model->get ($iter, $col_num);
 132                           $cell->set(text => sprintf("%.1f", $info), font => $font, xalign => 1.0);
 133                      }
 134                 );
 135
 136
 137 Gtk2::SimpleList->add_column_type( 'tt',
 138                      type     => 'Glib::Scalar',
 139                      renderer => 'Gtk2::CellRendererText',
 140                      attr     => sub {
 141                           my ($treecol, $cell, $model, $iter, $col_num) = @_;
 142                           my $info = $model->get ($iter, $col_num);
 143                           $cell->set(text => $info, font => $font);
 144                      }
 145                 );
 146
 147 Gtk2::SimpleList->add_column_type( 'ttlong',
 148                      type     => 'Glib::Scalar',
 149                      renderer => 'Gtk2::CellRendererText',
 150                      attr     => sub {
 151                           my ($treecol, $cell, $model, $iter, $col_num) = @_;
 152                           my $info = $model->get ($iter, $col_num);
 153                                                   $Text::Wrap::columns = 80;
 154                           $cell->set(text => join("\n",wrap("","",$info)), font => $font);
 155                      }
 156                 );
 157
 158 Gtk2::SimpleList->add_column_type( 'ttlesslong',
 159                      type     => 'Glib::Scalar',
 160                      renderer => 'Gtk2::CellRendererText',
 161                      attr     => sub {
 162                           my ($treecol, $cell, $model, $iter, $col_num) = @_;
 163                           my $info = $model->get ($iter, $col_num);
 164                                                   $Text::Wrap::columns = 65;
 165                           $cell->set(text => join("\n",wrap("","",$info)), font => $font);
 166                      }
 167                 );
 168
 169 Gtk2::SimpleList->add_column_type( 'ttshort',
 170                      type     => 'Glib::Scalar',
 171                      renderer => 'Gtk2::CellRendererText',
 172                      attr     => sub {
 173                           my ($treecol, $cell, $model, $iter, $col_num) = @_;
 174                           my $info = $model->get ($iter, $col_num);
 175                                                   $Text::Wrap::columns = 30;
 176                           $cell->set(text => join("\n",wrap("","",$info)), font => $font);
 177                      }
 178                 );
 179
 180
 181 #
 182 # LEFT HAND SIDE
 183 #
 184
 185 # DX window
 186 my $dxlist = Gtk2::SimpleList->new(
 187                                                                    'RxTime' => 'tt',
 188                                                                    'QRG' => 'qrg',
 189                                                                    'DX Call' => 'tt',
 190                                                                    'Grid' => 'tt',
 191                                                                    'Remarks' => 'ttshort',
 192                                                                    'By' => 'tt',
 193                                                                    'Grid' => 'tt',
 194                                                                    'TxTime' => 'tt',
 195                                                                   );
 196 $dxlist->set_rules_hint(1);
 197 my $dxscroll = Gtk2::ScrolledWindow->new (undef, undef);
 198 $dxscroll->set_shadow_type ('etched-out');
 199 $dxscroll->set_policy ('never', 'automatic');
 200 #$dxscroll->set_size_request (700, 400);
 201 $dxscroll->add($dxlist);
 202 $dxscroll->set_border_width(5);
 203
 204 $lhvpane->pack1($dxscroll, 1, 0);
 205
 206 # The command list
 207 my $lhvbox = Gtk2::VBox->new(0, 1);
 208 my $cmdlist = Gtk2::SimpleList->new(
 209                                                                         RxTime => 'tt',
 210                                                                         Information => 'ttlong',
 211                                                                    );
 212 my $cmdscroll = Gtk2::ScrolledWindow->new (undef, undef);
 213 $cmdscroll->set_shadow_type ('etched-out');
 214 $cmdscroll->set_policy ('automatic', 'automatic');
 215 #$cmdscroll->set_size_request (700, 400);
 216 $cmdscroll->add($cmdlist);
 217 $cmdscroll->set_border_width(5);
 218 $lhvbox->pack_start($cmdscroll, 1, 1, 0);
 219
 220
 221 # callsign and current date and time
 222 my $hbox = new Gtk2::HBox;
 223 my $calllabel = new Gtk2::Label($call);
 224 my $date = new Gtk2::Label(cldatetime(time));
 225 $date->{tick} = Glib::Timeout->add(1000, \&updatetime, 0);
 226 $hbox->pack_start( $calllabel, 0, 1, 0 );
 227 $hbox->pack_end($date, 0, 1, 0);
 228 $lhvbox->pack_start($hbox, 0, 1, 0);
 229 $lhvbox->pack_start(Gtk2::HSeparator->new, 0, 1, 0);
 230
 231 # the bottom handler
 232 my $bot = new Gtk2::Entry;
 233 $bot->set_editable(1);
 234 $bot->signal_connect('activate', \&bothandler);
 235 $bot->can_default(1);
 236 $lhvbox->pack_end($bot, 0, 1, 0);
 237 $lhvpane->pack2($lhvbox, 1, 0);
 238 $bot->grab_default;
 239
 240 #
 241 # RIGHT HAND SIDE
 242 #
 243
 244 # The announce list
 245 my $annlist = Gtk2::SimpleList->new(
 246                                                                         RxTime => 'tt',
 247                                                                         From => 'tt',
 248                                                                         To => 'tt',
 249                                                                         Announcement => 'ttlesslong',
 250                                                                    );
 251 $annlist->set_rules_hint(1);
 252 my $annscroll = Gtk2::ScrolledWindow->new (undef, undef);
 253 $annscroll->set_shadow_type ('etched-out');
 254 $annscroll->set_policy ('automatic', 'automatic');
 255 #$annscroll->set_size_request (700, 400);
 256 $annscroll->add($annlist);
 257 $annscroll->set_border_width(5);
 258 $rhvpane->pack1($annscroll, 1, 0);
 259
 260 # The wwv list
 261 my $rhvbox = Gtk2::VBox->new(0, 1);
 262
 263 my $wwvlist = Gtk2::SimpleList->new(
 264                                                                         RxTime => 'tt',
 265                                                                         From => 'tt',
 266                                                                         SFI => 'int',
 267                                                                         A => 'int',
 268                                                                         K => 'int',
 269                                                                         Remarks => 'ttshort',
 270                                                                         Hour => 'tt'
 271                                                                    );
 272 $wwvlist->set_rules_hint(1);
 273 my $wwvscroll = Gtk2::ScrolledWindow->new (undef, undef);
 274 $wwvscroll->set_shadow_type ('etched-out');
 275 $wwvscroll->set_policy ('never', 'automatic');
 276 #$wwvscroll->set_size_request (700, 200);
 277 $wwvscroll->add($wwvlist);
 278 $wwvscroll->set_border_width(5);
 279 $rhvbox->pack_start($wwvscroll, 1, 1, 0);
 280
 281 # The wcy list
 282 my $wcylist = Gtk2::SimpleList->new(
 283                                                                         RxTime => 'tt',
 284                                                                         From => 'tt',
 285                                                                         K => 'int',
 286                                                                         ExpK => 'int',
 287                                                                         A => 'int',
 288                                                                         R => 'int',
 289                                                                         SFI => 'int',
 290                                                                         SA => 'tt',
 291                                                                         GMF => 'tt',
 292                                                                         Aurora => 'tt',
 293                                                                         Hour => 'tt'
 294                                                                    );
 295 $wcylist->set_rules_hint(1);
 296 my $wcyscroll = Gtk2::ScrolledWindow->new (undef, undef);
 297 $wcyscroll->set_shadow_type ('etched-out');
 298 $wcyscroll->set_policy ('never', 'automatic');
 299 $wcyscroll->add($wcylist);
 300 $wcyscroll->set_border_width(5);
 301 $rhvbox->pack_start($wcyscroll, 1, 1, 0);
 302 $rhvbox->set_size_request (-1, $scr_height / 4);
 303
 304
 305 $rhvpane->pack2($rhvbox, 1, 0);
 306
 307 my $sock_helper = Gtk2::Helper->add_watch($sock->fileno, 'in', \&tophandler, $sock);
 308
 309 # the main loop
 310 $main->show_all;
 311 $bot->grab_focus;
 312 Gtk2->main;
 313 exit(0);
 314
 315 #
 316 # handlers
 317 #
 318
 319 sub updatetime
 320 {
 321         $date->set_text(cldatetime(time));
 322         1;
 323 }
 324
 325 sub bothandler
 326 {
 327         my ($self, $data) = @_;
 328         my $msg = $self->get_text;
 329         $msg =~ s/\r?\n$//;
 330         $self->set_text('');
 331         $self->grab_focus;
 332         senddata($msg);
 333 }
 334
 335 my $rbuf;
 336
 337 sub tophandler
 338 {
 339         my ($fd, $condx, $socket) = @_;
 340
 341         my $offset = length $rbuf;
 342         my $l = sysread($socket, $rbuf, 1024, $offset);
 343         if (defined $l) {
 344                 if ($l) {
 345                         while ($rbuf =~ s/^([^\015\012]*)\015?\012//) {
 346                                 my $msg = $1;
 347                                 handlemsg($msg);
 348                         }
 349                 } else {
 350                         Gtk2->main_quit;
 351                 }
 352         } else {
 353                 Gtk2->main_quit;
 354         }
 355         1;
 356
 357 }
 358
 359 sub handlemsg
 360 {
 361         my $line = shift;
 362
 363         # this is truely evil and I bet there is a better way...
 364         chomp $line;
 365         my $list;
 366         if ($line =~ /^'\w{2,4}',/) {
 367                 $list = eval qq([$line]);
 368         } else {
 369                 $list = ['cmd', $line];
 370         }
 371         unless ($@) {
 372                 no strict 'refs';
 373                 my $cmd = shift @$list;
 374                 my $handle = "handle_$cmd";
 375                 if (__PACKAGE__->can($handle)) {
 376                         __PACKAGE__->$handle($list);
 377                 } else {
 378                         unshift @$list, $cmd;
 379                         __PACKAGE__->handle_def($list);
 380                 }
 381         }
 382 }
 383
 384 sub handle_cmd
 385 {
 386         my $self = shift;
 387         my $ref = shift;
 388         my ($t, $ts) = (time, '');
 389         my $s;
 390         $s = ref $ref ? join ', ',@$ref : $ref;
 391
 392         if (($cmdscroll->{lasttime}||0) != $t) {
 393                 $ts = tim($t);
 394                 $cmdscroll->{lasttime} = $t;
 395         }
 396
 397         chomp $s;
 398         push @{$cmdlist->{data}}, [$ts,  $s];
 399 }
 400
 401 sub handle_def
 402 {
 403         my $self = shift;
 404         my $ref = shift;
 405         my $s;
 406         $s = ref $ref ? join ', ',@$ref : $ref;
 407         my ($t, $ts) = (time, '');
 408
 409         if (($cmdscroll->{lasttime}||0) != $t) {
 410                 $ts = tim($t);
 411                 $cmdscroll->{lasttime} = $t;
 412         }
 413
 414         chomp $s;
 415         push @{$cmdlist->{data}}, [$ts,  $s];
 416 }
 417
 418 sub handle_dx
 419 {
 420         my $self = shift;
 421         my $ref = shift;
 422         my ($t, $ts) = (time, '');
 423
 424         if (($dxscroll->{lasttime}||0) != $t) {
 425                 $ts = tim($t);
 426                 $dxscroll->{lasttime} = $t;
 427         }
 428         push @{$dxlist->{data}}, [$ts,  @$ref[0,1,15,3,4,16], stim($ref->[2]) ];
 429
 430 }
 431
 432 sub handle_ann
 433 {
 434         my $self = shift;
 435         my $ref = shift;
 436         my ($t, $ts) = (time, '');
 437         my $s;
 438         $s = ref $ref ? join ', ',@$ref : $ref;
 439
 440         if (($annscroll->{lasttime}||0) != $t) {
 441                 $ts = tim($t);
 442                 $annscroll->{lasttime} = $t;
 443         }
 444
 445         chomp $s;
 446         push @{$annlist->{data}}, [$ts,  @$ref[3,1,2]];
 447 }
 448
 449 sub handle_wcy
 450 {
 451         my $self = shift;
 452         my $ref = shift;
 453         my $s;
 454         $s = ref $ref ? join ', ',@$ref : $ref;
 455
 456         chomp $s;
 457         push @{$wcylist->{data}}, [tim(),  @$ref[10,4,5,3,6,2,7,8,9,1] ];
 458 }
 459
 460 sub handle_wwv
 461 {
 462         my $self = shift;
 463         my $ref = shift;
 464         my $s;
 465         $s = ref $ref ? join ', ',@$ref : $ref;
 466
 467         chomp $s;
 468         push @{$wwvlist->{data}}, [tim(),  @$ref[6,2,3,4,5,1] ];
 469 }
 470
 471 #
 472 # subroutine
 473 #
 474
 475 sub senddata
 476 {
 477         my $msg = shift;
 478         sendmsg('I', $msg);
 479 }
 480
 481 sub sendmsg
 482 {
 483         my ($let, $msg) = @_;
 484 #       $msg =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg;
 485 #       $sock->print("$let$call|$msg\n");
 486         $sock->print("$msg\n");
 487 }
 488
 489 sub tim
 490 {
 491         my $t = shift || time;
 492         return sprintf "%02d:%02d:%02d", (gmtime($t))[2,1,0];
 493 }
 494
 495 sub stim
 496 {
 497         my $t = shift || time;
 498         return sprintf "%02d:%02d", (gmtime($t))[2,1];
 499 }