]> gb7djk.dxcluster.net Git - spider.git/blob - gtkconsole/gtkconsole
95a810aeee1db092b383e2f05dffa7d4f8c3f1b2
[spider.git] / gtkconsole / gtkconsole
1 #!/usr/bin/perl -w
2 #
3 # A GTK based console program
4 #
5 # Copyright (c) 2001-6 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 Glib;
24 use Gtk2 qw(-init);
25 use Gtk2::Helper;
26 use Gtk2::SimpleList;
27
28 use vars qw(@modules $font);                    
29
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
33 use DXVars;
34 use DXUtil;
35 use IO::Socket::INET;
36
37 #
38 # main initialisation
39 #
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+$/;  
44 if ($ssid) {
45         $ssid = 15 if $ssid > 15;
46         $call = "$scall-$ssid";
47 }
48
49 die "You cannot connect as your cluster callsign ($main::mycall)\n" if $call eq $main::mycall;
50
51 my $host = 'gb7djk.dxcluster.net';
52 my $port = 7300;
53
54 my $sock = IO::Socket::INET->new(PeerAddr=>$host, PeerPort=>$port);
55 die "Cannot connect to  $host/$port ($!)\n" unless $sock;
56 sendmsg('I', $call);
57 sendmsg('I', 'set/gtk');
58 #sendmsg('A', 'local');
59 #sendmsg('G', '2');
60 sendmsg('I', 'set/page 500');
61 sendmsg('I', 'set/nobeep');
62
63 #
64 # start of GTK stuff
65 #
66
67
68
69 # +--------+-------+------------------------------------------------------------------------------------+
70 # | _File  | _Help |                                                                                    |
71 # +--------+-------+------------------------------------------------------------------------------------+
72 #
73 # main window
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");
81
82 # the main vbox
83 my $vbox = new Gtk2::VBox(0, 1);
84 $main->add($vbox);
85
86
87 # the menu bar
88 my @menu = ( 
89                         {path => '/_File', type => '<Branch>'},
90                         {path => '/_File/Quit', callback => sub {Gtk2->main_quit}},
91                         {path => '/_Help', type => '<LastBranch>'},
92                         {path => '/_Help/About'},
93                    );
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);
98
99
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);
103
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);
110
111 # first add a column type for the QRG
112 my $font = 'monospace 9';
113 my $oddbg = 'light blue';
114 my $evenbg = 'white';
115
116 Gtk2::SimpleList->add_column_type( 'qrg',
117                      type     => 'Glib::Scalar',
118                      renderer => 'Gtk2::CellRendererText',
119                      attr     => sub {
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);
123                      }
124                 );
125
126
127 Gtk2::SimpleList->add_column_type( 'tt',
128                      type     => 'Glib::Scalar',
129                      renderer => 'Gtk2::CellRendererText',
130                      attr     => sub {
131                           my ($treecol, $cell, $model, $iter, $col_num) = @_;
132                           my $info = $model->get ($iter, $col_num);
133                           $cell->set(text => $info, font => $font);
134                      }
135                 );
136
137
138 #
139 # LEFT HAND SIDE
140 #
141
142 # DX window
143 my $dxlist = Gtk2::SimpleList->new(
144                                                                    'RxTime' => 'tt',
145                                                                    'QRG' => 'qrg',
146                                                                    'DX Call' => 'tt',
147                                                                    'Grid' => 'tt',
148                                                                    'Remarks' => 'tt',
149                                                                    'By' => 'tt',
150                                                                    'Grid' => 'tt',
151                                                                    'TxTime' => 'tt',
152                                                                   );
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);
161
162 # The command list
163 my $cmdlist = Gtk2::SimpleList->new(
164                                                                         RxTime => 'tt',
165                                                                         Information => 'tt',
166                                                                    );
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);
174
175
176 # nice little separator
177 $lhvbox->pack_start(Gtk2::HSeparator->new, 0, 1, 0 );
178
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);
188
189 # the bottom handler
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);
195 $bot->grab_default;
196
197 #
198 # RIGHT HAND SIDE
199 #
200
201 # The announce list
202 my $annlist = Gtk2::SimpleList->new(
203                                                                         RxTime => 'tt',
204                                                                         From => 'tt',
205                                                                         To => 'tt',
206                                                                         Announcement => 'tt',
207                                                                    );
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);
216
217 # The wwv list
218 my $wwvlist = Gtk2::SimpleList->new(
219                                                                         RxTime => 'tt',
220                                                                         From => 'tt',
221                                                                         SFI => 'int',
222                                                                         A => 'int',
223                                                                         K => 'int',
224                                                                         Remarks => 'tt',
225                                                                         Hour => 'tt'
226                                                                    );
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);
235
236 # The wcy list
237 my $wcylist = Gtk2::SimpleList->new(
238                                                                         RxTime => 'tt',
239                                                                         From => 'tt',
240                                                                         K => 'int',
241                                                                         ExpK => 'int',
242                                                                         A => 'int',
243                                                                         R => 'int',
244                                                                         SFI => 'int', 
245                                                                         SA => 'tt',
246                                                                         GMF => 'tt',
247                                                                         Aurora => 'tt',
248                                                                         Hour => 'tt'
249                                                                    );
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);
258
259 my $sock_helper = Gtk2::Helper->add_watch($sock->fileno, 'in', \&tophandler, $sock);
260  
261 # the main loop
262 $main->show_all;
263 $bot->grab_focus;
264 Gtk2->main;
265 exit(0);
266
267 #
268 # handlers
269 #
270
271 sub updatetime
272 {
273         $date->set_text(cldatetime(time));
274         1;
275 }
276
277 sub bothandler
278 {
279         my ($self, $data) = @_;
280         my $msg = $self->get_text;
281         $msg =~ s/\r?\n$//;
282         $self->set_text('');
283         $self->grab_focus;
284         senddata($msg);
285 }
286
287 my $rbuf;
288
289 sub tophandler
290 {
291         my ($fd, $condx, $socket) = @_;
292
293         my $offset = length $rbuf;
294         my $l = sysread($socket, $rbuf, 1024, $offset);
295         if (defined $l) {
296                 if ($l) {
297                         while ($rbuf =~ s/^([^\015\012]*)\015?\012//) {
298                                 my $msg = $1;
299                                 handlemsg($msg);
300                         }
301                 } else {
302                         Gtk2->main_quit;
303                 }
304         } else {
305                 Gtk2->main_quit;
306         }
307         1;
308         
309 }
310
311 sub handlemsg
312 {
313         my $line = shift;
314
315         # this is truely evil and I bet there is a better way...
316         chomp $line;
317         my $list;
318         if ($line =~ /^'\w{2,4}',/) {
319                 $list = eval qq([$line]);
320         } else {
321                 $list = ['cmd', $line];
322         }
323         unless ($@) {
324                 no strict 'refs';
325                 my $cmd = shift @$list;
326                 my $handle = "handle_$cmd";
327                 if (__PACKAGE__->can($handle)) {
328                         __PACKAGE__->$handle($list);
329                 } else {
330                         unshift @$list, $cmd;
331                         __PACKAGE__->handle_def($list);
332                 }
333         }
334 }
335
336 sub handle_cmd
337 {
338         my $self = shift;
339         my $ref = shift;
340         my ($t, $ts) = (time, '');
341         my $s;
342         $s = ref $ref ? join ', ',@$ref : $ref;
343
344         if (($cmdscroll->{lasttime}||0) != $t) {
345                 $ts = tim($t);
346                 $cmdscroll->{lasttime} = $t;
347         }
348
349         chomp $s;
350         push @{$cmdlist->{data}}, [$ts,  $s];
351 }
352
353 sub handle_def
354 {
355         my $self = shift;
356         my $ref = shift;
357         my $s;
358         $s = ref $ref ? join ', ',@$ref : $ref;
359         my ($t, $ts) = (time, '');
360
361         if (($cmdscroll->{lasttime}||0) != $t) {
362                 $ts = tim($t);
363                 $cmdscroll->{lasttime} = $t;
364         }
365         
366         chomp $s;
367         push @{$cmdlist->{data}}, [$ts,  $s];
368 }
369
370 sub handle_dx
371 {
372         my $self = shift;
373         my $ref = shift;
374         my ($t, $ts) = (time, '');
375
376         if (($dxscroll->{lasttime}||0) != $t) {
377                 $ts = tim($t);
378                 $dxscroll->{lasttime} = $t;
379         }
380         push @{$dxlist->{data}}, [$ts,  @$ref[0,1,15,3,4,16], stim($ref->[2]) ];
381         
382 }
383
384 sub handle_ann
385 {
386         my $self = shift;
387         my $ref = shift;
388         my ($t, $ts) = (time, '');
389         my $s;
390         $s = ref $ref ? join ', ',@$ref : $ref;
391
392         if (($annscroll->{lasttime}||0) != $t) {
393                 $ts = tim($t);
394                 $annscroll->{lasttime} = $t;
395         }
396
397         chomp $s;
398         push @{$annlist->{data}}, [$ts,  @$ref[3,1,2]];
399 }
400
401 sub handle_wcy
402 {
403         my $self = shift;
404         my $ref = shift;
405         my $s;
406         $s = ref $ref ? join ', ',@$ref : $ref;
407
408         chomp $s;
409         push @{$wcylist->{data}}, [tim(),  @$ref[10,4,5,3,6,2,7,8,9,1] ];
410 }
411
412 sub handle_wwv
413 {
414         my $self = shift;
415         my $ref = shift;
416         my $s;
417         $s = ref $ref ? join ', ',@$ref : $ref;
418
419         chomp $s;
420         push @{$wwvlist->{data}}, [tim(),  @$ref[6,2,3,4,5,1] ];
421 }
422
423 #
424 # subroutine
425 #
426
427 sub senddata
428 {
429         my $msg = shift;
430         sendmsg('I', $msg);
431 }
432
433 sub sendmsg
434 {
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");
439 }
440
441 sub tim
442 {
443         my $t = shift || time;
444         return sprintf "%02d:%02d:%02d", (gmtime($t))[2,1,0];
445 }
446
447 sub stim
448 {
449         my $t = shift || time;
450         return sprintf "%02d:%02d", (gmtime($t))[2,1];
451 }