view release on metacpan or  search on metacpan

lib/PDL/Graphics/Prima.pm  view on Meta::CPAN

# PDL
use PDL::Lite;
use PDL::NiceSlice;
use PDL::Drawing::Prima;

# library-specific modules whose functionality I need
use PDL::Graphics::Prima::Axis;
use PDL::Graphics::Prima::DataSet;

# Next: use block-comments to describe the purpose of each method.

######################################
# Usage        : ????
# Purpose      : ????
# Arguments    : ????
# Returns      : ????
# Side Effects : none
# Throws       : no exceptions
# Comments     : none
# See Also     : n/a

######################################
# Usage        : Not used directly; this is invoked by Prima's inherited
#              : constructor.
# Purpose      : Sets up a default profile for a graph widget
# Arguments    : The (completely uninitialized) object
# Returns      : a hashref
# Side Effects : none
# Throws       : never
# Comments     : none
# See Also     : init

sub profile_default {
	my %def = %{$_[ 0]-> SUPER::profile_default};

	return {
		%def,
		# default properties follow
		
		# Title basics
		title => '',
		titleSpace => '1line',
		titleFont => { height => '10%height' },
		
		backColor => cl::White,
		
		# default color map
		color_map => pal::BlackToWhite,
		
		# replot duration in milliseconds
		replotDuration => 30,
		# Blank profiles for the axes:
		x => {},
		y => {},
		
		# Other important and basic settings
		selectable => 1,
		buffered => 1,

		popupItems => default_popup_items(),
	};
}

sub default_popup_items
{[
	['~Copy'           => 'copy_to_clipboard'     ],
	['P~rint'          => 'print'                 ],
	['~Export to'      => [
		[ '~Image'         => 'save_to_image' ],
		[ '~Postscript'    => 'save_to_ps'    ],
		[ '~EPS'           => 'save_to_eps'   ],
		[ 'P~DF'           => 'save_to_pdf'   ],
	]],
	['~Autoscale'      => 'autoscale'             ],
	['~Properties'     => 'set_properties_dialog' ]
]}


######################################
# Usage        : Not used directly; this is invoked by Prima's inherited
#              : constructor.
# Purpose      : Initializes self's data from the profile.
# Arguments    : $self, as yet uninitialized
#              : a list of key => value pairs corresponding to the list of
#              : arguments provided to the constructor, merged with the default
#              : profile.
# Returns      : A list of key => value pairs suitable for a profile hash.
# Side Effects : none
# Throws       : if unable to initialize the x/y axes from their associated
#              : constructor hashrefs
# Comments     : This has a lot of logic for setting defaults. It might not be
#              : a bad idea to refactor some of this out, so that a Plot widget
#              : can be reset to a default state.
# See Also     : profile_default

sub init {
	my $self = shift;
	my %profile = $self->SUPER::init(@_);
	
	# Set the title properties
	$self->_title($profile{title});
	$self->_titleSpace($profile{titleSpace});
	$self->_titleFont(%{$profile{titleFont}});
	
	# Set the default save-as data
	$self->default_save_dir($profile{default_save_dir});
	$self->default_save_format($profile{default_save_format});
	
	# Create the x- and y-axis objects, overriding the owner and axis name
	# properties if they are set in the profile.
	for ('x', 'y') {
		if (eval{$profile{$_}->isa('PDL::Graphics::Prima::Axis')}) {
			$self->{$_} = $profile{$_};
			$self->{$_}->owner($self);
			$self->{$_}->name($_);
		}
		elsif (ref ($profile{$_}) eq 'HASH') {
			$self->{$_} = PDL::Graphics::Prima::Axis->create(
				%{$profile{$_}}
				, owner => $self
				, name => $_
			);
		}
		elsif (not ref($profile{$_})) {

lib/PDL/Graphics/Prima.pm  view on Meta::CPAN

			my $new_max = $self->x->relatives_to_reals(1 - $dx);
			
			$self->x->minmax($new_min, $new_max);
		}
		# If the initial click was within the y-boundaries, then the y-values
		# should be adjusted:
		if ($y_down_rel > 0 and $y_down_rel < 1) {
			# Determine the relative change and the adjusted min/max:
			my $dy = $y_stop_rel - $y_start_rel;
			my $new_min = $self->y->relatives_to_reals(-$dy);
			my $new_max = $self->y->relatives_to_reals(1 - $dy);
			
			$self->y->minmax($new_min, $new_max);
		}
	}
	
	# Repaint if they're dragging the mouse
	$self->notify('Replot') if $drag_button;

	# Store the intermediate locations:
	$self->{mouse_move_rel} = [$x_stop_rel, $y_stop_rel];
}

sub on_mouseup {
	return unless $_[0]->enabled;
	my ($self, $up_button, $up_mods, $x_stop_pixel, $y_stop_pixel) = @_;
	
	# Remove the previous button record for left and middle buttons:
	if ($up_button & mb::Left) {
		delete $self->{mouse_down_rel}->{mb::Left};
	}
	elsif ($up_button & mb::Middle) {
		delete $self->{mouse_down_rel}->{mb::Middle};
	}
	elsif ($up_button & mb::Right and defined $self->{mouse_down_rel}->{mb::Right}) {
		# Zoom in to the requested rectangle:
		my ($x_start_rel, $y_start_rel) = @{$self->{mouse_down_rel}->{mb::Right}};
		my $x_stop_rel = $self->x->pixels_to_relatives($x_stop_pixel);
		my $y_stop_rel = $self->y->pixels_to_relatives($y_stop_pixel);
		
		# Only rescale if there is a legitimate x- and y- box:
		if ($x_stop_rel != $x_start_rel and $y_stop_rel != $y_start_rel) {
			# Reset the x min/max
			my ($min_rel, $max_rel) = get_min_max_for($x_start_rel, $x_stop_rel);
			# Compute the new min/max values from the axis scaling:
			my $min_real = $self->x->relatives_to_reals($min_rel);
			my $max_real = $self->x->relatives_to_reals($max_rel);
			# Set the new min/max values:
			$self->x->minmax($min_real, $max_real);

			# Reset the y min/max
			($min_rel, $max_rel) = get_min_max_for($y_start_rel, $y_stop_rel);
			# Compute the new min/max values from the axis scaling:
			$min_real = $self->y->relatives_to_reals($min_rel);
			$max_real = $self->y->relatives_to_reals($max_rel);
			# Set the new min/max values:
			$self->y->minmax($min_real, $max_real);
			$self->clear_event;
		}
		elsif ($x_stop_rel == $x_start_rel and $y_stop_rel == $y_start_rel) {
			# Call the popup menu if it 'looks' like a right-click
			# by not clearing the event
		} else {
			$self->clear_event;
		}
		# Remove the previous button record, so a zoom rectangle is not drawn:
		delete $self->{mouse_down_rel}->{mb::Right};
	}
}

sub autoscale
{
	my $self = shift;
	$self->x->minmax(lm::Auto, lm::Auto);
	$self->y->minmax(lm::Auto, lm::Auto);
}

use Scalar::Util qw(looks_like_number);

sub insert_minmax_input {
	my ($group_box, $method, $axis, $y_pos) = @_;
	$group_box->insert(Label =>
		place => { x => 45, y => $y_pos, height => 25, width => 60, anchor => 'sw', pad => 10 },
		height => 30,
		text => ucfirst($method) . ':',
	);
	# the widgets we are about to add
	my ($auto_button, $inline);
	# lexical state variable to bypass updates if the input line triggered
	# the update
	my $update_inline = 1;
	# initial value and autoscaling state of the axis
	my ($init_val, $is_auto) = $axis->$method;
	
	# Attach an event listener to the axis min/max methods to keep is_auto
	# up-to-date, and ensure that the input line is accurate
	$axis->add_notification(ChangeBounds => sub {
		# get the new min or max
		(my $curr_val, $is_auto) = $axis->$method;
		
		$inline->text($curr_val . ($is_auto ? ' (Auto)' : ''))
			if $update_inline;
		$auto_button->enabled(!$is_auto);
	});
	
	no PDL::NiceSlice;
	my $val_is_good = $method eq 'min'	? sub { $_[0] < $axis->max }
										: sub { $_[0] > $axis->min };
	$inline = $group_box->insert(InputLine =>
		place => { x => 110, y => $y_pos, height => 30, width => 280, anchor => 'sw' },
		height => 30,
		text => ($is_auto ? "$init_val (Auto)" : $init_val),
		backColor => cl::White,
		onEnter => sub {
			if ($is_auto) {
				$_[0]->text(scalar($axis->$method));
			}
		},
		onLeave => sub {
			if ($is_auto) {
				my $value = $axis->$method;