view release on metacpan or  search on metacpan

lib/Tk/Year.pm  view on Meta::CPAN

	# Any further contracts happen to the title widget.
	$self->Delegates(
		Construct => $self->{title},
		DEFAULT => $self->{title},
	);

	# return widget.
	$self;
}

;# Create all the subwidgets needed
sub make
{
	debug "args: @_\n";

	my $self	= shift;

	my $width = 2;

	# First create all the buttons in a grid.

	# navigation row.
	$self->{title} = $self->Menubutton(
		-width	=> 15,
		-text	=> 'Tk::Year',
	);
	
	# Create the month widgets
	for my $month (@Tk::Month::year)
	{
		my $m = $self->Month(
				-title	=> '%B',
				-month	=> $month,
				-navigation	=> 0,
				-side		=> 0,
			);

		push (@{$self->{'months'}}, $m);
	}

	$self;
}

# (Re-)Pack the months in to the correct number of columns.
sub cols
{
	my $self = shift;
	
	# requesting the value.
	return $self->{Configure}->{-cols} unless @_;

	# setting the value.
	my $cols = shift;
	$self->{Configure}->{-cols} = $cols;

	# Pack the title.
	$self->{title}->grid(
		-row		=> 0,
		-column		=> int(($cols-1)/2),
		-columnspan	=> 2 - $cols %2 ,
		-sticky		=> 'nsew',
	);

	# Positions (0,0), (0,1), (0,6), (0,7) are the
	# navigation buttons.

	my $n = 0;
	for my $month (@{$self->{'months'}})
	{
		# decide the row and column.
		my $c = $n % $cols ;
		my $r = int($n / $cols) +1;
		$n ++;
		
		$month ->grid(
				'-row'		=> $r + 1,
				'-column'	=> $c,
				'-sticky'	=> 'nsew',
				'-padx'		=> 5,
			);
	}
}

# Set the inter-month spacing.
sub sep
{
	my $self = shift;
	
	# requesting the value.
	return $self->{Configure}->{-sep} unless @_;

	# setting the value.
	my $sep = shift;
	$self->{Configure}->{-sep} = $sep;

	for my $month (@{$self->{'months'}})
	{
		$month ->grid('-padx' => $sep);
	}
}

;# configure or return various properties.
sub conf
{
	my $self = shift;

	# Decide what called us and hence which flag to set.
	my $var = (caller(1))[3];
	$var =~ s/^.*:/-/;

	debug "var = $var\n";

	return $self->{Configure}->{$var} unless @_;

	my $val = shift;
	debug "val = $val\n";
	
	# remember....
	$self->{Configure}->{$var} = $val;