#!/usr/bin/perl -w
#
# A GTK based console program
#
# Copyright (c) 2001 Dirk Koopman G1TLH
#
# $Id$
#

# search local then perl directories
BEGIN {
	# root of directory tree for this system
	$root = "/spider"; 
	$root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
	
	unshift @INC, "$root/perl";	# this IS the right way round!
	unshift @INC, "$root/gtkconsole";
	unshift @INC, "$root/local";
}

use strict;

use Gtk qw(-init);

use vars qw(@modules $font);                    

@modules = ();					# is the list of modules that need init calling
								# on them. It is set up by each  'use'ed module
								# that has Gtk stuff in it
$font = Gtk::Gdk::Font->load("-misc-fixed-medium-r-normal-*-*-130-*-*-c-*-koi8-r");

use DXVars;
use DXUtil;
use IO::Socket::INET;
use Text;
use DebugHandler;

#
# main initialisation
#
my $call = uc shift @ARGV if @ARGV;
$call = uc $main::myalias unless $call;
my ($scall, $ssid) = split /-/, $call;
$ssid = undef unless $ssid && $ssid =~ /^\d+$/;  
if ($ssid) {
	$ssid = 15 if $ssid > 15;
	$call = "$scall-$ssid";
}

die "You cannot connect as your cluster callsign ($main::mycall)\n" if $call eq $main::mycall;


my $sock = IO::Socket::INET->new(PeerAddr=>$main::clusteraddr, PeerPort=>$main::clusterport);
die "Cannot connect to $main::clusteraddr/$main::clusterport ($!)\n" unless $sock;
sendmsg('A', 'local');
sendmsg('G', '2');
sendmsg('I', 'set/page 500');
sendmsg('I', 'set/nobeep');

#
# start of GTK stuff
#


# main window
my $main = new Gtk::Window('toplevel');
$main->set_default_size(600, 600);
$main->set_policy(0, 1, 0);
$main->signal_connect('destroy', sub { Gtk->exit(0); });
$main->signal_connect('delete_event', sub { Gtk->exit(0); });
$main->set_title("gtkconsole - The DXSpider Console - $call");

# the main vbox
my $vbox = new Gtk::VBox(0, 1);
$vbox->border_width(1);
$main->add($vbox);

# the menu bar
my @menu = ( 
			{path => '/_File', type => '<Branch>'},
			{path => '/_File/Quit', callback => sub {Gtk->exit(0)}},
			{path => '/_Help', type => '<LastBranch>'},
			{path => '/_Help/About'},
		   );
my $accel = new Gtk::AccelGroup();
my $itemf = new Gtk::ItemFactory('Gtk::MenuBar', '<main>', $accel);
$itemf->create_items(@menu);
$main->add_accel_group($accel);
my $menu = $itemf->get_widget('<main>');
$vbox->pack_start($menu, 0, 1, 0);
$menu->show;


my $top = new Text(1);
my $toplist = $top->text;
$toplist->set_editable(0);
$toplist->sensitive(0);

# add the handler for incoming messages from the node
my $tophandler = Gtk::Gdk->input_add($sock->fileno, ['read'], \&tophandler, $sock);
my $rbuf = "";						# used in handler

#$toplist->{signalid} = $toplist->signal_connect(insert_text => \&doinsert, $toplist); 
#$bot->{signalid} = $bot->signal_connect(insert_text => \&botinsert, $bot); 
$vbox->pack_start($top, 1, 1, 0);
$vbox->show;

# the bottom handler
my $bot = new Gtk::Entry;
my $style = $toplist->style;
$style->font($main::font);
$bot->set_style($style);
$bot->set_editable(1);
$bot->signal_connect('activate', \&bothandler);
$bot->can_default(1);
$bot->grab_default;
$bot->grab_focus;
$bot->show;

# a horizontal box
my $hbox = new Gtk::HBox;
$hbox->show;

# callsign and current date and time
my $calllabel = new Gtk::Label($call);
my $date = new Gtk::Label(cldatetime(time));
Gtk->timeout_add(1000, \&updatetime);
$calllabel->show;
$date->show;
 
$hbox->pack_start( $calllabel, 0, 1, 0 );
$hbox->pack_end($date, 0, 1, 0);


$vbox->pack_start($hbox, 0, 1, 0); 

# nice little separator
my $separator = new Gtk::HSeparator();
$vbox->pack_start( $separator, 0, 1, 0 );
$separator->show();
$vbox->pack_start($bot, 0, 1, 0);

# the main loop
$main->show_all;
Gtk->main;

#
# handlers
#

sub updatetime
{
	$date->set_text(cldatetime(time));
	1;
}

sub doinsert {
	my ($self, $text) = @_;

	# we temporarily block this handler to avoid recursion
	$self->signal_handler_block($self->{signalid});
	my $pos = $self->insert($self->{font}, $toplist->style->black, $toplist->style->white, $text);
	$self->signal_handler_unblock($self->{signalid});

	# we already inserted the text if it was valid: no need
	# for the self to process this signal emission
	$self->signal_emit_stop_by_name('insert-text');
	1;
}

sub bothandler
{
	my ($self, $data) = @_;
	my $msg = $self->get_text;
	$msg =~ s/\r?\n$//;
	$self->set_text('');
	senddata($msg);
}

sub tophandler
{
	my ($socket, $fd, $flags) = @_;
	if ($flags->{read}) {
		my $offset = length $rbuf;
		my $l = sysread($socket, $rbuf, 1024, $offset);
		if (defined $l) {
			my $freeze;
			if ($l) {
				while ($rbuf =~ s/^([^\015\012]*)\015?\012//) {
					my $msg = $1;
					$msg =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg;
					$msg =~ s/[\x00-\x08\x0a-\x19\x1b-\x1f\x80-\x9f]/./g;         # immutable CSI sequence + control characters
					$toplist->freeze unless $freeze++;
					handlemsg($msg);
				}
				if ($freeze) {
					$toplist->thaw;
					$toplist->vadj->set_value($toplist->vadj->upper);
					$toplist->vadj->value_changed;
				}
			} else {
				Gtk->exit(0);
			}
		} else {
			Gtk->exit(0);
		}
	}
}

sub handlemsg
{
	my $msg = shift;
	my ($sort, $call, $line) = $msg =~ /^(\w)([^\|]+)\|(.*)$/;
	if ($sort eq 'D') {
		$toplist->insert($toplist->{font}, undef, undef, "$line\n");
	} elsif ($sort eq 'X') {
		$toplist->insert($toplist->{font}, undef, undef, "$line\n");
	} elsif ($sort eq 'Y') {
		$toplist->insert($toplist->{font}, undef, undef, "$line\n");
	} elsif ($sort eq 'V') {
		$toplist->insert($toplist->{font}, undef, undef, "$line\n");
	} elsif ($sort eq 'N') {
		$toplist->insert($toplist->{font}, undef, undef, "$line\n");
	} elsif ($sort eq 'W') {
		$toplist->insert($toplist->{font}, undef, undef, "$line\n");
	} elsif ($sort eq 'Z') {
		Gtk->exit(0);
	}
}

#
# subroutine
#

sub senddata
{
	my $msg = shift;
	sendmsg('I', $msg);
}

sub sendmsg
{
	my ($let, $msg) = @_;
	$msg =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg; 
	$sock->print("$let$call|$msg\n");
}