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);
76 {path => '/_File', type => '<Branch>'},
77 {path => '/_File/Quit', callback => sub {Gtk->exit(0)}},
78 {path => '/_Help', type => '<LastBranch>'},
79 {path => '/_Help/About'},
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);
90 my $top = new Text(1);
91 my $toplist = $top->text;
92 $toplist->set_editable(0);
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
99 my $bot = new Gtk::Entry;
100 $bot->set_editable(1);
101 $bot->signal_connect('activate', \&bothandler);
103 $bot->can_default(1);
106 $toplist->{signalid} = $toplist->signal_connect(insert_text => \&doinsert, $toplist);
107 #$bot->{signalid} = $bot->signal_connect(insert_text => \&doinsert, $bot);
108 $vbox->pack_end($bot, 0, 1, 0);
109 $vbox->pack_end($top, 1, 1, 0);
121 my ($self, $text) = @_;
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});
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');
136 my ($self, $text) = @_;
138 printf "%s\n", $text;
145 my ($self, $data) = @_;
146 my $msg = $self->get_text;
154 my ($socket, $fd, $flags) = @_;
155 if ($flags->{read}) {
156 my $offset = length $rbuf;
157 my $l = sysread($socket, $rbuf, 1024, $offset);
161 while ($rbuf =~ s/^([^\015\012]*)\015?\012//) {
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++;
170 $toplist->vadj->set_value($toplist->vadj->upper);
171 $toplist->vadj->value_changed;
185 my ($sort, $call, $line) = $msg =~ /^(\w)([^\|]+)\|(.*)$/;
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') {
215 my ($let, $msg) = @_;
216 $msg =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg;
217 $sock->print("$let$call|$msg\n");