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');
59 my $main = new Gtk::Window('toplevel');
60 $main->set_default_size(600, 600);
61 $main->set_policy(0, 1, 0);
62 $main->signal_connect('destroy', sub { Gtk->exit(0); });
63 $main->signal_connect('delete_event', sub { Gtk->exit(0); });
64 $main->set_title("gtkconsole - The DXSpider Console - $call");
67 my $vbox = new Gtk::VBox(0, 1);
68 $vbox->border_width(1);
74 {path => '/_File', type => '<Branch>'},
75 {path => '/_File/Quit', callback => sub {Gtk->exit(0)}},
76 {path => '/_Help', type => '<LastBranch>'},
77 {path => '/_Help/About'},
79 my $accel = new Gtk::AccelGroup();
80 my $itemf = new Gtk::ItemFactory('Gtk::MenuBar', '<main>', $accel);
81 $itemf->create_items(@menu);
82 $main->add_accel_group($accel);
83 my $menu = $itemf->get_widget('<main>');
84 $vbox->pack_start($menu, 0, 1, 0);
87 # create a vertically paned window and stick it in the bottom of the screen
88 my $paned = new Gtk::VPaned;
89 $vbox->pack_end($paned, 1, 1, 0);
91 my $top = new Text(1);
92 my $toplist = $top->text;
93 $toplist->set_editable(0);
94 $paned->pack1($top, 1, 1);
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
101 my $bot = new Text(1);
102 my $botlist = $bot->text;
103 $botlist->set_editable(1);
104 $botlist->signal_connect('activate', \&bothandler);
105 $botlist->can_focus(1);
106 $botlist->can_default(1);
107 $botlist->grab_focus;
108 $botlist->grab_default;
109 $toplist->{signalid} = $toplist->signal_connect(insert_text => \&doinsert);
110 $paned->pack2($bot, 0, 1);
122 my ($self, $text) = @_;
124 # we temporarily block this handler to avoid recursion
125 $self->signal_handler_block($self->{signalid});
126 my $pos = $self->insert($self->{font}, undef, undef, $text);
127 $self->signal_handler_unblock($self->{signalid});
129 # we already inserted the text if it was valid: no need
130 # for the self to process this signal emission
131 $self->signal_emit_stop_by_name('insert-text');
132 $self->signal_emit('activate') if $text eq "\n";
138 my ($self, $data) = @_;
139 my ($msg) = $self->get_chars =~ /([^\n]*)\r?\n$/;
146 my ($socket, $fd, $flags) = @_;
147 if ($flags->{read}) {
148 my $offset = length $rbuf;
149 my $l = sysread($socket, $rbuf, 1024, $offset);
153 while ($rbuf =~ s/^([^\015\012]*)\015?\012//) {
155 $msg =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg;
156 $msg =~ s/[\x00-\x08\x0a-\x19\x1b-\x1f\x80-\x9f]/./g; # immutable CSI sequence + control characters
157 $toplist->freeze unless $freeze++;
162 $toplist->vadj->set_value($toplist->vadj->upper);
163 $toplist->vadj->value_changed;
177 my ($sort, $call, $line) = $msg =~ /^(\w)([^\|]+)\|(.*)$/;
179 $toplist->insert($toplist->{font}, undef, undef, "$line\n");
180 } elsif ($sort eq 'Z') {
197 my ($let, $msg) = @_;
198 $msg =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg;
199 $sock->print("$let$call|$msg\n");