view release on metacpan or  search on metacpan

demos/demos/widtrib/all.pl  view on Meta::CPAN

		  }, scrolled => 'oe'},
		 {class => 'ObjEditor', w_args => [@txt_geom, -caller => { dummy => 'object'}]},
		 {class => 'ObjScanner', w_args => [@txt_geom, -caller => $TOP]},
		 {class => 'PodText', require => 'Tk::Pod::Text',
		  w_args => [@txt_geom, -file => 'Tk']},
		 {class => 'XMLViewer', w_args => [@txt_geom], action => sub {
		      shift->insertXML(-text => "<?xml version='1.0' ?><a><bla /><foo>bar</foo></a>");
		  }, scrolled => 'oe'},
		 {class => 'Zinc', w_args => [@px_geom],
		  action => sub {
		      my($w) = @_;
		      my @colors = qw(red green blue orange black white);
		      for (1..20) {
			  $w->add('curve', 1, [map { (rand($px_w),rand($px_h)) } (1..5)],
				  -relief => 'roundgroove',
				  -filled => 1,
				  -fillcolor => $colors[rand @colors],
				 );
		      }
		  },
		 },
		);
    $f->grid('columnconfigure', $_, -pad => 3, -weight => 1) for (0 .. 1);
    $f->grid('rowconfigure', $_, -pad => 3, -weight => 1) for (0 .. $#w_def);
    my $row = -1;
    for my $w_def (@w_def) {
	my($separator, $text, $class, @w_args, $action, $scrolled, $dialog, $dialog_action);
	if (UNIVERSAL::isa($w_def, "HASH")) {
	    $separator = $w_def->{separator};
	    if (!$separator) {
		$class    = $w_def->{class};
		$text     = $w_def->{text} || $class;
		@w_args   = @{ $w_def->{w_args} || [] };
		$action   = $w_def->{action};
		$scrolled = $w_def->{scrolled};
		$dialog   = $w_def->{dialog};
		$dialog_action = $w_def->{dialog_action};
		if ($dialog && !$dialog_action) {
		    $dialog_action = sub { shift->Show };
		}
		if ($w_def->{require}) {
		    eval 'require ' . $w_def->{require};
		    if ($@) {
			warn $@;
			next;
		    }
		}
	    }
	} else {
	    ($text, $class) = ($w_def, $w_def);
	}

	$row++;

	if ($separator) {
	    $f->Label(-text => $separator,
		      -font => 'Helvetica 18',
		      -pady => 5,
		     )->grid(-row => $row,
			     -column => 0,
			     -columnspan => 3,
			    );
	    next;
	}

	my $bgcolor = $row%2==0 ? '#c0c0c0' : '#a0a0a0';
	my $ff = $f->Frame(-background => $bgcolor,
			   )->grid(-row => $row,
				   -column => 1,
				   -sticky => 'news',
				  );
	my $cw = eval {
	    if ($dialog) {
		$ff->$class(@w_args)->destroy; # just load it...
		$ff->Button(-text => 'Open ' . $class,
			    -command => sub {
				# There are some buggy dialogs which display
				# already without calling a Show method (e.g. Tk::FBox),
				# so create here
				my $d = $ff->$class(@w_args);
				$dialog_action->($d) if $dialog_action;
			    })->pack;
	    } else {
		if ($scrolled) {
		    $ff->Scrolled($class, @w_args, -scrollbars => $scrolled)->pack;
		} else {
		    $ff->$class(@w_args)->pack;
		}
	    }
	};
	if ($@ || !$cw) {
	    warn $@;
	    $row--;
	    $ff->destroy;
	    next;
	}

	$action->($cw) if $action && !$dialog;

	$f->Label(-text => $text,
		  -background => $bgcolor,
		  -anchor => 'w',
		 )->grid(-row => $row,
			 -column => 0,
			 -sticky => "news",
			);

	$f->Button(-text => 'Pod',
		   -background => $bgcolor,
		   -command => sub {
		       require Tk::Pod;
		       $TOP->Pod(-file => 'Tk::' . $class);
		   },
		  )->grid(-row => $row,
			  -column => 2,
			  -sticky => 'news',
			 );
    }
    # $TOP->WidgetDump;
}