#!/usr/bin/perl -w

#
# A simpler version of the pager, that only switches between desktops without
# the outlines of windows. Patterned after the built-in pager that comes with
# tkGoodStuff.
#
# Randy J. Ray, adapted by Mikhael Goikhman.
#
# Usage:
#
#   *FvwmPerlTkDesker: Rows 2
#   *FvwmPerlTkDesker: Background bisque
#   *FvwmPerlTkDesker: Font 7x14
#   *FvwmPerlTkDesker: Title Perl/Tk Desker
#   Style *Desker Sticky
#   /path/to/tests/perl/module-tkdesker 0 3
#

use 5.003;
use strict;
use vars qw($TOP $desker %opts $current_desk $frame @buttons @desk_focus);

use lib `fvwm-perllib dir`;
use FVWM::Module::Tk;
use Tk;

my $TOP = new MainWindow;
my $desker = new FVWM::Module::Tk($TOP,
	Name => "FvwmPerlTkDesker",
	Mask => (M_NEW_DESK | M_FOCUS_CHANGE | M_ERROR),
);
&read_desker_options($desker, $TOP);

$frame = $TOP->Frame;
$TOP->title($opts{Title} || $desker->name);
$TOP->geometry($opts{Geometry}) if (defined $opts{Geometry});
&make_buttons($frame, $desker);
$frame->pack(-expand => 1, -fill => 'both', -anchor => 'nw');

$desker->add_handler(M_NEW_DESK, sub {
	my ($self, $event) = @_;
	my $desk = $event->_desk;

	&unhilite($current_desk);
	return if $desk < $opts{START} or $desk > $opts{'END'};
	$current_desk = $desk;
	&hilite($current_desk, $self);
});
$desker->add_handler(M_FOCUS_CHANGE, sub {
	my ($self, $event) = @_;

	$desk_focus[$current_desk] = $event->_win_id;
});
$desker->add_default_error_handler;

#
# Any signals we need to be wary of?
#
$SIG{PIPE} = sub { exit };

$current_desk = &current_desk($desker);
&hilite($current_desk);

$desker->event_loop; # Never returns

exit;

sub read_desker_options ($$) {
	my $mod = shift;
	my $top = shift;

	my @args = $mod->argv;

	if (@args < 2) {
		my $name = $mod->name;
		$mod->show_error("$name requires start and end params");
		die "Usage: $0 #start #end [ -name name_string ]\n";
	}

	my $START = shift(@args);
	my $END   = shift(@args);

	for ($START .. $END) { $desk_focus[$_] = undef }

	if ($args[0] && $args[0] eq '-name' && $args[1]) {
		$mod->name($args[1]);
	}

	### To fix
	%opts = ();  #$mod->get_config_info();

	$top->optionAdd('*foreground', $opts{Foreground})
		if (exists $opts{Foreground});
	$top->optionAdd('*background', $opts{Background})
		if (exists $opts{Background});
	$top->optionAdd('*font', $opts{Font}) if (exists $opts{Font});

	$opts{ROWS} = $opts{Rows} || 1;
	$opts{COLS} = $opts{Columns} || int(($END - $START + 1) / $opts{ROWS});
	$opts{START} = $START;
	$opts{'END'} = $END;
}

sub make_buttons ($$) {
	my $top = shift;
	my $mod = shift;

	my ($start, $end, $cols, $rows) =
		($opts{START}, $opts{'END'}, $opts{COLS},  $opts{ROWS});
	my ($x, $y, $text, $button, $frame, @labels);

	die "Managed desks ($start to $end) must exactly fit in ${cols}x$rows "
		. "space, stopped.\n"
		if $cols * $rows != $end - $start + 1;

	if (exists $opts{Label} and ref($opts{Label}) eq 'ARRAY') {
		my ($each, $pos, $string);

		for $each (@{$opts{Label}}) {
			($pos, $string) = split(/ /, $each, 2);
			$labels[$pos] = $string;
		}
	}

	for ($x = 0; $x < $cols; $x++) {
		$frame = $top->Frame;
		for ($y = 0; $y < $rows; $y++) {
			my $pos = $start + $x + ($y * $cols);

			$button = $frame->Label(-relief => 'raised');
			$button->bind('<1>', sub {
				$mod->send("Desk 0 $pos");
			});
			$text = $labels[$pos] || "Desk $pos";
			$button->configure(-text => "$text")
				unless (exists $opts{NoLabels} and $opts{NoLabels} !~ /no/oi);

			$button->pack(-side => 'top', -expand => 1, -fill => 'both');

			# This index happens to match the desk #, for (un)hilite
			$buttons[$pos] = $button;
		}
		$frame->pack(-side => 'left', -expand => 1, -fill => 'both');
	}
}

sub hilite ($$) {
	my $desk = shift;
	my $mod = shift;

	my $button = $buttons[$desk];

	if (exists $opts{CurrentDeskBackground}) {
		$button->configure(-background => $opts{CurrentDeskBackground});
		$button->configure(-foreground => $opts{CurrentDeskForeground})
			if exists $opts{CurrentDeskForeground};
	} else {
		$button->configure(-relief => 'sunken');
	}
	#$mod->send("Focus", $desk_focus[$desk])
	#	if (defined $desk_focus[$desk]);
}

sub unhilite ($) {
	my $desk = shift;

	my $button = $buttons[$desk];

	if (exists $opts{CurrentDeskBackground}) {
		$button->configure(-background => $opts{Background});
		$button->configure(-foreground => $opts{Foreground})
			if exists $opts{CurrentDeskForeground};
	} else {
		$button->configure(-relief => 'raised');
	}
}

sub current_desk ($) {
	my $mod = shift;

	# not implemented

	return 0;
}