3 # A GTK based console program
5 # Copyright (c) 2001 Dirk Koopman G1TLH
10 # search local then perl directories
12 # root of directory tree for this system
14 $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
16 unshift @INC, "$root/perl"; # this IS the right way round!
17 unshift @INC, "$root/local";
22 use vars qw(@modules);
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
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+$/;
42 $ssid = 15 if $ssid > 15;
43 $call = "$scall-$ssid";
46 die "You cannot connect as your cluster callsign ($main::mycall)\n" if $call eq $main::mycall;
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');
53 sendmsg('I', 'set/page 500');
54 sendmsg('I', 'set/nobeep');
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");
70 my $vbox = new Gtk::VBox(0, 1);
71 $vbox->border_width(1);
77 {path => '/_File', type => '<Branch>'},
78 {path => '/_File/Quit', callback => sub {Gtk->exit(0)}},
79 {path => '/_Help', type => '<LastBranch>'},
80 {path => '/_Help/About'},
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);
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);
94 my $top = new Text(1);
95 my $toplist = $top->text;
96 $toplist->set_editable(0);
97 $paned->pack1($top, 1, 1);
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
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);
125 my ($self, $text) = @_;
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});
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";
141 my ($self, $data) = @_;
142 my ($msg) = $self->get_chars =~ /([^\n]*)\r?\n$/;
149 my ($socket, $fd, $flags) = @_;
150 if ($flags->{read}) {
151 my $offset = length $rbuf;
152 my $l = sysread($socket, $rbuf, 1024, $offset);
156 while ($rbuf =~ s/^([^\015\012]*)\015?\012//) {
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++;
165 $toplist->vadj->set_value($toplist->vadj->upper);
166 $toplist->vadj->value_changed;
180 my ($sort, $call, $line) = $msg =~ /^(\w)([^\|]+)\|(.*)$/;
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') {
210 my ($let, $msg) = @_;
211 $msg =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg;
212 $sock->print("$let$call|$msg\n");