gtkconsole/gtkconsole

   1 #!/usr/bin/perl -w
   2 #
   3 # A GTK based console program
   4 #
   5 # Copyright (c) 2001 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 = 'localhost';
  54 my $port = 7301;
  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);
 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 my $dxscroll = Gtk2::ScrolledWindow->new (undef, undef);
 153 $dxscroll->set_shadow_type ('etched-out');
 154 $dxscroll->set_policy ('never', 'automatic');
 155 #$dxscroll->set_size_request (700, 400);
 156 $dxscroll->add($dxlist);
 157 $dxscroll->set_border_width(5);
 158 $lhvbox->pack_start($dxscroll, 1, 1, 0);
 159
 160 # The command list
 161 my $cmdlist = Gtk2::SimpleList->new(
 162                                                                         RxTime => 'tt',
 163                                                                         Information => 'tt',
 164                                                                    );
 165 my $cmdscroll = Gtk2::ScrolledWindow->new (undef, undef);
 166 $cmdscroll->set_shadow_type ('etched-out');
 167 $cmdscroll->set_policy ('never', 'automatic');
 168 #$cmdscroll->set_size_request (700, 400);
 169 $cmdscroll->add($cmdlist);
 170 $cmdscroll->set_border_width(5);
 171 $lhvbox->pack_start($cmdscroll, 1, 1, 0);
 172
 173
 174 # nice little separator
 175 $lhvbox->pack_start(Gtk2::HSeparator->new, 0, 1, 0 );
 176
 177 # callsign and current date and time
 178 my $hbox = new Gtk2::HBox;
 179 my $calllabel = new Gtk2::Label($call);
 180 my $date = new Gtk2::Label(cldatetime(time));
 181 $date->{tick} = Glib::Timeout->add(1000, \&updatetime, 0);
 182 $hbox->pack_start( $calllabel, 0, 1, 0 );
 183 $hbox->pack_end($date, 0, 1, 0);
 184 $lhvbox->pack_start($hbox, 0, 1, 0);
 185 $lhvbox->pack_start(Gtk2::HSeparator->new, 0, 1, 0);
 186
 187 # the bottom handler
 188 my $bot = new Gtk2::Entry;
 189 $bot->set_editable(1);
 190 $bot->signal_connect('activate', \&bothandler);
 191 $bot->can_default(1);
 192 $lhvbox->pack_end($bot, 0, 1, 0);
 193 $bot->grab_default;
 194
 195 #
 196 # RIGHT HAND SIDE
 197 #
 198
 199 # The announce list
 200 my $annlist = Gtk2::SimpleList->new(
 201                                                                         RxTime => 'tt',
 202                                                                         From => 'tt',
 203                                                                         To => 'tt',
 204                                                                         Announcement => 'tt',
 205                                                                    );
 206 my $annscroll = Gtk2::ScrolledWindow->new (undef, undef);
 207 $annscroll->set_shadow_type ('etched-out');
 208 $annscroll->set_policy ('automatic', 'automatic');
 209 #$annscroll->set_size_request (700, 400);
 210 $annscroll->add($annlist);
 211 $annscroll->set_border_width(5);
 212 $rhvbox->pack_start($annscroll, 0, 1, 0);
 213
 214 # The wwv list
 215 my $wwvlist = Gtk2::SimpleList->new(
 216                                                                         RxTime => 'tt',
 217                                                                         From => 'tt',
 218                                                                         SFI => 'int',
 219                                                                         A => 'int',
 220                                                                         K => 'int',
 221                                                                         Remarks => 'tt',
 222                                                                         Hour => 'tt'
 223                                                                    );
 224 my $wwvscroll = Gtk2::ScrolledWindow->new (undef, undef);
 225 $wwvscroll->set_shadow_type ('etched-out');
 226 $wwvscroll->set_policy ('never', 'automatic');
 227 #$wwvscroll->set_size_request (700, 200);
 228 $wwvscroll->add($wwvlist);
 229 $wwvscroll->set_border_width(5);
 230 $rhvbox->pack_start($wwvscroll, 1, 1, 0);
 231
 232 # The wcy list
 233 my $wcylist = Gtk2::SimpleList->new(
 234                                                                         RxTime => 'tt',
 235                                                                         From => 'tt',
 236                                                                         K => 'int',
 237                                                                         ExpK => 'int',
 238                                                                         A => 'int',
 239                                                                         R => 'int',
 240                                                                         SFI => 'int',
 241                                                                         SA => 'tt',
 242                                                                         GMF => 'tt',
 243                                                                         Aurora => 'tt',
 244                                                                         Time => 'tt'
 245                                                                    );
 246 my $wcyscroll = Gtk2::ScrolledWindow->new (undef, undef);
 247 $wcyscroll->set_shadow_type ('etched-out');
 248 $wcyscroll->set_policy ('never', 'automatic');
 249 #$wcyscroll->set_size_request (700, 200);
 250 $wcyscroll->add($wcylist);
 251 $wcyscroll->set_border_width(5);
 252 $rhvbox->pack_start($wcyscroll, 1, 1, 0);
 253
 254 my $sock_helper = Gtk2::Helper->add_watch($sock->fileno, 'in', \&tophandler, $sock);
 255
 256 # the main loop
 257 $main->show_all;
 258 $bot->grab_focus;
 259 Gtk2->main;
 260 exit(0);
 261
 262 #
 263 # handlers
 264 #
 265
 266 sub updatetime
 267 {
 268         $date->set_text(cldatetime(time));
 269         1;
 270 }
 271
 272 sub bothandler
 273 {
 274         my ($self, $data) = @_;
 275         my $msg = $self->get_text;
 276         $msg =~ s/\r?\n$//;
 277         $self->set_text('');
 278         $self->grab_focus;
 279         senddata($msg);
 280 }
 281
 282 my $rbuf;
 283
 284 sub tophandler
 285 {
 286         my ($fd, $condx, $socket) = @_;
 287
 288         my $offset = length $rbuf;
 289         my $l = sysread($socket, $rbuf, 1024, $offset);
 290         if (defined $l) {
 291                 if ($l) {
 292                         while ($rbuf =~ s/^([^\015\012]*)\015?\012//) {
 293                                 my $msg = $1;
 294                                 handlemsg($msg);
 295                         }
 296                 } else {
 297                         Gtk2->main_quit;
 298                 }
 299         } else {
 300                 Gtk2->main_quit;
 301         }
 302         1;
 303
 304 }
 305
 306 sub handlemsg
 307 {
 308         my $line = shift;
 309
 310         # this is truely evil and I bet there is a better way...
 311         chomp $line;
 312         my $list;
 313         if ($line =~ /^'\w{2,4}',/) {
 314                 $list = eval qq([$line]);
 315         } else {
 316                 $list = ['cmd', $line];
 317         }
 318         unless ($@) {
 319                 no strict 'refs';
 320                 my $cmd = shift @$list;
 321                 my $handle = "handle_$cmd";
 322                 if (__PACKAGE__->can($handle)) {
 323                         __PACKAGE__->$handle($list);
 324                 } else {
 325                         push @$list, $cmd;
 326                         __PACKAGE__->handle_def($list);
 327                 }
 328         }
 329 }
 330
 331 sub handle_cmd
 332 {
 333         my $self = shift;
 334         my $ref = shift;
 335         my ($t, $ts) = (time, '');
 336         my $s;
 337         $s = ref $ref ? join ', ',@$ref : $ref;
 338
 339         if (exists $cmdlist->{lasttime} != $t) {
 340                 $ts = tim($t);
 341                 $cmdlist->{lasttime} = $t;
 342         }
 343
 344         chomp $s;
 345         push @{$cmdlist->{data}}, [$ts,  $s];
 346 }
 347
 348 sub handle_def
 349 {
 350         my $self = shift;
 351         my $ref = shift;
 352         my $s;
 353         $s = ref $ref ? join ', ',@$ref : $ref;
 354         my ($t, $ts) = (time, '');
 355
 356         if (exists $cmdlist->{lasttime} != $t) {
 357                 $ts = tim($t);
 358                 $cmdlist->{lasttime} = $t;
 359         }
 360
 361         chomp $s;
 362         push @{$cmdlist->{data}}, [$ts,  $s];
 363 }
 364
 365 sub handle_dx
 366 {
 367         my $self = shift;
 368         my $ref = shift;
 369         my ($t, $ts) = (time, '');
 370
 371         if (exists $dxlist->{lasttime} != $t) {
 372                 $ts = tim($t);
 373                 $dxlist->{lasttime} = $t;
 374         }
 375         push @{$dxlist->{data}}, [$ts,  @$ref[0,1,15,3,4,16], stim($ref->[2]) ];
 376
 377 }
 378
 379 sub handle_ann
 380 {
 381         my $self = shift;
 382         my $ref = shift;
 383         my ($t, $ts) = (time, '');
 384         my $s;
 385         $s = ref $ref ? join ', ',@$ref : $ref;
 386
 387         if (exists $cmdlist->{lasttime} != $t) {
 388                 $ts = tim($t);
 389                 $cmdlist->{lasttime} = $t;
 390         }
 391
 392         chomp $s;
 393         push @{$cmdlist->{data}}, [$ts,  @$ref[0,1,2]];
 394 }
 395
 396 sub handle_wcy
 397 {
 398         my $self = shift;
 399         my $ref = shift;
 400         my $s;
 401         $s = ref $ref ? join ', ',@$ref : $ref;
 402
 403         chomp $s;
 404         push @{$cmdlist->{data}}, [tim(),  @$ref[10,4,5,3,6,2,7,8,9,1] ];
 405 }
 406
 407 sub handle_wwv
 408 {
 409         my $self = shift;
 410         my $ref = shift;
 411         my $s;
 412         $s = ref $ref ? join ', ',@$ref : $ref;
 413
 414         chomp $s;
 415         push @{$cmdlist->{data}}, [tim(),  @$ref[6,2,3,4,5,1] ];
 416 }
 417
 418 #
 419 # subroutine
 420 #
 421
 422 sub senddata
 423 {
 424         my $msg = shift;
 425         sendmsg('I', $msg);
 426 }
 427
 428 sub sendmsg
 429 {
 430         my ($let, $msg) = @_;
 431 #       $msg =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg;
 432 #       $sock->print("$let$call|$msg\n");
 433         $sock->print("$msg\n");
 434 }
 435
 436 sub tim
 437 {
 438         my $t = shift || time;
 439         return sprintf "%02d:%02d:%02d", (gmtime($t))[2,1,0];
 440 }
 441
 442 sub stim
 443 {
 444         my $t = shift || time;
 445         return sprintf "%02d:%02d", (gmtime($t))[2,1];
 446 }