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