view release on metacpan or  search on metacpan

alpha/Tk/ListMgr.pm  view on Meta::CPAN

    my $layout = $lmgr->layout;

    my $data = $lmgr->privateData;
    my $why = delete $data->{why};

    $lmgr->update
	if($why & 1);

    my $meth = "arrange_" . $layout;
    $lmgr->$meth(0);
}

sub layout {
    my $lmgr = shift;
    my $data = $lmgr->privateData;
    my $o = $lmgr->{Configure}{'-layout'} ||= 'vertical';
    if(@_) {
	my $new = shift;
	croak "Bad value for -layout, shoutl be one of horizontal, vertical, list"
		unless $new =~ /^(horizontal|vertical|list)$/;
	$lmgr->{Configure}{'layout'} = $new;
	$data->{H} = $data->{W} = 1;
	$lmgr->LayoutRequest(2);
    }
    $o;
}

sub subitemConfigure {
    my $lmgr = shift;
    my $index = shift;

    my $data = $lmgr->privateData;
    my $fmt = $data->{'subitemConfigure'};
    my $item = $fmt->[$index] ||= {
	-type => 'Text',
	-display => 1,
	-imageon => undef,
	-imageoff => undef,
	-width => undef,
    };

    return %$item
	unless @_;

    my %args = @_;

    %$item = (%$item, %args);

}

sub headerConfigure {
    my $lmgr = shift;
    my $index = shift;

    my $data = $lmgr->privateData;
    my $hdr = $data->{'headerConfigure'};
    my $item = $hdr->[$index] ||= {
	-type => 'Text',
	-text => '',
	-image => '',
	-columnspan => 1,
	-display => 1,
	-width => undef,
    };

    return %$item
	unless @_;

    my %args = @_;

    %$item = (%$item, %args);
}

my $pad = 2;

sub arrange_list {
    my $lmgr  = shift;
    my $start = shift;
    my $data  = $lmgr->privateData;
    my $items = $data->{'items'};
    my $cols  = $data->{'columns'};

    my $H = $data->{H} ||= 0;

    my $redo = 0;
    my $where = $start;

    for( ; $start < @$items ; $start++) {
	my $item = $items->[$start];
	my @rb = $item->SubItem(0)->bbox;
	my $ry = $rb[1] + int(($rb[3] - $rb[1]) / 2);
	my $i;
	my $subitem;

	for($i = 0 ; $subitem = $item->SubItem($i) ; $i++) {
	    my $column = $cols->[$i] ||= $lmgr->Tag;
	    my @b = $subitem->bbox;
	    my $dx = $pad - int(($subitem->coords)[0]);
	    my $dy = 0;
	    my $h = $b[3] - $b[1] + $pad;

	    $redo = $data->{H} = $H = $h
	        if $h > $H;

	    my $anchor = $column->SubItem('anchor');

	    unless(defined $anchor) {
		$anchor = $column->Component(
				Line => 'anchor',
				-coords => [ $i * 100,0, $i*100,-20]
			  );
		if($i) {
		    $anchor->bind('<B1-Motion>', [
			sub {
			    my($line,$col,$x) = @_;
			    $x = $line->cloth->canvasx($x);
			    my $tx = ($col->SubItem('anchor')->coords)[0];
			    $x = 0 if $x < 0;
			    $col->move($x - $tx,0);
			}, $column, Ev('x') ]
		    );