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/local";
  18 }
  19
  20 use strict;
  21
  22 use vars qw(@modules);
  23
  24 @modules = ();                                  # is the list of modules that need init calling
  25                                                                 # on them. It is set up by each  'use'ed module
  26                                                                 # that has Gtk stuff in it
  27
  28 use DXVars;
  29 use IO::Socket::INET;
  30 use Gtk qw(-init);
  31 use Text;
  32 use DebugHandler;
  33
  34 #
  35 # main initialisation
  36 #
  37 my $call = uc shift @ARGV if @ARGV;
  38 $call = uc $main::myalias unless $call;
  39 my ($scall, $ssid) = split /-/, $call;
  40 $ssid = undef unless $ssid && $ssid =~ /^\d+$/;
  41 if ($ssid) {
  42         $ssid = 15 if $ssid > 15;
  43         $call = "$scall-$ssid";
  44 }
  45
  46 die "You cannot connect as your cluster callsign ($main::mycall)\n" if $call eq $main::mycall;
  47
  48
  49 my $sock = IO::Socket::INET->new(PeerAddr=>$main::clusteraddr, PeerPort=>$main::clusterport);
  50 die "Cannot connect to $main::clusteraddr/$main::clusterport ($!)\n" unless $sock;
  51 sendmsg('A', 'local');
  52 sendmsg('G', '2');
  53 sendmsg('I', 'set/page 500');
  54 sendmsg('I', 'set/nobeep');
  55
  56 #
  57 # start of GTK stuff
  58 #
  59
  60
  61 # main window
  62 my $main = new Gtk::Window('toplevel');
  63 $main->set_default_size(600, 600);
  64 $main->set_policy(0, 1, 0);
  65 $main->signal_connect('destroy', sub { Gtk->exit(0); });
  66 $main->signal_connect('delete_event', sub { Gtk->exit(0); });
  67 $main->set_title("gtkconsole - The DXSpider Console - $call");
  68
  69 # the main vbox
  70 my $vbox = new Gtk::VBox(0, 1);
  71 $vbox->border_width(1);
  72 $main->add($vbox);
  73 $vbox->show;
  74
  75 # the menu bar
  76 my @menu = (
  77                         {path => '/_File', type => '<Branch>'},
  78                         {path => '/_File/Quit', callback => sub {Gtk->exit(0)}},
  79                         {path => '/_Help', type => '<LastBranch>'},
  80                         {path => '/_Help/About'},
  81                    );
  82 my $accel = new Gtk::AccelGroup();
  83 my $itemf = new Gtk::ItemFactory('Gtk::MenuBar', '<main>', $accel);
  84 $itemf->create_items(@menu);
  85 $main->add_accel_group($accel);
  86 my $menu = $itemf->get_widget('<main>');
  87 $vbox->pack_start($menu, 0, 1, 0);
  88 $menu->show;
  89
  90 # create a vertically paned window and stick it in the bottom of the screen
  91 my $paned = new Gtk::VPaned;
  92 $vbox->pack_end($paned, 1, 1, 0);
  93
  94 my $top = new Text(1);
  95 my $toplist = $top->text;
  96 $toplist->set_editable(0);
  97 $paned->pack1($top, 1, 1);
  98
  99 # add the handler for incoming messages from the node
 100 my $tophandler = Gtk::Gdk->input_add($sock->fileno, ['read'], \&tophandler, $sock);
 101 my $rbuf = "";                                          # used in handler
 102
 103 # the bottom handler
 104 my $bot = new Text(1);
 105 my $botlist = $bot->text;
 106 $botlist->set_editable(1);
 107 $botlist->signal_connect('activate', \&bothandler);
 108 $botlist->can_focus(1);
 109 $botlist->can_default(1);
 110 $botlist->grab_focus;
 111 $botlist->grab_default;
 112 $toplist->{signalid} = $toplist->signal_connect(insert_text => \&doinsert);
 113 $paned->pack2($bot, 0, 1);
 114 $paned->show;
 115
 116 # the main loop
 117 $main->show_all;
 118 Gtk->main;
 119
 120 #
 121 # handlers
 122 #
 123
 124 sub doinsert {
 125         my ($self, $text) = @_;
 126
 127         # we temporarily block this handler to avoid recursion
 128         $self->signal_handler_block($self->{signalid});
 129         my $pos = $self->insert($self->{font}, undef, undef, $text);
 130         $self->signal_handler_unblock($self->{signalid});
 131
 132         # we already inserted the text if it was valid: no need
 133         # for the self to process this signal emission
 134         $self->signal_emit_stop_by_name('insert-text');
 135         $self->signal_emit('activate') if $text eq "\n";
 136         1;
 137 }
 138
 139 sub bothandler
 140 {
 141         my ($self, $data) = @_;
 142         my ($msg) = $self->get_chars =~ /([^\n]*)\r?\n$/;
 143         $msg ||= '';
 144         senddata($msg);
 145 }
 146
 147 sub tophandler
 148 {
 149         my ($socket, $fd, $flags) = @_;
 150         if ($flags->{read}) {
 151                 my $offset = length $rbuf;
 152                 my $l = sysread($socket, $rbuf, 1024, $offset);
 153                 if (defined $l) {
 154                         my $freeze;
 155                         if ($l) {
 156                                 while ($rbuf =~ s/^([^\015\012]*)\015?\012//) {
 157                                         my $msg = $1;
 158                                         $msg =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg;
 159                                         $msg =~ s/[\x00-\x08\x0a-\x19\x1b-\x1f\x80-\x9f]/./g;         # immutable CSI sequence + control characters
 160                                         $toplist->freeze unless $freeze++;
 161                                         handlemsg($msg);
 162                                 }
 163                                 if ($freeze) {
 164                                         $toplist->thaw;
 165                                         $toplist->vadj->set_value($toplist->vadj->upper);
 166                                         $toplist->vadj->value_changed;
 167                                 }
 168                         } else {
 169                                 Gtk->exit(0);
 170                         }
 171                 } else {
 172                         Gtk->exit(0);
 173                 }
 174         }
 175 }
 176
 177 sub handlemsg
 178 {
 179         my $msg = shift;
 180         my ($sort, $call, $line) = $msg =~ /^(\w)([^\|]+)\|(.*)$/;
 181         if ($sort eq 'D') {
 182                 $toplist->insert($toplist->{font}, undef, undef, "$line\n");
 183         } elsif ($sort eq 'X') {
 184                 $toplist->insert($toplist->{font}, undef, undef, "$line\n");
 185         } elsif ($sort eq 'Y') {
 186                 $toplist->insert($toplist->{font}, undef, undef, "$line\n");
 187         } elsif ($sort eq 'V') {
 188                 $toplist->insert($toplist->{font}, undef, undef, "$line\n");
 189         } elsif ($sort eq 'N') {
 190                 $toplist->insert($toplist->{font}, undef, undef, "$line\n");
 191         } elsif ($sort eq 'W') {
 192                 $toplist->insert($toplist->{font}, undef, undef, "$line\n");
 193         } elsif ($sort eq 'Z') {
 194                 Gtk->exit(0);
 195         }
 196 }
 197
 198 #
 199 # subroutine
 200 #
 201
 202 sub senddata
 203 {
 204         my $msg = shift;
 205         sendmsg('I', $msg);
 206 }
 207
 208 sub sendmsg
 209 {
 210         my ($let, $msg) = @_;
 211         $msg =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg;
 212         $sock->print("$let$call|$msg\n");
 213 }