view release on metacpan or  search on metacpan

tk/tk-itunes.pl  view on Meta::CPAN

	my $actions   = shift;
	
	my $sub = sub { 
		foreach my $action ( @$actions ) 
			{
			print STDERR "Calling $action action\n" if $Verbose > 1;
			eval { $Actions->{$action}->() } if exists $Actions->{$action};
			}  
		};
		
	return $frame->Button(
		-text                => $title,
		-command             => $sub,
		-background          => "#$color",
		-activebackground    => "#$color",
		-activeforeground    => "#FFFFFF",
		)->pack(
			-anchor  => 'w',
			-side    => 'top',
			-fill    => 'both',
			);
		
	}

sub _menubar
	{
	my $mw      = shift;

	$mw->configure( -menu => my $menubar = $mw->Menu );
	my $file_items = [
		[qw( command ~Quit -accelerator Ctrl-q -command ) => $Actions->{quit} ]
		];
	my( $edit_items, $help_items, $play_items, $refresh_items ) = ( [], [], [] );
	foreach my $playlist ( @{ $Actions->{'playlists'}->() } )
		{
		push @$play_items, [ 'command', $playlist, 
			'-command' => sub { $Playlist = $playlist;
				@Tracks = @{ $Actions->{get_tracks}->( $playlist ) } } ];
		}

	$refresh_items = [
		[ 'command', 'Playlists', -command => $Actions->{playlists}  ],
		[ 'command', 'Tracks',    -command => $Actions->{get_tracks} ],
		];
		
	my $file = _menu( $menubar, "~File",     $file_items );
	my $edit = _menu( $menubar, "~Edit",     $edit_items );
	my $play = _menu( $menubar, "~Playlist", $play_items );		
	my $help = _menu( $menubar, "~Refresh",  $refresh_items );
	my $help = _menu( $menubar, "~Help",     $help_items );
	
	return $menubar;
	}
	
sub _menu
	{
	my $menubar = shift;
	my $title   = shift;
	my $items   = shift;
	
	my $menu = $menubar->cascade( 
		-label     => $title, 
		-menuitems => $items,
		-tearoff   => 0,
		 );
		 
	return $menu;
	};

sub _current_label
	{
	my $frame = shift;
	my $value = shift;
	
	my $label = $frame->Label(
		-textvariable => $value,
		-relief       => 'flat',
		-width        => 32,
		)->pack(
			-anchor => 'e',
			-side   => 'top',
			-fill   => 'x',
			);

	return $label;
	}
	
sub _scale
	{
	my $frame = shift;
	my $value = shift;
	
	my $scale = $frame->Scale(
		-sliderlength => 5,
		-length       => 150,
		-from         => 0,
		-to           => 100,
		-orient       => 'horizontal',
		-variable     => $value,
		-showvalue    => 0,
		-relief       => 'flat',
		-state        => 'disabled',
		-takefocus    => 0,
		-width        => 5,
		-troughcolor  => '#FFFFFF',
		-borderwidth  => 1,
		-foreground   => '#000000',
		)->pack(
			-anchor => 'e',
			-side   => 'top',
			-fill   => 'x',
			);
	
	return $scale;
	}
	
sub _track_list_box
	{
	my $frame  = shift;
	
	my $color = $Config->list_color || '00cccc';