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