]> gb7djk.dxcluster.net Git - spider.git/blob - gtkconsole/gtkconsole
start the recasting of gtkconsole
[spider.git] / gtkconsole / gtkconsole
1 #!/usr/bin/perl -w
2 #
3 # A GTK based console program
4 #
5 # usage: gtkconsole [<callsign>] [<host> <port>]
6 #
7 # Copyright (c) 2006-2007 Dirk Koopman G1TLH
8 #
9 #
10 #
11
12 use strict;
13
14 our $VERSION = '$Revision$';
15 $VERSION =~ s|[^\d\.]+||g;
16
17 our $root;
18
19 # search local then perl directories
20 BEGIN {
21         # root of directory tree for this system
22         $root = "/spider";
23         $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
24 }
25
26 use Glib;
27 use Gtk2 qw(-init);
28 use Gtk2::Helper;
29 use Gtk2::SimpleMenu;
30 use Data::Dumper;
31 use IO::File;
32
33 use Screen;
34
35 use vars qw(@modules $font);
36
37 @modules = ();                                  # is the list of modules that need init calling
38                                                                 # on them. It is set up by each  'use'ed module
39                                                                 # that has Gtk stuff in it
40 use IO::Socket::INET;
41
42 our @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
43
44 # various GTK handles
45 our $main;                                              # the main screen
46 our $scr_width;                                 # calculated screen dimensions
47 our $scr_height;
48 our ($dx, $cmd, $ann, $wcy, $wwv, $chat); # scrolling list windows
49 our $bot;                                               # the cmd entry window
50 our $date;                                              # the current date
51
52 # other windows
53 our $annwin;                                    # the announcement window handle
54 our $dxwin;                                             # the dx spot window handle
55 our $wwvwin;                                    # wwv window handle
56 our $wcywin;                                    # wcy window handle
57 our $chatwin;                                   # chat window handle
58
59 require "$root/local/DXVars.pm" if -e "$root/local/DXVars.pm";
60
61 # read in the user data
62 our $userfn = "$ENV{HOME}/.gtkconsole_data";
63 our $user = read_user_data();
64 our $call;
65 our $passwd;
66 our $host = 'localhost';
67 our $port = 7300;
68
69 #
70 # read in gtkconsole file
71 #
72
73 Gtk2::Rc->set_default_files("$root/gtkconsole/gtkconsolerc", "$ENV{HOME}/.gtkconsolerc", ".gtkconsolerc");
74 Gtk2::Rc->reparse_all;
75
76 # sort out a callsign, host and port, looking in order
77 #  1. the command line
78 #  2. any defaults in the user data;
79 #  3. poke about in any spider tree that we can find
80 #
81
82 if (@ARGV) {
83         $call = uc shift @ARGV;
84         $host = shift @ARGV if @ARGV;
85         $port = shift @ARGV if @ARGV;
86 }
87
88 unless ($call && $host) {
89         my $node = $user->{clusters}->{$user->{node}};
90
91         if ($node->{call} || $user->{call}) {
92                 $call = $node->{call} || $user->{call} || $main::myalias;
93                 $host = $node->{passwd};
94                 $host = $node->{host};
95                 $port = $node->{port};
96         }
97 }
98
99 unless ($call && $host) {
100         if (-e "$root/local/Listeners.pm") {
101                 require  "$root/local/Listeners.pm";
102                 $host = $main::listen->[0]->[0];
103                 $port = $main::listen->[0]->[1];
104                 $host ||= '127.0.0.1';
105                 $host = "127.0.0.1" if $host eq '0.0.0.0';
106                 $port ||= 7300;
107         }
108 }
109
110 unless ($host) {
111         $host = $user->{clusters}->{$user->{node}}->{host};
112         $port = $user->{clusters}->{$user->{node}}->{port};
113 }
114
115 $call ||= '';
116 $host ||= '';
117 $port ||= '';
118 die "You need a callsign ($call), a hostname($host) and a port($port) to proceed" unless $call && $host;
119
120 #
121 # start of GTK stuff
122 #
123
124 gtk_create_main_screen();
125
126 $main->set_title("gtkconsole $VERSION - DXSpider Console - $call \@ $host:$port");
127
128 # connect and send stuff
129 my $sock = IO::Socket::INET->new(PeerAddr=>$host, PeerPort=>$port);
130 die "Cannot connect to  $/$port ($!)\n" unless $sock;
131 sendmsg($call);
132 sendmsg($passwd) if $passwd;
133 sendmsg('set/gtk');
134 sendmsg('set/page 500');
135 sendmsg('set/nobeep');
136
137 my $sock_helper = Gtk2::Helper->add_watch($sock->fileno, 'in', \&tophandler, $sock);
138
139 # the main loop
140 $main->show_all;
141 $bot->grab_focus;
142 Gtk2->main;
143 exit(0);
144
145 #
146 # handlers
147 #
148
149 sub updatetime
150 {
151         $_[0]->set_text(cldatetime(time));
152         1;
153 }
154
155 sub bothandler
156 {
157         my ($self, $data) = @_;
158         my $msg = $self->get_text;
159         $msg =~ s/\r?\n$//;
160         $self->set_text('');
161         $self->grab_focus;
162         sendmsg($msg);
163 }
164
165 my $rbuf = '';
166
167 sub tophandler
168 {
169         my ($fd, $condx, $socket) = @_;
170
171         my $offset = defined $rbuf ? length $rbuf : 0;
172         my $l = sysread($socket, $rbuf, 1024, $offset);
173         if (defined $l) {
174                 if ($l) {
175                         while ($rbuf =~ s/^([^\015\012]*)\015?\012//) {
176                                 my $msg = $1;
177                                 handlemsg($msg);
178                         }
179                 } else {
180                         Gtk2->main_quit;
181                 }
182         } else {
183                 Gtk2->main_quit;
184         }
185         1;
186
187 }
188
189 sub handlemsg
190 {
191         my $line = shift;
192
193         # this is truely evil and I bet there is a better way...
194         chomp $line;
195         my $list;
196         if ($line =~ /^'\w{2,4}',/) {
197                 $list = eval qq([$line]);
198         } else {
199                 $list = ['cmd', $line];
200         }
201         unless ($@) {
202                 no strict 'refs';
203                 my $cmd = shift @$list;
204                 my $handle = "handle_$cmd";
205                 if (__PACKAGE__->can($handle)) {
206                         __PACKAGE__->$handle($list);
207                 } else {
208                         unshift @$list, $cmd;
209                         __PACKAGE__->handle_def($list);
210                 }
211         }
212 }
213
214 sub handle_cmd
215 {
216         my $self = shift;
217         my $ref = shift;
218         my ($t, $ts) = (time, '');
219         my $s;
220         $s = ref $ref ? join ', ',@$ref : $ref;
221
222         if (($cmd->{lasttime}||0) != $t) {
223                 $ts = tim($t);
224                 $cmd->{lasttime} = $t;
225         }
226
227         chomp $s;
228         $cmd->add_data([$ts,  $s]);
229 }
230
231 sub handle_def
232 {
233         my $self = shift;
234         my $ref = shift;
235         my ($t, $ts) = (time, '');
236         my $s;
237         $s = ref $ref ? join(', ', @$ref) : $ref;
238         if (($cmd->{lasttime}||0) != $t) {
239                 $ts = tim($t);
240                 $cmd->{lasttime} = $t;
241         }
242         $cmd->add_data([$ts,  $s]);
243 }
244
245 sub handle_dx
246 {
247         my $self = shift;
248         my $ref = shift;
249         my ($t, $ts) = (time, '');
250
251         if (($dx->{lasttime}||0) != $t) {
252                 $ts = tim($t);
253                 $dx->{lasttime} = $t;
254         }
255         $dx->add_data([$ts,  @$ref[0,1,15,3,4,16], stim($ref->[2]) ]);
256         $dxwin->show_all;
257 }
258
259 sub handle_ann
260 {
261         my $self = shift;
262         my $ref = shift;
263         my ($t, $ts) = (time, '');
264 #       my $s;
265 #       $s = ref $ref ? (join ', ',@$ref) : $ref;
266
267         if (($ann->{lasttime}||0) != $t) {
268                 $ts = tim($t);
269                 $ann->{lasttime} = $t;
270         }
271
272 #       chomp $s;
273         $ann->add_data([$ts,  @$ref[3,1,2]]);
274         $annwin->show_all;
275 }
276
277 sub handle_wcy
278 {
279         my $self = shift;
280         my $ref = shift;
281 #       my $s;
282 #       $s = ref $ref ? join ', ',@$ref : $ref;
283
284 #       chomp $s;
285
286         $wcy->add_data([tim(),  @$ref[10,4,5,3,6,2,7,8,9,1] ]);
287         $wcywin->show_all;
288 }
289
290 sub handle_wwv
291 {
292         my $self = shift;
293         my $ref = shift;
294 #       my $s;
295 #       $s = ref $ref ? join ', ',@$ref : $ref;
296
297 #       chomp $s;
298         $wwv->add_data([tim(),  @$ref[6,2,3,4,5,1] ]);
299         $wwvwin->show_all;
300 }
301
302
303 sub handle_chat
304 {
305         my $self = shift;
306         my $ref = shift;
307         my ($t, $ts) = (time, '');
308         my $s;
309         $s = ref $ref ? (join ', ',@$ref) : $ref;
310
311         if (($ann->{lasttime}||0) != $t) {
312                 $ts = tim($t);
313                 $ann->{lasttime} = $t;
314         }
315
316         chomp $s;
317         $chat->add_data([$ts,  @$ref[3,1,2]]);
318         $chatwin->show_all;
319 }
320
321
322
323 #
324 # subroutine
325 #
326
327 sub sendmsg
328 {
329         my $msg = shift;
330         $sock->print("$msg\n");
331 }
332
333 sub tim
334 {
335         my $t = shift || time;
336         return sprintf "%02d:%02d:%02d", (gmtime($t))[2,1,0];
337 }
338
339 sub stim
340 {
341         my $t = shift || time;
342         return sprintf "%02d:%02d", (gmtime($t))[2,1];
343 }
344
345 # get a zulu time in cluster format (2300Z)
346 sub ztime
347 {
348         my $t = shift;
349         $t = defined $t ? $t : time;
350         my $dst = shift;
351         my ($sec,$min,$hour) = $dst ? localtime($t): gmtime($t);
352         my $buf = sprintf "%02d%02d%s", $hour, $min, ($dst) ? '' : 'Z';
353         return $buf;
354 }
355
356 # get a cluster format date (23-Jun-1998)
357 sub cldate
358 {
359         my $t = shift;
360         $t = defined $t ? $t : time;
361         my $dst = shift;
362         my ($sec,$min,$hour,$mday,$mon,$year) = $dst ? localtime($t) : gmtime($t);
363         $year += 1900;
364         my $buf = sprintf "%2d-%s-%04d", $mday, $month[$mon], $year;
365         return $buf;
366 }
367
368 # return a cluster style date time
369 sub cldatetime
370 {
371         my $t = shift;
372         my $dst = shift;
373         my $date = cldate($t, $dst);
374         my $time = ztime($t, $dst);
375         return "$date $time";
376 }
377
378 sub read_user_data
379 {
380         my $u;
381
382         if (-e $userfn) {
383                 my $fh = new IO::File $userfn;
384                 my $s = undef;
385                 if ($fh) {
386                         local $/ = undef;
387                         $s = <$fh>;
388                         $fh->close;
389                 }
390                 eval "\$u = $s";
391         }
392         unless ($u) {
393                 print "$userfn missing or unreadable, starting afresh!\n";
394
395                 $u = {
396                           clusters => {
397                                                    'LOCAL' => {host => '127.0.0.1', port => 7300},
398                                                    'GB7DJK' => {host => 'gb7djk.dxcluster.net', port => 7300},
399                                                    'WR3D' => {host => 'wr3d.dxcluster.net', port => 7300},
400                                                    'GB7BAA' => {host => 'gb7baa.dxcluster.net', port => 7300},
401                                                   },
402                           node => 'LOCAL',
403                           call => $main::myalias,
404                          };
405                 write_user_data($u);
406         }
407         return $u;
408 }
409
410 sub write_user_data
411 {
412         my $u = shift;
413
414         my $fh = new IO::File ">$userfn";
415         if ($fh) {
416                 my $dd = new Data::Dumper([ $u ]);
417                 $dd->Indent(1);
418                 $dd->Quotekeys(0);
419                 $fh->print($dd->Dumpxs);
420                 $fh->close;
421                 return 1;
422         }
423         return 0;
424 }
425
426 sub def_menu_callback
427 {
428
429 }
430
431 sub gtk_create_main_screen
432 {
433         $main = new Gtk2::Window('toplevel');
434         my $scr = $main->get_screen;
435         $scr_width = $scr->get_width;
436         $scr_width = 700 if $scr_width > 700;
437         $scr_height = int ($scr->get_height * 0.66);
438         $main->set_default_size($scr_width, $scr_height);
439         $main->signal_connect('delete_event', sub { Gtk2->main_quit; });
440
441         # the main vbox
442         my $vbox = new Gtk2::VBox(0, 1);
443         $main->add($vbox);
444
445         my $menutree = [
446                                         _File => {
447                                                           item_type => '<Branch>',
448                                                           children => [
449                                                                                    _Quit => {
450                                                                                                          callback => sub { Gtk2->main_quit; },
451                                                                                                          callback_action => 1,
452                                                                                                          accelerator => '<ctrl>Q',
453                                                                                                         }
454                                                                                   ],
455                                                          },
456
457                                         _Help => {
458                                                           item_type => '<Branch>',
459                                                           children => [
460                                                                                    _About => {
461                                                                                                           callback_action => 9,
462                                                                                                          },
463                                                                                   ],
464                                                          },
465
466                                    ];
467
468         my $menu = Gtk2::SimpleMenu->new(menu_tree => $menutree, default_callback => \&def_menu_callback, user_data => $user);
469         $vbox->pack_start($menu->{widget}, 0, 1, 0);
470
471
472         # a paned hbox is packed as the bottom of the vbox
473 #       my $bhpane = Gtk2::HPaned->new;
474 #       $vbox->pack_end($bhpane, 1, 1, 0);
475
476         # now create the lh and rh panes
477 #       my $lhvpane = Gtk2::VPaned->new;
478 #       my $rhvpane = Gtk2::VPaned->new;
479 #       $bhpane->pack1($lhvpane, 1, 0);
480 #       $bhpane->pack2($rhvpane, 1, 0);
481
482
483         # The command list
484 #       my $lhvbox = Gtk2::VBox->new(0, 1);
485         $cmd = Screen::List->new(fields => [
486                                                                                 RxTime => 'tt',
487                                                                                 Information => 'ttlong',
488                                                                            ],
489                                                          size => [$scr_width, $scr_height * 0.66],
490                                                         );
491         $vbox->pack_start($cmd->widget, 1, 1, 0);
492
493
494         # callsign and current date and time
495         my $hbox = new Gtk2::HBox;
496         my $calllabel = new Gtk2::Label($call);
497         my $date = new Gtk2::Label(cldatetime(time));
498         $date->{tick} = Glib::Timeout->add(1000, \&updatetime, $date);
499         $hbox->pack_start( $calllabel, 0, 1, 0 );
500         $hbox->pack_end($date, 0, 1, 0);
501         $vbox->pack_start($hbox, 0, 1, 0);
502         $vbox->pack_start(Gtk2::HSeparator->new, 0, 1, 0);
503
504         # the bottom handler
505         $bot = new Gtk2::Entry;
506         $bot->set_editable(1);
507         $bot->signal_connect('activate', \&bothandler);
508         $bot->can_default(1);
509         $vbox->pack_end($bot, 0, 1, 0);
510 #       $lhvpane->pack2($lhvbox, 1, 0);
511         $bot->grab_default;
512
513         #
514         #
515         #
516
517         #
518         # The announce list
519         $annwin = new Gtk2::Window('toplevel');
520         $ann = Screen::List->new(fields =>[
521                                                                            RxTime => 'tt',
522                                                                            From => 'tt',
523                                                                            To => 'tt',
524                                                                            Announcement => 'ttlesslong',
525                                                                           ],
526                                                          hint => 1,
527                                                          frame => 'Announcements',
528                                                          size => [$scr_width * 0.85, $scr_height * 0.25],
529                                                         );
530         $annwin->add($ann->widget);
531 #       $annwin->show_all;
532
533         # The announce list
534         $chatwin = new Gtk2::Window('toplevel');
535         $chat = Screen::List->new(fields =>[
536                                                                            RxTime => 'tt',
537                                                                            From => 'tt',
538                                                                            To => 'tt',
539                                                                            Chat => 'ttlesslong',
540                                                                           ],
541                                                          hint => 1,
542                                                          frame => 'Chat',
543                                                          size => [$scr_width * 0.85, $scr_height * 0.25],
544                                                         );
545         $chatwin->add($chat->widget);
546 #       $annwin->show_all;
547
548         # DX window
549         $dxwin = new Gtk2::Window('toplevel');
550         $dx = Screen::List->new(fields => [
551                                                                            'RxTime' => 'tt',
552                                                                            'QRG' => 'qrg',
553                                                                            'DX Call' => 'tt',
554                                                                            'Grid' => 'tt',
555                                                                            'Remarks' => 'ttshort',
556                                                                            'By' => 'tt',
557                                                                            'Grid' => 'tt',
558                                                                            'TxTime' => 'tt',
559                                                                           ],
560                                                         policy => [qw(never automatic)],
561                                                         hint => 1,
562                                                         frame => "DX Spots",
563                                                         maxsize => 500,
564                                                         size => [$scr_width * 0.9, $scr_height * 0.25],
565                                                    );
566 #       $rhvpane->pack1($dx->widget, 1, 0);
567         $dxwin->add($dx->widget);
568 #       $dxwin->show_all;
569
570         # The wwv list
571         $wwvwin = new Gtk2::Window('toplevel');
572         #       my $rhvbox = Gtk2::VBox->new(0, 1);
573         $wwv = Screen::List->new( fields =>[
574                                                                                 RxTime => 'tt',
575                                                                                 From => 'tt',
576                                                                                 SFI => 'int',
577                                                                                 A => 'int',
578                                                                                 K => 'int',
579                                                                                 Remarks => 'ttshort',
580                                                                                 Hour => 'tt'
581                                                                            ],
582                                                           hint => 1,
583                                                           policy => ['never', 'automatic'],
584                                                           frame => 'WWV Data',
585                                                         );
586         $wwvwin->add($wwv->widget);
587 #       $wwvwin->show_all;
588
589 #       $rhvbox->pack_start($wwv->widget, 1, 1, 0);
590
591         # The wcy list
592         $wcywin = new Gtk2::Window('toplevel');
593         $wcy = Screen::List->new(fields => [
594                                                                                 RxTime => 'tt',
595                                                                                 From => 'tt',
596                                                                                 K => 'int',
597                                                                                 ExpK => 'int',
598                                                                                 A => 'int',
599                                                                                 R => 'int',
600                                                                                 SFI => 'int',
601                                                                                 SA => 'tt',
602                                                                                 GMF => 'tt',
603                                                                                 Aurora => 'tt',
604                                                                                 Hour => 'tt'
605                                                                            ],
606                                                          hint => 1,
607                                                          policy => ['never', 'automatic'],
608                                                          frame => 'WCY Data',
609                                                         );
610
611 #       $rhvbox->pack_start($wcy->widget, 1, 1, 0);
612 #       $rhvbox->set_size_request($scr_width * 0.45, $scr_height * 0.33);
613 #       $rhvpane->pack2($rhvbox, 1, 0);
614         $wcywin->add($wcy->widget);
615 #       $wcywin->show_all;
616 }