Tk-Taxis

 view release on metacpan or  search on metacpan

eg/woodlice.pl  view on Meta::CPAN

#!/usr/bin/perl 

# woodlice.pl v2.03

use strict;
use warnings;

if ( $ARGV[0] && $ARGV[0] =~ /^-{1,2}(h|help|\?)$/i )
{
	system ( "perldoc", $0 ) and die "For usage, use perldoc $0\n";
	exit( 0 );
}

use Tk qw( DONT_WAIT DoOneEvent );
use Tk::Taxis;
use Time::HiRes;

############################### global state ###################################

my $running           = 0;       # is the simulation running?
my $counter           = 0;       # seconds since simulation was started
my $paused            = 0;       # is the simulation paused?
my $dry               = 0;       # dry/damp mode on?
my $light             = 1;       # light/dark mode on?
my $supress_refresh   = 1;       # when we start up the we don't refresh
my $mode              = 'light'; # default mode

my %mode = 
(
	none                    =>
	{
		fill =>
		[
			[ '#7DDE4D', '#7DDE4D' ],
			[ '#7DDE4D', '#7DDE4D' ],
		],
		prefs => [ 1, 1 ],
	},	
	dry                     => 
	{
		fill =>
		[
			[ '#C1B24E', '#C1B24E' ],
			[ '#7695EF', '#7695EF' ],
		],
		prefs => [ 1, 7 ],
	},
	light                   => 
	{
		fill =>
		[
			[ 'white', 'gray' ],
			[ 'white', 'gray' ],
		],
		prefs => [ 1000, 1 ],
	},
	both                    =>
	{
		fill =>
		[
			[ '#F6D388', '#705824' ],
			[ '#B7C8DB', '#215187' ],
		],		
		prefs => [ 1000, 7 ],
	}
);

################################# defaults #####################################

my $population   = 20;
my $critters     = 'woodlice';
my $vert         = 500;
my $horiz        = 500;
my $speed        = 0.006;
my $refresh      = 20;         # milliseconds between refreshes

################################ gui settings ##################################

my $background   = 'gray';
my $foreground   = '#B65DE9';
my %menu_opt     =
(
	# settings for cascaded menu items
	-font        => 'sserife 8',
);
my %label_opt    = 
(
	# options for text labels
	-font        => 'sserif 14', 
	-width       => 12, 
	-borderwidth => 2, 
	-relief      => 'groove',
);
my %pad_opt      =
(
	# padding for generic pack and grid
	-padx        => 5, 
	-pady        => 5, 
);
my %wide_pad_opt      =
(
	# padding for wider label pack and grid
	-padx        => 15, 
	-pady        => 5, 
);
my %frame_opt    = 
(
	# settings for frames around widgets
	-relief      => 'groove', 
	-borderwidth => 2, 
	-background  => $background,
);

########################### command line options ###############################

use Getopt::Long;
GetOptions
(
	"foreground=s" => \$foreground,
	"background=s" => \$background,
	"vert=i"       => \$vert,
	"horiz=i"      => \$horiz,
	"image=s"      => \$critters,
	"refresh=i"    => \$refresh,

eg/woodlice.pl  view on Meta::CPAN

			my $option_menu = $simulate->command
			(
				-label     => 'Options',
				-underline => 0,
				-command   => \&options,
				%menu_opt,
			);
		my $help = $menu->cascade
		(
			-label     => 'Help',
			-underline => 0,
			-tearoff   => 0,
		);
			$help->command
			(
				-label     => 'Help',
				-underline => 0,
				-command   => \&help,
				%menu_opt,
			);
			$help->command
			(
				-label     => 'About',
				-underline => 0,
				-command   => \&about,
				%menu_opt,
			);
		$mw->configure( -menu => $menu );

################################## simulation ##################################
	
	my %counters;
	my $main = $mw->Frame( -background => $background )->pack();
		
		$counters{ top_left } = $main->Label
		( 
			%label_opt,
		)
		->grid
		(
			-column   => 0, 
			-row      => 0, 
			%wide_pad_opt,
		);
		
		my $taxis_frame = $main->Frame
		(
			%frame_opt,
		)
		->grid
		(
			-column    => 1,
			-row       => 0,
			-rowspan   => 2,
			%pad_opt,
		);
			my $taxis = $taxis_frame->Taxis
			( 
				-width      => $horiz,
				-height     => $vert,
				-preference => $mode{$mode}{prefs},
				-fill       => $mode{$mode}{fill},
				-population => $population,
				-images     => $critters,
				-speed      => $speed,
			)
			->pack();
		
		$counters{ top_right } = $main->Label
		( 
			%label_opt,
		)
		->grid
		(
			-column   => 2, 
			-row      => 0, 
			%wide_pad_opt,
		);

		$counters{ bottom_left } = $main->Label
		( 
			%label_opt,
		)
		->grid
		(
			-column   => 0, 
			-row      => 1, 
			%wide_pad_opt,
		);

		$counters{ bottom_right } = $main->Label
		( 
			%label_opt,
		)
		->grid
		(
			-column   => 2, 
			-row      => 1, 
			%wide_pad_opt,
		);
		
		my $frame = $main->Frame
		(
			%frame_opt,
		)
		->grid
		(
			-column   => 1, 
			-row      => 2, 
			%wide_pad_opt,
		);
			my $start_button = $frame->Button
			( 
				-text     => "Start",
				-command  => \&start_toggle,
				%label_opt,
			)
			->grid
			(
				-column   => 0, 
				-row      => 0,

eg/woodlice.pl  view on Meta::CPAN

	->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();
							$supress_refresh = 1;
						}
					],
		-width        => 10,
	)->grid
	(
		-column       => 1,
		-row          => 3, 
		%pad_opt,
	);
	my $cancel = $option_box->Button
	( 
		-text         => "Cancel", 
		-font         => "sserif 14",
		-command      => [
						sub
						{
							$option_box->destroy();
						}
					],
		-width        => 10,
					
	)->grid(
		-column       => 2, 
		-row          => 3,
		%pad_opt,
	);
	$option_box->raise();
	$ok->focus();
	$option_box->Tk::bind( '<Alt-F4>' => [ sub { $option_box->destroy() } ] );
	$option_box->Tk::bind( '<Escape>' => [ sub { $option_box->destroy() } ] );
}

################################### toggles ####################################

sub start_toggle
{
	if ( $running )
	{
		$running = 0;
		$paused  = 0;
	}
	else
	{
		$counter = 0;
		$paused  = 0;
		$running = 1;
		if ( $supress_refresh )
		{
			$supress_refresh = 0;
		}
		else
		{
			$taxis->refresh();
		}
		new_log();
	}