Source

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

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

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::TextCtrl' =>1, 'Wx::StyledTextCtrl' =>1, 
	'Wx::Perl::DisplaySlider' => 1, 'Wx::Perl::RadioGroup' =>1,
);

sub new {
	my ($class, $label, $mode) = @_; #$parent, $widgets, $border
	$mode = '' unless defined $mode;
	my $style = &Wx::wxDEFAULT_FRAME_STYLE;
	$style = $style ^ &Wx::wxRESIZE_BORDER unless $mode eq 'resize';

	my ($self) = $class->SUPER::new( undef, -1, $label, [1,1], [-1,-1], $style );
	Wx::InitAllImageHandlers();
	$self->SetIcon( Wx::GetWxPerlIcon() );
	$self->{'mode'} = $mode;
	$self->{'factory'} = Wx::Perl::Smart::WidgetFactory->new($self);
	$self;
}
sub SetSmartLayout {
	my ($self) = shift;
	my $sizer = Wx::BoxSizer->new( &Wx::wxVERTICAL );
	$sizer-> Add( Wx::Perl::Smart::Panel->new( $self, [ @_ ] ), 0 );
	$self->SetSizerAndFit ($sizer);
	$self->Center();
	$self->Show(1);
	$self;
}




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->{'managed'}{'widget'}{$name};
		warn ((caller(0))[3].": $widget is not a widget"), next unless is_widget($widget) or ref $widget eq 'ARRAY';

		if (ref $widget eq 'ARRAY'){ $self->{'managed'}{'widget_def'}{$name} = $widget }
		else                       { $self->_SubscribeWidget($widget, $name) }
	 }
}
sub _SubscribeWidget {
	my ($self, $widget, $name) = @_;
	$self->{'managed'}{'widget'}{$name} = $widget;
	$self->{'managed'}{'default_val'}{$name} = $widget->GetValue if $widget_io{ref $widget};
	$widget->Reparent($self);
	$widget->Show(0);
}
sub UnsubscribeWidgets {
	my ($self) = shift;
	for my $name (@_){
		warn ((caller(0))[3].": no widget subscribed as $name")
			unless exists $self->{'managed'}{'widget'}{$name}
			    or exists $self->{'managed'}{'widget_ref'}{$name};
		delete $self->{'managed'}{'widget'}{$name};
		delete $self->{'managed'}{'widget_def'}{$name};
		delete $self->{'managed'}{'default_val'}{$name};
	}
}
sub GetSubscribedWidget {
	my ($self) = shift;
	my @widget;
	for my $name (@_){
		warn ((caller(0))[3].": there is no widget subscribed as $name"), next
			unless exists $self->{'managed'}{'widget'}{$name}
			    or exists $self->{'managed'}{'widget_def'}{$name};

		$self->{'managed'}{'widget'}{$name} = $self->{'factory'}->Make(
			$self->{'managed'}{'widget_def'}{$name}
		) if not exists $self->{'managed'}{'widget'}{$name};
		push @widget, $self->{'managed'}{'widget'}{$name};
	}
	return $widget[0] if scalar @widget == 1;
	return @widget;
}
sub IsWidgetSubscribed {
	my ($self, $widget_wanted) = @_;
	while (my ($name, $widget) = each %{$self->{'managed'}{'widget'}}) {
		return $name if $widget eq $widget_wanted;
	}
	return 0;
}


sub SubscribeStrings {
	my ($self, $string) = @_;
	warn ((caller(0))[3].': needs a HASH ref as parameter') unless ref $string eq 'HASH';
	while (my ($name, $value) = each %$string) {
		$self->{'managed'}{'string'}{$name} = $value;
	}
	$self;
}
sub EvalSubscribedStrings {
	my ($self, $string) = @_;
	return $string if ref $string or not $string;
	$string =~ s/(~\w+)/$self->{'managed'}{'string'}{substr($1, 1)}/ while index ($string, '~') > -1;
	return $string;
}



sub GetValues {
	my ($self) = shift;
	my %value;
	$value{$_} = $self->{'managed'}{'widget'}{$_}->GetValue() for keys %{$self->{'managed'}{'default_val'}};
	return \%value;
}
sub SetValues {
	my ($self, $value) = @_;
	$value = {$value, @_} if scalar(@_) % 2 == 1 and ref $value ne 'HASH';
	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->{'managed'}{'default_val'}{$name};
		$self->{'managed'}{'widget'}{$name}->SetValue(  $value );
	}
	$self;
}
sub ResetValues { $_[0]->ResetValue }     # for naming consistency
sub ResetValue {
	my ($self) = shift;
	my ($name) = shift // ':all';   # value name
	return warn ((caller(0))[3].": $name is not a subscribed widget")
		unless exists $self->{'managed'}{'default_val'}{$name} or $name eq ':all';
	if ($name eq ':all'){
		$self->{'managed'}{'widget'}{$_}->SetValue( $self->{'managed'}{'default_val'}{$_} )
			for keys %{ $self->{'managed'}{'default_val'} };
	} 
	else { $self->{'managed'}{'widget'}{$name}->SetValue( $self->{'managed'}{'default_val'}{$name} ) }
	$self;
}


sub widget_admin {
	my ($widget) = shift;
	return warn ((caller(0))[3].": need a WxWwidget") unless is_widget($widget);
	while ($widget->GetParent){
		$widget = $widget->GetParent;
		return $widget if ref $widget eq __PACKAGE__;
	}
}

sub is_widget { 1 if blessed($_[0]) and $_[0]->isa('Wx::Window') }

1;