Source

App::Harmonograph / lib / Wx / Perl / Smart / Frame.pm

use v5.12;
use warnings;
use Wx;
use Wx::Perl::Smart::Sizer;
use Wx::Perl::Smart::Panel;

package Wx::Perl::Smart::Frame;
our $VERSION = '0.20';
use base qw(Wx::Frame);
use Scalar::Util qw(blessed looks_like_number);

my %widget_io = (
	'Wx::ComboBox' =>1, 'Wx::CheckBox' =>1, 
	'Wx::Perl::TextSlider' => 1, 'Wx::Perl::RadioGroup' =>1,
);

sub new {
	my ($class, $label, $mode) = @_; #$parent, $widgets, $border
	my ($self) = $class->SUPER::new(
		undef, -1, $label, [1,1], [-1,-1],
		&Wx::wxCAPTION | &Wx::wxCLOSE_BOX | &Wx::wxFRAME_TOOL_WINDOW | &Wx::wxSYSTEM_MENU #| &Wx::wxRESIZE_BORDER
	);
	$self->SetIcon( Wx::GetWxPerlIcon() );
	$self->{'mode'} = $mode;
	Wx::InitAllImageHandlers();
	$self;
}


sub CreateSubWidgets {
	my ($self) = shift;
	my @widget;
	for my $widget_def (@_){
		next unless ref $widget_def eq 'ARRAY';
		my $widget = $self->CreateSubWidget($widget_def);
		push @widget, $widget if $widget;
	}
	return @widget;
}

sub CreateSubWidget {
	my ($self, $widget_def) = @_;
	return warn ((caller(0))[3].': need an ARRAY ref as parameter') unless ref $widget_def eq 'ARRAY';
	my $widget;
	if ($widget_def->[0] eq '-Button'){
		warn ((caller(0))[3].': @$widget_def is no proper WxButton definition ("label", &callback)'),
			next if ref $widget_def->[1] or ref $widget_def->[2] ne 'CODE';
		$widget = Wx::Button->new($self, -1, $widget_def->[1]);
		Wx::Event::EVT_BUTTON( $widget, $widget, $widget_def->[2] );
	} elsif ($widget_def->[0] eq '-CheckBox'){
		warn ((caller(0))[3].': @$widget_def is no proper Checkbox definition ("label", checked?, &callback)'),
			next if ref $widget_def->[1]
			or not looks_like_number($widget_def->[2])
			or ref $widget_def->[3] ne 'CODE';
		$widget = Wx::CheckBox->new($self, -1, $widget_def->[1]);
		$widget->SetValue($widget_def->[2]);
		Wx::Event::EVT_CHECKBOX( $widget, -1, $widget_def->[3] );
	}
	return $widget if blessed($widget);
}


sub SubscribeWidgets {
	my ($self, $widgets) = @_;
	warn ((caller(0))[3].'needs a hashref as parameter') unless ref $widgets eq 'HASH';
	while (my ($name, $widget) = each %$widgets) {
		warn ((caller(0))[3].": $name is already subscribed"), next if $self->{'subwidget'}{$name};
		$widget = $self->CreateSubWidget($widget) if ref $widget eq 'ARRAY';
		warn ((caller(0))[3].": $widget is not a widget"), next
			unless blessed($widget) and $widget->isa('Wx::Window');
		$self->{'subwidget'}{$name} = $widget;
		$self->{'default_val'}{$name} = $widget->GetValue if $widget_io{ref $widget};
		$widget->Show(0);
	 }
}
sub UnsubscribeWidgets {
	my ($self) = shift;
	for my $name (@_){
		warn ((caller(0))[3].": no widget subscribed as $name") unless exists $self->{'subwidget'}{$name};
		$self->{'subwidget'}{$name} = '';
		$self->{'default_val'}{$name} = '';
	}
}
sub GetSubscribedWidget {
	my ($self) = shift;
	my @widget;
	for my $name (@_){
		warn ((caller(0))[3].": there is no widget subscribed as $name") unless exists $self->{'subwidget'}{$name};
		push @widget, $self->{'subwidget'}{$name};
	}
	return $widget[0] if scalar @widget == 1;
	return @widget;
}
sub w { shift->GetSubscribedWidget(@_) }
#sub WidgetSubscribed {shift->{'subwidget'}{shift;}}


sub GetValues {
	my ($self) = shift;
	my %value;
	$value{$_} = $self->{'subwidget'}{$_}->GetValue() for keys %{$self->{'default_val'}};
	return \%value;
}
sub SetValues {
	my ($self, $value) = @_;
	return warn ((caller(0))[3].': need a Hashref a parameter') unless ref $value eq 'HASH';
	while (my ($name, $value) = each %$value) {
		warn ((caller(0))[3].": $name is not a subscribed widget"), next
			unless exists $self->{'default_val'}{$name};
		$self->{'subwidget'}{$name}->SetValue(  $value );
	}
	$self;
}
sub ResetValues { shift->ResetValue }     # for naming consistency
sub ResetValue {
	my ($self) = shift;
	my $which = shift // 'all';
	return warn ((caller(0))[3].": $which is not a subscribed widget")
		unless exists $self->{'default_val'}{$which} or $which eq 'all';
	if ($which eq 'all'){
		$self->{'subwidget'}{$_}->SetValue( $self->{'default_val'}{$_} )
			for keys %{ $self->{'default_val'} };
	} 
	else { $self->{'subwidget'}{$which}->SetValue( $self->{'default_val'}{$which} ) }
	$self;
}


sub SetSmartLayout {
	my ($self) = shift;
	$self->SetSizerAndFit( 
		Wx::Perl::Smart::Sizer->new($self, [ 
			Wx::Perl::Smart::Panel->new( $self, [ @_ ] ) 
		])
	);
	$self->Center();
	$self->Show(1);
	$self;

}

1;