3 # A GTK based console program
5 # Copyright (c) 2001-6 Dirk Koopman G1TLH
14 # search local then perl directories
16 # root of directory tree for this system
18 $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
20 unshift @INC, "$root/perl"; # this IS the right way round!
21 unshift @INC, "$root/gtkconsole";
22 unshift @INC, "$root/local";
32 use vars qw(@modules $font);
34 @modules = (); # is the list of modules that need init calling
35 # on them. It is set up by each 'use'ed module
36 # that has Gtk stuff in it
42 # read in gtkconsole file
44 Gtk2::Rc->set_default_files("$root/gtkconsole/gtkconsolerc", "$ENV{HOME}/.gtkconsolerc", ".gtkconsolerc");
45 print join(', ', Gtk2::Rc->get_default_files), "\n";
46 Gtk2::Rc->reparse_all;
51 my $call = uc shift @ARGV if @ARGV;
52 $call = uc $main::myalias unless $call;
53 my ($scall, $ssid) = split /-/, $call;
54 $ssid = undef unless $ssid && $ssid =~ /^\d+$/;
56 $ssid = 15 if $ssid > 15;
57 $call = "$scall-$ssid";
60 die "You cannot connect as your cluster callsign ($main::mycall)\n" if $call eq $main::mycall;
62 my $host = 'gb7djk.dxcluster.net';
65 my $sock = IO::Socket::INET->new(PeerAddr=>$host, PeerPort=>$port);
66 die "Cannot connect to $host/$port ($!)\n" unless $sock;
68 sendmsg('I', 'set/gtk');
69 #sendmsg('A', 'local');
71 sendmsg('I', 'set/page 500');
72 sendmsg('I', 'set/nobeep');
80 # +--------+-------+------------------------------------------------------------------------------------+
82 # +--------+-------+------------------------------------------------------------------------------------+
85 my $main = new Gtk2::Window('toplevel');
86 my $scr = $main->get_screen;
87 my $scr_width = $scr->get_width;
88 my $scr_height = $scr->get_height;
89 $main->set_default_size($scr_width, $scr_height/2);
90 $main->signal_connect('delete_event', sub { Gtk2->main_quit; });
91 $main->set_title("gtkconsole - The DXSpider Console - $call");
94 my $vbox = new Gtk2::VBox(0, 1);
100 {path => '/_File', type => '<Branch>'},
101 {path => '/_File/Quit', callback => sub {Gtk2->main_quit}},
102 {path => '/_Help', type => '<LastBranch>'},
103 {path => '/_Help/About'},
105 my $itemf = new Gtk2::ItemFactory('Gtk2::MenuBar', '<main>');
106 $itemf->create_items(@menu);
107 my $menu = $itemf->get_widget('<main>');
108 $vbox->pack_start($menu, 0, 1, 0);
111 # a paned hbox is packed as the bottom of the vbox
112 my $bhpane = Gtk2::HPaned->new;
113 $vbox->pack_end($bhpane, 1, 1, 0);
115 # now create the lh and rh panes
116 my $lhvpane = Gtk2::VPaned->new;
117 my $rhvpane = Gtk2::VPaned->new;
118 $bhpane->pack1($lhvpane, 1, 0);
119 $bhpane->pack2($rhvpane, 1, 0);
121 # first add a column type for the QRG
122 my $font = 'monospace 9';
123 my $oddbg = 'light blue';
124 my $evenbg = 'white';
126 Gtk2::SimpleList->add_column_type( 'qrg',
127 type => 'Glib::Scalar',
128 renderer => 'Gtk2::CellRendererText',
130 my ($treecol, $cell, $model, $iter, $col_num) = @_;
131 my $info = $model->get ($iter, $col_num);
132 $cell->set(text => sprintf("%.1f", $info), font => $font, xalign => 1.0);
137 Gtk2::SimpleList->add_column_type( 'tt',
138 type => 'Glib::Scalar',
139 renderer => 'Gtk2::CellRendererText',
141 my ($treecol, $cell, $model, $iter, $col_num) = @_;
142 my $info = $model->get ($iter, $col_num);
143 $cell->set(text => $info, font => $font);
147 Gtk2::SimpleList->add_column_type( 'ttlong',
148 type => 'Glib::Scalar',
149 renderer => 'Gtk2::CellRendererText',
151 my ($treecol, $cell, $model, $iter, $col_num) = @_;
152 my $info = $model->get ($iter, $col_num);
153 $Text::Wrap::columns = 80;
154 $cell->set(text => join("\n",wrap("","",$info)), font => $font);
158 Gtk2::SimpleList->add_column_type( 'ttlesslong',
159 type => 'Glib::Scalar',
160 renderer => 'Gtk2::CellRendererText',
162 my ($treecol, $cell, $model, $iter, $col_num) = @_;
163 my $info = $model->get ($iter, $col_num);
164 $Text::Wrap::columns = 65;
165 $cell->set(text => join("\n",wrap("","",$info)), font => $font);
169 Gtk2::SimpleList->add_column_type( 'ttshort',
170 type => 'Glib::Scalar',
171 renderer => 'Gtk2::CellRendererText',
173 my ($treecol, $cell, $model, $iter, $col_num) = @_;
174 my $info = $model->get ($iter, $col_num);
175 $Text::Wrap::columns = 30;
176 $cell->set(text => join("\n",wrap("","",$info)), font => $font);
186 my $dxlist = Gtk2::SimpleList->new(
191 'Remarks' => 'ttshort',
196 $dxlist->set_rules_hint(1);
197 $dxlist->get_model->signal_connect('row-changed', \&row_inserted, $dxlist);
198 my $dxscroll = Gtk2::ScrolledWindow->new (undef, undef);
199 $dxscroll->set_shadow_type ('etched-out');
200 $dxscroll->set_policy ('never', 'automatic');
201 #$dxscroll->set_size_request (700, 400);
202 $dxscroll->add($dxlist);
203 $dxscroll->set_border_width(5);
205 $lhvpane->pack1($dxscroll, 1, 0);
208 my $lhvbox = Gtk2::VBox->new(0, 1);
209 my $cmdlist = Gtk2::SimpleList->new(
211 Information => 'ttlong',
213 my $cmdscroll = Gtk2::ScrolledWindow->new (undef, undef);
214 $cmdscroll->set_shadow_type ('etched-out');
215 $cmdscroll->set_policy ('automatic', 'automatic');
216 #$cmdscroll->set_size_request (700, 400);
217 $cmdscroll->add($cmdlist);
218 $cmdscroll->set_border_width(5);
219 $cmdlist->get_model->signal_connect('row-changed', \&row_inserted, $cmdlist);
221 $lhvbox->pack_start($cmdscroll, 1, 1, 0);
224 # callsign and current date and time
225 my $hbox = new Gtk2::HBox;
226 my $calllabel = new Gtk2::Label($call);
227 my $date = new Gtk2::Label(cldatetime(time));
228 $date->{tick} = Glib::Timeout->add(1000, \&updatetime, 0);
229 $hbox->pack_start( $calllabel, 0, 1, 0 );
230 $hbox->pack_end($date, 0, 1, 0);
231 $lhvbox->pack_start($hbox, 0, 1, 0);
232 $lhvbox->pack_start(Gtk2::HSeparator->new, 0, 1, 0);
235 my $bot = new Gtk2::Entry;
236 $bot->set_editable(1);
237 $bot->signal_connect('activate', \&bothandler);
238 $bot->can_default(1);
239 $lhvbox->pack_end($bot, 0, 1, 0);
240 $lhvpane->pack2($lhvbox, 1, 0);
248 my $annlist = Gtk2::SimpleList->new(
252 Announcement => 'ttlesslong',
254 $annlist->set_rules_hint(1);
255 $annlist->get_model->signal_connect('row-changed', \&row_inserted, $annlist);
256 my $annscroll = Gtk2::ScrolledWindow->new (undef, undef);
257 $annscroll->set_shadow_type ('etched-out');
258 $annscroll->set_policy ('automatic', 'automatic');
259 #$annscroll->set_size_request (700, 400);
260 $annscroll->add($annlist);
261 $annscroll->set_border_width(5);
262 $rhvpane->pack1($annscroll, 1, 0);
265 my $rhvbox = Gtk2::VBox->new(0, 1);
267 my $wwvlist = Gtk2::SimpleList->new(
273 Remarks => 'ttshort',
276 $wwvlist->set_rules_hint(1);
277 $wwvlist->get_model->signal_connect('row-changed', \&row_inserted, $wwvlist);
278 my $wwvscroll = Gtk2::ScrolledWindow->new (undef, undef);
279 $wwvscroll->set_shadow_type ('etched-out');
280 $wwvscroll->set_policy ('never', 'automatic');
281 #$wwvscroll->set_size_request (700, 200);
282 $wwvscroll->add($wwvlist);
283 $wwvscroll->set_border_width(5);
284 $rhvbox->pack_start($wwvscroll, 1, 1, 0);
287 my $wcylist = Gtk2::SimpleList->new(
300 $wcylist->set_rules_hint(1);
301 $wcylist->get_model->signal_connect('row-changed', \&row_inserted, $wcylist);
302 my $wcyscroll = Gtk2::ScrolledWindow->new (undef, undef);
303 $wcyscroll->set_shadow_type ('etched-out');
304 $wcyscroll->set_policy ('never', 'automatic');
305 $wcyscroll->add($wcylist);
306 $wcyscroll->set_border_width(5);
307 $rhvbox->pack_start($wcyscroll, 1, 1, 0);
308 $rhvbox->set_size_request (-1, $scr_height / 4);
311 $rhvpane->pack2($rhvbox, 1, 0);
313 my $sock_helper = Gtk2::Helper->add_watch($sock->fileno, 'in', \&tophandler, $sock);
327 $date->set_text(cldatetime(time));
333 my ($self, $data) = @_;
334 my $msg = $self->get_text;
345 my ($fd, $condx, $socket) = @_;
347 my $offset = length $rbuf;
348 my $l = sysread($socket, $rbuf, 1024, $offset);
351 while ($rbuf =~ s/^([^\015\012]*)\015?\012//) {
369 # this is truely evil and I bet there is a better way...
372 if ($line =~ /^'\w{2,4}',/) {
373 $list = eval qq([$line]);
375 $list = ['cmd', $line];
379 my $cmd = shift @$list;
380 my $handle = "handle_$cmd";
381 if (__PACKAGE__->can($handle)) {
382 __PACKAGE__->$handle($list);
384 unshift @$list, $cmd;
385 __PACKAGE__->handle_def($list);
394 my ($t, $ts) = (time, '');
396 $s = ref $ref ? join ', ',@$ref : $ref;
398 if (($cmdscroll->{lasttime}||0) != $t) {
400 $cmdscroll->{lasttime} = $t;
404 push @{$cmdlist->{data}}, [$ts, $s];
412 $s = ref $ref ? join ', ',@$ref : $ref;
413 my ($t, $ts) = (time, '');
415 if (($cmdscroll->{lasttime}||0) != $t) {
417 $cmdscroll->{lasttime} = $t;
421 push @{$cmdlist->{data}}, [$ts, $s];
428 my ($t, $ts) = (time, '');
430 if (($dxscroll->{lasttime}||0) != $t) {
432 $dxscroll->{lasttime} = $t;
434 push @{$dxlist->{data}}, [$ts, @$ref[0,1,15,3,4,16], stim($ref->[2]) ];
442 my ($t, $ts) = (time, '');
444 $s = ref $ref ? join ', ',@$ref : $ref;
446 if (($annscroll->{lasttime}||0) != $t) {
448 $annscroll->{lasttime} = $t;
452 push @{$annlist->{data}}, [$ts, @$ref[3,1,2]];
460 $s = ref $ref ? join ', ',@$ref : $ref;
463 push @{$wcylist->{data}}, [tim(), @$ref[10,4,5,3,6,2,7,8,9,1] ];
471 $s = ref $ref ? join ', ',@$ref : $ref;
474 push @{$wwvlist->{data}}, [tim(), @$ref[6,2,3,4,5,1] ];
480 my ($list, $path, $iter, $tree) = @_;
481 # print $list->get_string_from_iter, "\n";
482 $tree->scroll_to_cell($path, undef, 0, 0, 0);
487 my ($tree, $path, $col) = @_;
488 print "row activated\n";
489 $tree->scroll_to_cell($path, undef, 0, 0, 0);
504 my ($let, $msg) = @_;
505 # $msg =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg;
506 # $sock->print("$let$call|$msg\n");
507 $sock->print("$msg\n");
512 my $t = shift || time;
513 return sprintf "%02d:%02d:%02d", (gmtime($t))[2,1,0];
518 my $t = shift || time;
519 return sprintf "%02d:%02d", (gmtime($t))[2,1];