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
  74 # the menu bar
  75 my @menu = (
  76                         {path => '/_File', type => '<Branch>'},
  77                         {path => '/_File/Quit', callback => sub {Gtk->exit(0)}},
  78                         {path => '/_Help', type => '<LastBranch>'},
  79                         {path => '/_Help/About'},
  80                    );
  81 my $accel = new Gtk::AccelGroup();
  82 my $itemf = new Gtk::ItemFactory('Gtk::MenuBar', '<main>', $accel);
  83 $itemf->create_items(@menu);
  84 $main->add_accel_group($accel);
  85 my $menu = $itemf->get_widget('<main>');
  86 $vbox->pack_start($menu, 0, 1, 0);
  87 $menu->show;
  88
  89
  90 my $top = new Text(1);
  91 my $toplist = $top->text;
  92 $toplist->set_editable(0);
  93
  94 # add the handler for incoming messages from the node
  95 my $tophandler = Gtk::Gdk->input_add($sock->fileno, ['read'], \&tophandler, $sock);
  96 my $rbuf = "";                                          # used in handler
  97
  98 # the bottom handler
  99 my $bot = new Gtk::Entry;
 100 $bot->set_editable(1);
 101 $bot->signal_connect('activate', \&bothandler);
 102 $bot->can_focus(1);
 103 $bot->can_default(1);
 104 $bot->grab_focus;
 105 $bot->grab_default;
 106 $toplist->{signalid} = $toplist->signal_connect(insert_text => \&doinsert, $toplist);
 107 #$bot->{signalid} = $bot->signal_connect(insert_text => \&botinsert, $bot);
 108 $vbox->pack_end($bot, 0, 1, 0);
 109 $vbox->pack_end($top, 1, 1, 0);
 110 $vbox->show;
 111
 112 # the main loop
 113 $main->show_all;
 114 Gtk->main;
 115
 116 #
 117 # handlers
 118 #
 119
 120 sub doinsert {
 121         my ($self, $text) = @_;
 122
 123         # we temporarily block this handler to avoid recursion
 124         $self->signal_handler_block($self->{signalid});
 125         my $pos = $self->insert($self->{font}, $toplist->style->black, $toplist->style->white, $text);
 126         $self->signal_handler_unblock($self->{signalid});
 127
 128         # we already inserted the text if it was valid: no need
 129         # for the self to process this signal emission
 130         $self->signal_emit_stop_by_name('insert-text');
 131         1;
 132 }
 133
 134 sub botinsert
 135 {
 136         my ($self, $text) = @_;
 137
 138         printf "%s\n", $text;
 139
 140         1;
 141 }
 142
 143 sub bothandler
 144 {
 145         my ($self, $data) = @_;
 146         my $msg = $self->get_text;
 147         $msg =~ s/\r?\n$//;
 148         $self->set_text('');
 149         senddata($msg);
 150 }
 151
 152 sub tophandler
 153 {
 154         my ($socket, $fd, $flags) = @_;
 155         if ($flags->{read}) {
 156                 my $offset = length $rbuf;
 157                 my $l = sysread($socket, $rbuf, 1024, $offset);
 158                 if (defined $l) {
 159                         my $freeze;
 160                         if ($l) {
 161                                 while ($rbuf =~ s/^([^\015\012]*)\015?\012//) {
 162                                         my $msg = $1;
 163                                         $msg =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg;
 164                                         $msg =~ s/[\x00-\x08\x0a-\x19\x1b-\x1f\x80-\x9f]/./g;         # immutable CSI sequence + control characters
 165                                         $toplist->freeze unless $freeze++;
 166                                         handlemsg($msg);
 167                                 }
 168                                 if ($freeze) {
 169                                         $toplist->thaw;
 170                                         $toplist->vadj->set_value($toplist->vadj->upper);
 171                                         $toplist->vadj->value_changed;
 172                                 }
 173                         } else {
 174                                 Gtk->exit(0);
 175                         }
 176                 } else {
 177                         Gtk->exit(0);
 178                 }
 179         }
 180 }
 181
 182 sub handlemsg
 183 {
 184         my $msg = shift;
 185         my ($sort, $call, $line) = $msg =~ /^(\w)([^\|]+)\|(.*)$/;
 186         if ($sort eq 'D') {
 187                 $toplist->insert($toplist->{font}, undef, undef, "$line\n");
 188         } elsif ($sort eq 'X') {
 189                 $toplist->insert($toplist->{font}, undef, undef, "$line\n");
 190         } elsif ($sort eq 'Y') {
 191                 $toplist->insert($toplist->{font}, undef, undef, "$line\n");
 192         } elsif ($sort eq 'V') {
 193                 $toplist->insert($toplist->{font}, undef, undef, "$line\n");
 194         } elsif ($sort eq 'N') {
 195                 $toplist->insert($toplist->{font}, undef, undef, "$line\n");
 196         } elsif ($sort eq 'W') {
 197                 $toplist->insert($toplist->{font}, undef, undef, "$line\n");
 198         } elsif ($sort eq 'Z') {
 199                 Gtk->exit(0);
 200         }
 201 }
 202
 203 #
 204 # subroutine
 205 #
 206
 207 sub senddata
 208 {
 209         my $msg = shift;
 210         sendmsg('I', $msg);
 211 }
 212
 213 sub sendmsg
 214 {
 215         my ($let, $msg) = @_;
 216         $msg =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg;
 217         $sock->print("$let$call|$msg\n");
 218 }