3 # A GTK based console program
5 # Copyright (c) 2001-6 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";
28 use vars qw(@modules $font);
30 @modules = (); # is the list of modules that need init calling
31 # on them. It is set up by each 'use'ed module
32 # that has Gtk stuff in it
40 my $call = uc shift @ARGV if @ARGV;
41 $call = uc $main::myalias unless $call;
42 my ($scall, $ssid) = split /-/, $call;
43 $ssid = undef unless $ssid && $ssid =~ /^\d+$/;
45 $ssid = 15 if $ssid > 15;
46 $call = "$scall-$ssid";
49 die "You cannot connect as your cluster callsign ($main::mycall)\n" if $call eq $main::mycall;
51 my $host = 'gb7djk.dxcluster.net';
54 my $sock = IO::Socket::INET->new(PeerAddr=>$host, PeerPort=>$port);
55 die "Cannot connect to $host/$port ($!)\n" unless $sock;
57 sendmsg('I', 'set/gtk');
58 #sendmsg('A', 'local');
60 sendmsg('I', 'set/page 500');
61 sendmsg('I', 'set/nobeep');
69 # +--------+-------+------------------------------------------------------------------------------------+
71 # +--------+-------+------------------------------------------------------------------------------------+
74 my $main = new Gtk2::Window('toplevel');
75 my $scr = $main->get_screen;
76 my $scr_width = $scr->get_width;
77 my $scr_height = $scr->get_height;
78 $main->set_default_size($scr_width, $scr_height/2);
79 $main->signal_connect('delete_event', sub { Gtk2->main_quit; });
80 $main->set_title("gtkconsole - The DXSpider Console - $call");
83 my $vbox = new Gtk2::VBox(0, 1);
89 {path => '/_File', type => '<Branch>'},
90 {path => '/_File/Quit', callback => sub {Gtk2->main_quit}},
91 {path => '/_Help', type => '<LastBranch>'},
92 {path => '/_Help/About'},
94 my $itemf = new Gtk2::ItemFactory('Gtk2::MenuBar', '<main>');
95 $itemf->create_items(@menu);
96 my $menu = $itemf->get_widget('<main>');
97 $vbox->pack_start($menu, 0, 1, 0);
100 # another hbox is packed as the bottom of the vbox
101 my $bhbox = Gtk2::HBox->new(0, 1);
102 $vbox->pack_end($bhbox, 1, 1, 0);
104 # now pack two vboxes into the hbox
105 my $lhvbox = Gtk2::VBox->new(0, 1);
106 my $rhvbox = Gtk2::VBox->new(0, 1);
107 $bhbox->pack_start($lhvbox, 1, 1, 5);
108 $bhbox->pack_start(Gtk2::VSeparator->new, 0, 1, 0);
109 $bhbox->pack_end($rhvbox, 1, 1, 5);
111 # first add a column type for the QRG
112 my $font = 'monospace 9';
113 my $oddbg = 'light blue';
114 my $evenbg = 'white';
116 Gtk2::SimpleList->add_column_type( 'qrg',
117 type => 'Glib::Scalar',
118 renderer => 'Gtk2::CellRendererText',
120 my ($treecol, $cell, $model, $iter, $col_num) = @_;
121 my $info = $model->get ($iter, $col_num);
122 $cell->set(text => sprintf("%.1f", $info), font => $font, xalign => 1.0);
127 Gtk2::SimpleList->add_column_type( 'tt',
128 type => 'Glib::Scalar',
129 renderer => 'Gtk2::CellRendererText',
131 my ($treecol, $cell, $model, $iter, $col_num) = @_;
132 my $info = $model->get ($iter, $col_num);
133 $cell->set(text => $info, font => $font);
143 my $dxlist = Gtk2::SimpleList->new(
153 $dxlist->set_rules_hint(1);
154 my $dxscroll = Gtk2::ScrolledWindow->new (undef, undef);
155 $dxscroll->set_shadow_type ('etched-out');
156 $dxscroll->set_policy ('never', 'automatic');
157 #$dxscroll->set_size_request (700, 400);
158 $dxscroll->add($dxlist);
159 $dxscroll->set_border_width(5);
160 $lhvbox->pack_start($dxscroll, 1, 1, 0);
163 my $cmdlist = Gtk2::SimpleList->new(
167 my $cmdscroll = Gtk2::ScrolledWindow->new (undef, undef);
168 $cmdscroll->set_shadow_type ('etched-out');
169 $cmdscroll->set_policy ('never', 'automatic');
170 #$cmdscroll->set_size_request (700, 400);
171 $cmdscroll->add($cmdlist);
172 $cmdscroll->set_border_width(5);
173 $lhvbox->pack_start($cmdscroll, 1, 1, 0);
176 # nice little separator
177 $lhvbox->pack_start(Gtk2::HSeparator->new, 0, 1, 0 );
179 # callsign and current date and time
180 my $hbox = new Gtk2::HBox;
181 my $calllabel = new Gtk2::Label($call);
182 my $date = new Gtk2::Label(cldatetime(time));
183 $date->{tick} = Glib::Timeout->add(1000, \&updatetime, 0);
184 $hbox->pack_start( $calllabel, 0, 1, 0 );
185 $hbox->pack_end($date, 0, 1, 0);
186 $lhvbox->pack_start($hbox, 0, 1, 0);
187 $lhvbox->pack_start(Gtk2::HSeparator->new, 0, 1, 0);
190 my $bot = new Gtk2::Entry;
191 $bot->set_editable(1);
192 $bot->signal_connect('activate', \&bothandler);
193 $bot->can_default(1);
194 $lhvbox->pack_end($bot, 0, 1, 0);
202 my $annlist = Gtk2::SimpleList->new(
206 Announcement => 'tt',
208 $annlist->set_rules_hint(1);
209 my $annscroll = Gtk2::ScrolledWindow->new (undef, undef);
210 $annscroll->set_shadow_type ('etched-out');
211 $annscroll->set_policy ('automatic', 'automatic');
212 #$annscroll->set_size_request (700, 400);
213 $annscroll->add($annlist);
214 $annscroll->set_border_width(5);
215 $rhvbox->pack_start($annscroll, 1, 1, 0);
218 my $wwvlist = Gtk2::SimpleList->new(
227 $wwvlist->set_rules_hint(1);
228 my $wwvscroll = Gtk2::ScrolledWindow->new (undef, undef);
229 $wwvscroll->set_shadow_type ('etched-out');
230 $wwvscroll->set_policy ('never', 'automatic');
231 #$wwvscroll->set_size_request (700, 200);
232 $wwvscroll->add($wwvlist);
233 $wwvscroll->set_border_width(5);
234 $rhvbox->pack_start($wwvscroll, 0, 1, 0);
237 my $wcylist = Gtk2::SimpleList->new(
250 $wcylist->set_rules_hint(1);
251 my $wcyscroll = Gtk2::ScrolledWindow->new (undef, undef);
252 $wcyscroll->set_shadow_type ('etched-out');
253 $wcyscroll->set_policy ('never', 'automatic');
254 #$wcyscroll->set_size_request (700, 200);
255 $wcyscroll->add($wcylist);
256 $wcyscroll->set_border_width(5);
257 $rhvbox->pack_start($wcyscroll, 0, 1, 0);
259 my $sock_helper = Gtk2::Helper->add_watch($sock->fileno, 'in', \&tophandler, $sock);
273 $date->set_text(cldatetime(time));
279 my ($self, $data) = @_;
280 my $msg = $self->get_text;
291 my ($fd, $condx, $socket) = @_;
293 my $offset = length $rbuf;
294 my $l = sysread($socket, $rbuf, 1024, $offset);
297 while ($rbuf =~ s/^([^\015\012]*)\015?\012//) {
315 # this is truely evil and I bet there is a better way...
318 if ($line =~ /^'\w{2,4}',/) {
319 $list = eval qq([$line]);
321 $list = ['cmd', $line];
325 my $cmd = shift @$list;
326 my $handle = "handle_$cmd";
327 if (__PACKAGE__->can($handle)) {
328 __PACKAGE__->$handle($list);
330 unshift @$list, $cmd;
331 __PACKAGE__->handle_def($list);
340 my ($t, $ts) = (time, '');
342 $s = ref $ref ? join ', ',@$ref : $ref;
344 if (($cmdscroll->{lasttime}||0) != $t) {
346 $cmdscroll->{lasttime} = $t;
350 push @{$cmdlist->{data}}, [$ts, $s];
358 $s = ref $ref ? join ', ',@$ref : $ref;
359 my ($t, $ts) = (time, '');
361 if (($cmdscroll->{lasttime}||0) != $t) {
363 $cmdscroll->{lasttime} = $t;
367 push @{$cmdlist->{data}}, [$ts, $s];
374 my ($t, $ts) = (time, '');
376 if (($dxscroll->{lasttime}||0) != $t) {
378 $dxscroll->{lasttime} = $t;
380 push @{$dxlist->{data}}, [$ts, @$ref[0,1,15,3,4,16], stim($ref->[2]) ];
388 my ($t, $ts) = (time, '');
390 $s = ref $ref ? join ', ',@$ref : $ref;
392 if (($annscroll->{lasttime}||0) != $t) {
394 $annscroll->{lasttime} = $t;
398 push @{$annlist->{data}}, [$ts, @$ref[3,1,2]];
406 $s = ref $ref ? join ', ',@$ref : $ref;
409 push @{$wcylist->{data}}, [tim(), @$ref[10,4,5,3,6,2,7,8,9,1] ];
417 $s = ref $ref ? join ', ',@$ref : $ref;
420 push @{$wwvlist->{data}}, [tim(), @$ref[6,2,3,4,5,1] ];
435 my ($let, $msg) = @_;
436 # $msg =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg;
437 # $sock->print("$let$call|$msg\n");
438 $sock->print("$msg\n");
443 my $t = shift || time;
444 return sprintf "%02d:%02d:%02d", (gmtime($t))[2,1,0];
449 my $t = shift || time;
450 return sprintf "%02d:%02d", (gmtime($t))[2,1];