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 $dxlist->get_model->signal_connect('row-changed', \&row_inserted, $dxlist);
 198 my $dxscroll = Gtk2::ScrolledWindow->new (undef, undef);
 199 $dxscroll->set_shadow_type ('etched-out');
 200 $dxscroll->set_policy ('never', 'automatic');
 201 #$dxscroll->set_size_request (700, 400);
 202 $dxscroll->add($dxlist);
 203 $dxscroll->set_border_width(5);
 204
 205 $lhvpane->pack1($dxscroll, 1, 0);
 206
 207 # The command list
 208 my $lhvbox = Gtk2::VBox->new(0, 1);
 209 my $cmdlist = Gtk2::SimpleList->new(
 210                                                                         RxTime => 'tt',
 211                                                                         Information => 'ttlong',
 212                                                                    );
 213 my $cmdscroll = Gtk2::ScrolledWindow->new (undef, undef);
 214 $cmdscroll->set_shadow_type ('etched-out');
 215 $cmdscroll->set_policy ('automatic', 'automatic');
 216 #$cmdscroll->set_size_request (700, 400);
 217 $cmdscroll->add($cmdlist);
 218 $cmdscroll->set_border_width(5);
 219 $cmdlist->get_model->signal_connect('row-changed', \&row_inserted, $cmdlist);
 220
 221 $lhvbox->pack_start($cmdscroll, 1, 1, 0);
 222
 223
 224 # callsign and current date and time
 225 my $hbox = new Gtk2::HBox;
 226 my $calllabel = new Gtk2::Label($call);
 227 my $date = new Gtk2::Label(cldatetime(time));
 228 $date->{tick} = Glib::Timeout->add(1000, \&updatetime, 0);
 229 $hbox->pack_start( $calllabel, 0, 1, 0 );
 230 $hbox->pack_end($date, 0, 1, 0);
 231 $lhvbox->pack_start($hbox, 0, 1, 0);
 232 $lhvbox->pack_start(Gtk2::HSeparator->new, 0, 1, 0);
 233
 234 # the bottom handler
 235 my $bot = new Gtk2::Entry;
 236 $bot->set_editable(1);
 237 $bot->signal_connect('activate', \&bothandler);
 238 $bot->can_default(1);
 239 $lhvbox->pack_end($bot, 0, 1, 0);
 240 $lhvpane->pack2($lhvbox, 1, 0);
 241 $bot->grab_default;
 242
 243 #
 244 # RIGHT HAND SIDE
 245 #
 246
 247 # The announce list
 248 my $annlist = Gtk2::SimpleList->new(
 249                                                                         RxTime => 'tt',
 250                                                                         From => 'tt',
 251                                                                         To => 'tt',
 252                                                                         Announcement => 'ttlesslong',
 253                                                                    );
 254 $annlist->set_rules_hint(1);
 255 $annlist->get_model->signal_connect('row-changed', \&row_inserted, $annlist);
 256 my $annscroll = Gtk2::ScrolledWindow->new (undef, undef);
 257 $annscroll->set_shadow_type ('etched-out');
 258 $annscroll->set_policy ('automatic', 'automatic');
 259 #$annscroll->set_size_request (700, 400);
 260 $annscroll->add($annlist);
 261 $annscroll->set_border_width(5);
 262 $rhvpane->pack1($annscroll, 1, 0);
 263
 264 # The wwv list
 265 my $rhvbox = Gtk2::VBox->new(0, 1);
 266
 267 my $wwvlist = Gtk2::SimpleList->new(
 268                                                                         RxTime => 'tt',
 269                                                                         From => 'tt',
 270                                                                         SFI => 'int',
 271                                                                         A => 'int',
 272                                                                         K => 'int',
 273                                                                         Remarks => 'ttshort',
 274                                                                         Hour => 'tt'
 275                                                                    );
 276 $wwvlist->set_rules_hint(1);
 277 $wwvlist->get_model->signal_connect('row-changed', \&row_inserted, $wwvlist);
 278 my $wwvscroll = Gtk2::ScrolledWindow->new (undef, undef);
 279 $wwvscroll->set_shadow_type ('etched-out');
 280 $wwvscroll->set_policy ('never', 'automatic');
 281 #$wwvscroll->set_size_request (700, 200);
 282 $wwvscroll->add($wwvlist);
 283 $wwvscroll->set_border_width(5);
 284 $rhvbox->pack_start($wwvscroll, 1, 1, 0);
 285
 286 # The wcy list
 287 my $wcylist = Gtk2::SimpleList->new(
 288                                                                         RxTime => 'tt',
 289                                                                         From => 'tt',
 290                                                                         K => 'int',
 291                                                                         ExpK => 'int',
 292                                                                         A => 'int',
 293                                                                         R => 'int',
 294                                                                         SFI => 'int',
 295                                                                         SA => 'tt',
 296                                                                         GMF => 'tt',
 297                                                                         Aurora => 'tt',
 298                                                                         Hour => 'tt'
 299                                                                    );
 300 $wcylist->set_rules_hint(1);
 301 $wcylist->get_model->signal_connect('row-changed', \&row_inserted, $wcylist);
 302 my $wcyscroll = Gtk2::ScrolledWindow->new (undef, undef);
 303 $wcyscroll->set_shadow_type ('etched-out');
 304 $wcyscroll->set_policy ('never', 'automatic');
 305 $wcyscroll->add($wcylist);
 306 $wcyscroll->set_border_width(5);
 307 $rhvbox->pack_start($wcyscroll, 1, 1, 0);
 308 $rhvbox->set_size_request (-1, $scr_height / 4);
 309
 310
 311 $rhvpane->pack2($rhvbox, 1, 0);
 312
 313 my $sock_helper = Gtk2::Helper->add_watch($sock->fileno, 'in', \&tophandler, $sock);
 314
 315 # the main loop
 316 $main->show_all;
 317 $bot->grab_focus;
 318 Gtk2->main;
 319 exit(0);
 320
 321 #
 322 # handlers
 323 #
 324
 325 sub updatetime
 326 {
 327         $date->set_text(cldatetime(time));
 328         1;
 329 }
 330
 331 sub bothandler
 332 {
 333         my ($self, $data) = @_;
 334         my $msg = $self->get_text;
 335         $msg =~ s/\r?\n$//;
 336         $self->set_text('');
 337         $self->grab_focus;
 338         senddata($msg);
 339 }
 340
 341 my $rbuf;
 342
 343 sub tophandler
 344 {
 345         my ($fd, $condx, $socket) = @_;
 346
 347         my $offset = length $rbuf;
 348         my $l = sysread($socket, $rbuf, 1024, $offset);
 349         if (defined $l) {
 350                 if ($l) {
 351                         while ($rbuf =~ s/^([^\015\012]*)\015?\012//) {
 352                                 my $msg = $1;
 353                                 handlemsg($msg);
 354                         }
 355                 } else {
 356                         Gtk2->main_quit;
 357                 }
 358         } else {
 359                 Gtk2->main_quit;
 360         }
 361         1;
 362
 363 }
 364
 365 sub handlemsg
 366 {
 367         my $line = shift;
 368
 369         # this is truely evil and I bet there is a better way...
 370         chomp $line;
 371         my $list;
 372         if ($line =~ /^'\w{2,4}',/) {
 373                 $list = eval qq([$line]);
 374         } else {
 375                 $list = ['cmd', $line];
 376         }
 377         unless ($@) {
 378                 no strict 'refs';
 379                 my $cmd = shift @$list;
 380                 my $handle = "handle_$cmd";
 381                 if (__PACKAGE__->can($handle)) {
 382                         __PACKAGE__->$handle($list);
 383                 } else {
 384                         unshift @$list, $cmd;
 385                         __PACKAGE__->handle_def($list);
 386                 }
 387         }
 388 }
 389
 390 sub handle_cmd
 391 {
 392         my $self = shift;
 393         my $ref = shift;
 394         my ($t, $ts) = (time, '');
 395         my $s;
 396         $s = ref $ref ? join ', ',@$ref : $ref;
 397
 398         if (($cmdscroll->{lasttime}||0) != $t) {
 399                 $ts = tim($t);
 400                 $cmdscroll->{lasttime} = $t;
 401         }
 402
 403         chomp $s;
 404         push @{$cmdlist->{data}}, [$ts,  $s];
 405 }
 406
 407 sub handle_def
 408 {
 409         my $self = shift;
 410         my $ref = shift;
 411         my $s;
 412         $s = ref $ref ? join ', ',@$ref : $ref;
 413         my ($t, $ts) = (time, '');
 414
 415         if (($cmdscroll->{lasttime}||0) != $t) {
 416                 $ts = tim($t);
 417                 $cmdscroll->{lasttime} = $t;
 418         }
 419
 420         chomp $s;
 421         push @{$cmdlist->{data}}, [$ts,  $s];
 422 }
 423
 424 sub handle_dx
 425 {
 426         my $self = shift;
 427         my $ref = shift;
 428         my ($t, $ts) = (time, '');
 429
 430         if (($dxscroll->{lasttime}||0) != $t) {
 431                 $ts = tim($t);
 432                 $dxscroll->{lasttime} = $t;
 433         }
 434         push @{$dxlist->{data}}, [$ts,  @$ref[0,1,15,3,4,16], stim($ref->[2]) ];
 435
 436 }
 437
 438 sub handle_ann
 439 {
 440         my $self = shift;
 441         my $ref = shift;
 442         my ($t, $ts) = (time, '');
 443         my $s;
 444         $s = ref $ref ? join ', ',@$ref : $ref;
 445
 446         if (($annscroll->{lasttime}||0) != $t) {
 447                 $ts = tim($t);
 448                 $annscroll->{lasttime} = $t;
 449         }
 450
 451         chomp $s;
 452         push @{$annlist->{data}}, [$ts,  @$ref[3,1,2]];
 453 }
 454
 455 sub handle_wcy
 456 {
 457         my $self = shift;
 458         my $ref = shift;
 459         my $s;
 460         $s = ref $ref ? join ', ',@$ref : $ref;
 461
 462         chomp $s;
 463         push @{$wcylist->{data}}, [tim(),  @$ref[10,4,5,3,6,2,7,8,9,1] ];
 464 }
 465
 466 sub handle_wwv
 467 {
 468         my $self = shift;
 469         my $ref = shift;
 470         my $s;
 471         $s = ref $ref ? join ', ',@$ref : $ref;
 472
 473         chomp $s;
 474         push @{$wwvlist->{data}}, [tim(),  @$ref[6,2,3,4,5,1] ];
 475 }
 476
 477
 478 sub row_inserted
 479 {
 480         my ($list, $path, $iter, $tree) = @_;
 481 #       print $list->get_string_from_iter, "\n";
 482         $tree->scroll_to_cell($path, undef, 0, 0, 0);
 483 }
 484
 485 sub row_activated
 486 {
 487         my ($tree, $path, $col) = @_;
 488         print "row activated\n";
 489         $tree->scroll_to_cell($path, undef, 0, 0, 0);
 490 }
 491
 492 #
 493 # subroutine
 494 #
 495
 496 sub senddata
 497 {
 498         my $msg = shift;
 499         sendmsg('I', $msg);
 500 }
 501
 502 sub sendmsg
 503 {
 504         my ($let, $msg) = @_;
 505 #       $msg =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg;
 506 #       $sock->print("$let$call|$msg\n");
 507         $sock->print("$msg\n");
 508 }
 509
 510 sub tim
 511 {
 512         my $t = shift || time;
 513         return sprintf "%02d:%02d:%02d", (gmtime($t))[2,1,0];
 514 }
 515
 516 sub stim
 517 {
 518         my $t = shift || time;
 519         return sprintf "%02d:%02d", (gmtime($t))[2,1];
 520 }