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/gtkconsole";
18 unshift @INC, "$root/local";
23 use vars qw(@modules);
25 @modules = (); # is the list of modules that need init calling
26 # on them. It is set up by each 'use'ed module
27 # that has Gtk stuff in it
39 my $call = uc shift @ARGV if @ARGV;
40 $call = uc $main::myalias unless $call;
41 my ($scall, $ssid) = split /-/, $call;
42 $ssid = undef unless $ssid && $ssid =~ /^\d+$/;
44 $ssid = 15 if $ssid > 15;
45 $call = "$scall-$ssid";
48 die "You cannot connect as your cluster callsign ($main::mycall)\n" if $call eq $main::mycall;
51 my $sock = IO::Socket::INET->new(PeerAddr=>$main::clusteraddr, PeerPort=>$main::clusterport);
52 die "Cannot connect to $main::clusteraddr/$main::clusterport ($!)\n" unless $sock;
53 sendmsg('A', 'local');
55 sendmsg('I', 'set/page 500');
56 sendmsg('I', 'set/nobeep');
64 my $main = new Gtk::Window('toplevel');
65 $main->set_default_size(600, 600);
66 $main->set_policy(0, 1, 0);
67 $main->signal_connect('destroy', sub { Gtk->exit(0); });
68 $main->signal_connect('delete_event', sub { Gtk->exit(0); });
69 $main->set_title("gtkconsole - The DXSpider Console - $call");
72 my $vbox = new Gtk::VBox(0, 1);
73 $vbox->border_width(1);
78 {path => '/_File', type => '<Branch>'},
79 {path => '/_File/Quit', callback => sub {Gtk->exit(0)}},
80 {path => '/_Help', type => '<LastBranch>'},
81 {path => '/_Help/About'},
83 my $accel = new Gtk::AccelGroup();
84 my $itemf = new Gtk::ItemFactory('Gtk::MenuBar', '<main>', $accel);
85 $itemf->create_items(@menu);
86 $main->add_accel_group($accel);
87 my $menu = $itemf->get_widget('<main>');
88 $vbox->pack_start($menu, 0, 1, 0);
92 my $top = new Text(1);
93 my $toplist = $top->text;
94 $toplist->set_editable(0);
96 # add the handler for incoming messages from the node
97 my $tophandler = Gtk::Gdk->input_add($sock->fileno, ['read'], \&tophandler, $sock);
98 my $rbuf = ""; # used in handler
100 $toplist->{signalid} = $toplist->signal_connect(insert_text => \&doinsert, $toplist);
101 #$bot->{signalid} = $bot->signal_connect(insert_text => \&botinsert, $bot);
102 $vbox->pack_start($top, 1, 1, 0);
106 my $bot = new Gtk::Entry;
107 $bot->set_editable(1);
108 $bot->signal_connect('activate', \&bothandler);
110 $bot->can_default(1);
116 my $hbox = new Gtk::HBox;
119 # callsign and current date and time
120 my $calllabel = new Gtk::Label($call);
121 my $date = new Gtk::Label(cldatetime(time));
122 Gtk->timeout_add(1000, \&updatetime);
126 $hbox->pack_start( $calllabel, 0, 1, 0 );
127 $hbox->pack_end($date, 0, 1, 0);
130 $vbox->pack_start($hbox, 0, 1, 0);
132 # nice little separator
133 my $separator = new Gtk::HSeparator();
134 $vbox->pack_start( $separator, 0, 1, 0 );
136 $vbox->pack_start($bot, 0, 1, 0);
148 $date->set_text(cldatetime(time));
153 my ($self, $text) = @_;
155 # we temporarily block this handler to avoid recursion
156 $self->signal_handler_block($self->{signalid});
157 my $pos = $self->insert($self->{font}, $toplist->style->black, $toplist->style->white, $text);
158 $self->signal_handler_unblock($self->{signalid});
160 # we already inserted the text if it was valid: no need
161 # for the self to process this signal emission
162 $self->signal_emit_stop_by_name('insert-text');
168 my ($self, $text) = @_;
170 printf "%s\n", $text;
177 my ($self, $data) = @_;
178 my $msg = $self->get_text;
186 my ($socket, $fd, $flags) = @_;
187 if ($flags->{read}) {
188 my $offset = length $rbuf;
189 my $l = sysread($socket, $rbuf, 1024, $offset);
193 while ($rbuf =~ s/^([^\015\012]*)\015?\012//) {
195 $msg =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg;
196 $msg =~ s/[\x00-\x08\x0a-\x19\x1b-\x1f\x80-\x9f]/./g; # immutable CSI sequence + control characters
197 $toplist->freeze unless $freeze++;
202 $toplist->vadj->set_value($toplist->vadj->upper);
203 $toplist->vadj->value_changed;
217 my ($sort, $call, $line) = $msg =~ /^(\w)([^\|]+)\|(.*)$/;
219 $toplist->insert($toplist->{font}, undef, undef, "$line\n");
220 } elsif ($sort eq 'X') {
221 $toplist->insert($toplist->{font}, undef, undef, "$line\n");
222 } elsif ($sort eq 'Y') {
223 $toplist->insert($toplist->{font}, undef, undef, "$line\n");
224 } elsif ($sort eq 'V') {
225 $toplist->insert($toplist->{font}, undef, undef, "$line\n");
226 } elsif ($sort eq 'N') {
227 $toplist->insert($toplist->{font}, undef, undef, "$line\n");
228 } elsif ($sort eq 'W') {
229 $toplist->insert($toplist->{font}, undef, undef, "$line\n");
230 } elsif ($sort eq 'Z') {
247 my ($let, $msg) = @_;
248 $msg =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg;
249 $sock->print("$let$call|$msg\n");