view release on metacpan or  search on metacpan

eg/woodlice.pl  view on Meta::CPAN

		$counters{top_right}->configure(    -text => "" );
		$counters{bottom_right}->configure( -text => "" );
	}
	elsif ( $light )
	{
		$counters{top_left}->configure(     -text => "Light : $c{left}" );
		$counters{bottom_left}->configure(  -text => "" );
		$counters{top_right}->configure(    -text => "Dark : $c{right}" );
		$counters{bottom_right}->configure( -text => "" );
	}
	else
	{
		$counters{top_left}->configure(     -text => "$c{top_left}" );
		$counters{bottom_left}->configure(  -text => "$c{bottom_left}" );
		$counters{top_right}->configure(    -text => "$c{top_right}" );
		$counters{bottom_right}->configure( -text => "$c{bottom_right}" );
	}

	while ( Time::HiRes::time < $finish  )
	{ 
		DoOneEvent( DONT_WAIT );
	}
}

################################### options ####################################

sub options
{
	return if $running;
	my %scale_opt =
	(
		-font       => 'sserif 14', 
		-orient     => 'horizontal',
		-background =>  $background,
		-length     => 300,
	);
	my $option_box = $mw->Toplevel
	(
		-background => $background,
		-title      => "Options",
	);
	
	my $population_frame = $option_box->Frame
	(
		%frame_opt,
	);
	my $population_scale = $population_frame->Scale
	(
		-label        => "Population",
		-from         => 0, 
		-to           => 50, 
		-tickinterval => 10,
		%scale_opt,
	)
	->pack();
	$population_scale->set( $population );
	$population_frame->grid
	(	
		-column       => 1, 
		-row          => 1, 
		-columnspan   => 2, 
		%pad_opt,
	);

	my $mode_frame = $option_box->Frame
	(
		%frame_opt,
	)
	->grid
	(	
		-column       => 1, 
		-row          => 2, 
		-columnspan   => 2, 
		%pad_opt,
	);	
	my $light_button  = $mode_frame->Checkbutton
	(
		-text         => "Light/Dark",
		-variable     => \$light,
		-selectcolor  => $background,
		%label_opt,
	)
	->grid
	(
		-column       => 1,
		-row          => 1,
		%pad_opt,		
	);
	my $dry_button    = $mode_frame->Checkbutton
	(
		-text         => "Dry/Damp",
		-variable     => \$dry,
		-selectcolor  => $background,
		%label_opt,
	)
	->grid
	(
		-column       => 2,
		-row          => 1,
		%pad_opt,
	);
	
	my $ok = $option_box->Button
	( 
		-text         => "OK", 
		-font         => "sserif 14",
		-command      => [
						sub
						{
							$population = $population_scale->get();
							$taxis->configure( -population => $population ); 
							if ( $light && $dry )
							{
								$taxis->configure( -fill => $mode{both}{fill} );
								$taxis->configure( -preference => $mode{both}{prefs} );
							}
							elsif ( $dry )
							{
								$taxis->configure( -fill => $mode{dry}{fill} );
								$taxis->configure( -preference => $mode{dry}{prefs} );
							}
							elsif ( $light )
							{
								$taxis->configure( -fill => $mode{light}{fill} );
								$taxis->configure( -preference => $mode{light}{prefs} );
							}
							else
							{
								$taxis->configure( -fill => $mode{none}{fill} );
								$taxis->configure( -preference => $mode{none}{prefs} );
							}							
							$option_box->destroy();
							$taxis->refresh();

eg/woodlice.pl  view on Meta::CPAN

	( 
		-state => $running ? 'disabled' : 'normal',
	);
}

sub pause_toggle
{
	$paused = $paused ? 0 : 1;
	$pause_button->configure
	(
		-text  => $paused ? 'Unpause' : 'Pause',
	);
	$pause_menu->configure
	(
		-label => $paused ? 'Unpause' : 'Pause',
	);	
}

#################################### popups ####################################

sub help
{
	my $help_text = << "THIS";
This software simulates the movement of organisms which work out where to go by 
measuring how dark it is where they are now, and comparing it to the darkness 
they experienced just a moment ago. If they find the conditions have got darker, 
they carry on running in the same direction, otherwise, they take a random 
tumble to a new direction. This makes them perform a biased random walk towards 
the dark. The author doesn't know whether woodlice do this, but they are more 
attractive than bacteria, which certainly do. To start a new simulation, press 
the 'Start' button. To pause it temporarily, press the 'Pause' button.\n
When the simulation is stopped, options can also be set using 'Options' on the 
'Simulate' menu. The population can be varied from 1 to 50 using the slider, 
and the critters' preference can be varied from 0 to +/-100.\n
The simulator can run damp vs. dry, dark vs. light, neither or both at the same
time. These options can be configured from the options menu.\n
A log is kept of the current option settings and the number of critters in the 
four quadrants, every second. This can be saved using 'Save log file' on 
'File' toolbar when the simulation is stopped.\n
Keyboard shortcuts:\n
\tF1\tHelp
\tCtrl-S\tStart/stop
\tCtrl-P\tPause/unpause
\tCtrl-O\tOptions (when stopped)
\tCtrl-L\tSave log file (when stopped)
\tAlt-F4\tExit\n
THIS
	my $help = $mw->Toplevel
	(
		-background   => $background,
		-title        => 'Help',
	);
	my $frame = $help->Frame
	(
		%frame_opt,
	)
	->grid
	(
		-column       => 1, 
		-row          => 1, 
		-columnspan   => 2, 
		%pad_opt,
	);
	my $text = $frame->Label
	(
		-font       => 'sserif 12',
		-text       => $help_text,
		-wraplength => 600,
		-justify    => 'left',
		-background => $background,
	)
	->grid
	(
		-column       => 1,
		-row          => 1, 
		%pad_opt, 
	);
	my $ok = $frame->Button
	( 
		-text         => "OK", 
		-font         => "sserif 14",
		-command      => [ sub { $help->destroy() } ],
		-width        => 10,
	)
	->grid
	(
		-column       => 1,
		-row          => 2, 
		%pad_opt, 
	);
    $help->Tk::bind( '<Alt-F4>' => [ sub { $help->destroy() } ] );
    $help->Tk::bind( '<Escape>' => [ sub { $help->destroy() } ] );
	$help->raise();
	$ok->focus();
}

sub dialog
{
	my ( $dialog_text, $title ) = @_;
	my $dialog = $mw->Toplevel
	(
		-title => $title || 'Dialog',
		-width => 1000,
	);
	my $frame = $dialog->Frame
	(
		%frame_opt,
	);
	$frame->grid
	(
		-column       => 1, 
		-row          => 1, 
		-columnspan   => 2, 
		%pad_opt,
	);
	my $text = $frame->Label
	(
		-width      => 50,
		-font       => 'sserif 12',
		-text       => $dialog_text,
		-wraplength => 400,
		-justify    => 'left',
		-background => $background,
	);
	$text->grid
	(
		-column       => 1,
		-row          => 1, 
		%pad_opt,
	);
	my $ok = $frame->Button
	( 
		-text         => "OK", 
		-font         => "sserif 14",
		-command      => [ sub { $dialog->destroy() } ],
		-width        => 10,
	);
	$ok->grid
	(
		-column       => 1,
		-row          => 2, 
		%pad_opt, 
	);
    $dialog->Tk::bind( '<Alt-F4>'    => [ sub { $dialog->destroy() } ] );
    $dialog->Tk::bind( '<Escape>'    => [ sub { $dialog->destroy() } ] );
	$dialog->raise();
	$ok->focus();
}

sub about
{
	my $about_text = << "THIS";
Woodlouse Simulator (CASE 19) v2.02 © Dr. Cook 2003\n
This is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
THIS
	dialog( $about_text, "About" );
}

################################### logging ####################################

sub save
{	
	my $default = "woodlice$log_number";
	my $save_window = $mw->getSaveFile
	(
		-filetypes        => [ [ 'Log files' => '.log' ] ],
		-initialfile      => $default,
		-defaultextension => '.log',
	);
	if ( defined $save_window )
	{
		local *LOG;
		unless ( open LOG, ">", $save_window )