Source

Kephra / lib / Kephra / App / Helper.pm

use strict;
use warnings;

package Kephra::App::Helper;

sub get {
    my ($ref, @method_ref);
    die unless @_;
    for my $subname (@_){
        eval { $ref = \&{__PACKAGE__ . "::$subname"} };
        if ($@) { die "__PACKAGE__::get : no $subname sub in this Module." }
        else    { push @method_ref, $ref }
    }
    if (wantarray){ return @method_ref }
    else          { return $method_ref[0] }
}

sub is_a_widget {
    return 0 unless $_[0]
             and substr( ref $_[0], 0, 4 ) eq 'Wx::';
             and $_[0]->isa('Wx::Control');
    return 1;
}

sub put_on_panel {
    my $widget = shift;
    return 0 unless is_a_widget($widget);
    my $sizer = Wx::BoxSizer->new(&Wx::wxVERTICAL);;
    $sizer->Add( $widget, 1, &Wx::wxGROW );
    my $panel = Wx::Panel->new( $this );
    $panel->SetSizer( $sizer );
    return $panel;
}

sub is_a_color {
    return 0 unless $_[0]
             and substr( ref $_[0], 0, 4 ) eq 'Wx::';
             and $_[0]->isa('Wx::Colour');
    return 1;
}

sub make_color_object {
    my ($r,$g,$b) = @_;
    unless (defined $g){
        # handle hex format like in HTML: #234567
        $r = substr $r, 1 if length $r == 7;
        if ( $r =~ /^([0-9a-f]{2})([0-9a-f]{2})([0-9a-f]{2})$/i ) {
            ($r,$g,$b) = ( hex $1, hex $2, hex $3 );
        }
        # handle comma-seperated format
        if ( $r =~ /^(\d+),(\d+),(\d+)$/ ) {
            ($r,$g,$b) = ( $1+0, $2+0, $3+0 );
        }
    }
    return unless defined $b;
    return unless int $r == $r && $r>=0 && $r<=255;
    return unless int $g == $g && $g>=0 && $g<=255;
    return unless int $b == $b && $b>=0 && $b<=255;
    Wx::Colour->new($r, $g, $b);
}

1;