]> dxcluster.net Git - spider.git/blob - gtkconsole/gtkconsole
make all pings update the node averages
[spider.git] / 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/gtkconsole";
18         unshift @INC, "$root/local";
19 }
20
21 use strict;
22
23 use Gtk qw(-init);
24
25 use vars qw(@modules $font);                    
26
27 @modules = ();                                  # is the list of modules that need init calling
28                                                                 # on them. It is set up by each  'use'ed module
29                                                                 # that has Gtk stuff in it
30 $font = Gtk::Gdk::Font->load("-misc-fixed-medium-r-normal-*-*-130-*-*-c-*-koi8-r");
31
32 use DXVars;
33 use DXUtil;
34 use IO::Socket::INET;
35 use Text;
36 use DebugHandler;
37
38 #
39 # main initialisation
40 #
41 my $call = uc shift @ARGV if @ARGV;
42 $call = uc $main::myalias unless $call;
43 my ($scall, $ssid) = split /-/, $call;
44 $ssid = undef unless $ssid && $ssid =~ /^\d+$/;  
45 if ($ssid) {
46         $ssid = 15 if $ssid > 15;
47         $call = "$scall-$ssid";
48 }
49
50 die "You cannot connect as your cluster callsign ($main::mycall)\n" if $call eq $main::mycall;
51
52
53 my $sock = IO::Socket::INET->new(PeerAddr=>$main::clusteraddr, PeerPort=>$main::clusterport);
54 die "Cannot connect to $main::clusteraddr/$main::clusterport ($!)\n" unless $sock;
55 sendmsg('A', 'local');
56 sendmsg('G', '2');
57 sendmsg('I', 'set/page 500');
58 sendmsg('I', 'set/nobeep');
59
60 #
61 # start of GTK stuff
62 #
63
64
65 # main window
66 my $main = new Gtk::Window('toplevel');
67 $main->set_default_size(600, 600);
68 $main->set_policy(0, 1, 0);
69 $main->signal_connect('destroy', sub { Gtk->exit(0); });
70 $main->signal_connect('delete_event', sub { Gtk->exit(0); });
71 $main->set_title("gtkconsole - The DXSpider Console - $call");
72
73 # the main vbox
74 my $vbox = new Gtk::VBox(0, 1);
75 $vbox->border_width(1);
76 $main->add($vbox);
77
78 # the menu bar
79 my @menu = ( 
80                         {path => '/_File', type => '<Branch>'},
81                         {path => '/_File/Quit', callback => sub {Gtk->exit(0)}},
82                         {path => '/_Help', type => '<LastBranch>'},
83                         {path => '/_Help/About'},
84                    );
85 my $accel = new Gtk::AccelGroup();
86 my $itemf = new Gtk::ItemFactory('Gtk::MenuBar', '<main>', $accel);
87 $itemf->create_items(@menu);
88 $main->add_accel_group($accel);
89 my $menu = $itemf->get_widget('<main>');
90 $vbox->pack_start($menu, 0, 1, 0);
91 $menu->show;
92
93
94 my $top = new Text(1);
95 my $toplist = $top->text;
96 $toplist->set_editable(0);
97 $toplist->sensitive(0);
98
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
102
103 #$toplist->{signalid} = $toplist->signal_connect(insert_text => \&doinsert, $toplist); 
104 #$bot->{signalid} = $bot->signal_connect(insert_text => \&botinsert, $bot); 
105 $vbox->pack_start($top, 1, 1, 0);
106 $vbox->show;
107
108 # the bottom handler
109 my $bot = new Gtk::Entry;
110 my $style = $toplist->style;
111 $style->font($main::font);
112 $bot->set_style($style);
113 $bot->set_editable(1);
114 $bot->signal_connect('activate', \&bothandler);
115 $bot->can_default(1);
116 $bot->grab_default;
117 $bot->show;
118
119 # a horizontal box
120 my $hbox = new Gtk::HBox;
121 $hbox->show;
122
123 # callsign and current date and time
124 my $calllabel = new Gtk::Label($call);
125 my $date = new Gtk::Label(cldatetime(time));
126 Gtk->timeout_add(1000, \&updatetime);
127 $calllabel->show;
128 $date->show;
129  
130 $hbox->pack_start( $calllabel, 0, 1, 0 );
131 $hbox->pack_end($date, 0, 1, 0);
132
133
134 $vbox->pack_start($hbox, 0, 1, 0); 
135
136 # nice little separator
137 my $separator = new Gtk::HSeparator();
138 $vbox->pack_start( $separator, 0, 1, 0 );
139 $separator->show();
140 $vbox->pack_start($bot, 0, 1, 0);
141
142 # the main loop
143 $main->show_all;
144 $bot->grab_focus;
145 Gtk->main;
146
147 #
148 # handlers
149 #
150
151 sub updatetime
152 {
153         $date->set_text(cldatetime(time));
154         1;
155 }
156
157 sub doinsert {
158         my ($self, $text) = @_;
159
160         # we temporarily block this handler to avoid recursion
161         $self->signal_handler_block($self->{signalid});
162         my $pos = $self->insert($self->{font}, $toplist->style->black, $toplist->style->white, $text);
163         $self->signal_handler_unblock($self->{signalid});
164
165         # we already inserted the text if it was valid: no need
166         # for the self to process this signal emission
167         $self->signal_emit_stop_by_name('insert-text');
168         1;
169 }
170
171 sub bothandler
172 {
173         my ($self, $data) = @_;
174         my $msg = $self->get_text;
175         $msg =~ s/\r?\n$//;
176         $self->set_text('');
177         $self->grab_focus;
178         senddata($msg);
179 }
180
181 sub tophandler
182 {
183         my ($socket, $fd, $flags) = @_;
184         if ($flags->{read}) {
185                 my $offset = length $rbuf;
186                 my $l = sysread($socket, $rbuf, 1024, $offset);
187                 if (defined $l) {
188                         my $freeze;
189                         if ($l) {
190                                 while ($rbuf =~ s/^([^\015\012]*)\015?\012//) {
191                                         my $msg = $1;
192                                         $msg =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg;
193                                         $msg =~ s/[\x00-\x08\x0a-\x19\x1b-\x1f\x80-\x9f]/./g;         # immutable CSI sequence + control characters
194                                         $toplist->freeze unless $freeze++;
195                                         handlemsg($msg);
196                                 }
197                                 if ($freeze) {
198                                         $toplist->thaw;
199                                         $toplist->vadj->set_value($toplist->vadj->upper);
200                                         $toplist->vadj->value_changed;
201                                 }
202                         } else {
203                                 Gtk->exit(0);
204                         }
205                 } else {
206                         Gtk->exit(0);
207                 }
208         }
209 }
210
211 sub handlemsg
212 {
213         my $msg = shift;
214         my ($sort, $call, $line) = $msg =~ /^(\w)([^\|]+)\|(.*)$/;
215         if ($sort eq 'D') {
216                 $toplist->insert($toplist->{font}, undef, undef, "$line\n");    
217         } elsif ($sort eq 'X') {
218                 $toplist->insert($toplist->{font}, undef, undef, "$line\n");
219         } elsif ($sort eq 'T') {
220                 $toplist->insert($toplist->{font}, undef, undef, "$line\n");
221         } elsif ($sort eq 'Y') {
222                 $toplist->insert($toplist->{font}, undef, undef, "$line\n");
223         } elsif ($sort eq 'V') {
224                 $toplist->insert($toplist->{font}, undef, undef, "$line\n");
225         } elsif ($sort eq 'N') {
226                 $toplist->insert($toplist->{font}, undef, undef, "$line\n");
227         } elsif ($sort eq 'W') {
228                 $toplist->insert($toplist->{font}, undef, undef, "$line\n");
229         } elsif ($sort eq 'Z') {
230                 Gtk->exit(0);
231         }
232 }
233
234 #
235 # subroutine
236 #
237
238 sub senddata
239 {
240         my $msg = shift;
241         sendmsg('I', $msg);
242 }
243
244 sub sendmsg
245 {
246         my ($let, $msg) = @_;
247         $msg =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg; 
248         $sock->print("$let$call|$msg\n");
249 }