view release on metacpan or  search on metacpan

lib/Acme/Gtk2/Ex/Builder.pm  view on Meta::CPAN

sub find {
    my $self   = shift;
    my $id     = shift;
    my $widget = shift;
 
    if ($widget) {
        $self->{_widget}{$id} = $widget;
    }
 
    return $self->{_widget}{$id};
}
 
sub _current {
    my $self = shift;
    my $up   = shift || 0;
    $self->{_current}[-1 - $up];
}
 
sub _current_push {
    my $self   = shift;
    my $widget = shift;
    push @{ $self->{_current} }, $widget;
}
 
sub _current_pop {
    my $self = shift;
    pop @{ $self->{_current} };
}
 
sub contain (&) { @_ }
 
sub build (&) {
    my $code = shift;
 
    my $self = bless {
        _info    => {},
        _widget  => {},
        _current => [],
    }, __PACKAGE__;
 
    no strict 'subs';
    no warnings 'redefine';
 
    local *_widget = sub ($&) {
        my $class  = shift;
        my $_code  = shift;
        my @params = @_;
 
        my $widget;
        if (ref($class) && $class->isa("Gtk2::Widget")) {
            $widget = $class;
        }
        else {
            $widget = "Gtk2::$class"->new(@params);
        }
 
        if ($self->_current && ref($self->_current) ne __PACKAGE__) {
            given (ref $self->_current) {
                when (/Gtk2::VBox|Gtk2::HBox/) {
                    $self->_current->pack_start($widget, 0, 0, 1);
                }
                default {
                    $self->_current->add($widget);
                }
            };
        }
 
        $self->_current_push( $widget );
 
        local *_info = sub {
            my $key    = shift;
            my @values = @_;
 
            given ($key) {
                when ('id') {
                    $self->find($values[0], $self->_current);
                }
                when ('packing') {
                    given (ref $self->_current(1)) {
                        when (/Gtk2::VBox|Gtk2::HBox/) {
                            $self->_current(1)->set_child_packing($self->_current, @values);
                        }
                    }
                }
                default {
                }
            }
            $self->{_info}{$self->_current}{$key} = \@values;
        };
 
        local *_on = sub {
            my $signal = shift;
            my $_code  = shift;
            my $data   = shift;
 
            if ($self->_current) {
                $self->_current->signal_connect( $signal => $_code, $data );
            }
        };
 
        local *_set = sub {
            my $attr = shift;
            my @para = @_;
 
            my $method = "set_$attr";
            if ($self->_current) {
                $self->_current->$method(@para);
            }
        };

        local *_prop = sub {
            my $prop  = shift;
            my $value = shift;
 
            my $method = "set";
            if ($self->_current) {
                $self->_current->$method($prop, $value);
            }
        };
 

lib/Acme/Gtk2/Ex/Builder.pm  view on Meta::CPAN

If you have to use more parameters for constructor,
then specify additional parameters after the C<widget> block.
Following code create L<Gtk2::SimpleList> with
additional C<timestamp>, C<nick> and C<message> parameter.
See L<Gtk2> and Gtk2 API reference.

    use Gtk2;
    use Gtk2::SimpleList; # Do NOT forgot!!
    
    my $app = build {
        widget SimpleList => contain {
            info id              => 'logviewer';
            set  headers_visible => FALSE;
            set  rules_hint      => TRUE;
        }, (
            timestamp => 'markup',
            nick      => 'markup',
            message   => 'markup',
        );
    };

It also supports prebuilt widget.

    my $prev_button = Gtk2::Button->new('Prev');
    my $next_button = Gtk2::Button->new('Next');
    my $quit_button = Gtk2::Button->new;
    
    my $app = build {
        widget VBox => contain {
            widget HBox => contain {
                widget $prev_button;
                widget $next_button;
            };
            widget $next_button => contain {
                info packing => TRUE, TRUE, 1, 'end';
                set  label   => 'quit';
                on   clicked => \&quit_clicked;
            }
        };
    };

=head2 info

This function sets additional information.
Since it is not realted to Gtk2 functions,
attributes, signal and properties,
so save anything what you want or need.

Currently C<id> and C<packing> have some special meanings.
C<id> is used for C<widget> method to find widget.
C<packing> is used for L<Gtk2::VBox> and L<Gtk2::HBox>.

    my $app = build {
        widget Window => contain {
            info id             => 'window';
            set  title          => 'Seoul.pm irc log viewer';
        };
    
        widget HBox => contain {
            info id      => 'hbox';
            info packing => TRUE, TRUE, 1, 'start';
    
            widget ScrolledWindow => contain {
                set policy => 'never', 'automatic';
            };
        };
    };

=head2 on

This function connects signals for specified widget.
Actually it is same as C<< $widget->signal_connect >>.
See L<Gtk2> and Gtk2 API reference.

    my $app = build {
        widget Window => contain {
            on   delete_event => sub { Gtk2->main_quit };
            widget VBox => contain {
                widget ToggleButton => contain {
                    set  label   => "show/hide";
                    on   toggled => \&toggled;
                };
                widget Button => contain {
                    set  label   => 'Quit';
                    on   clicked => sub { Gtk2->main_quit };
                };
            };
        };
    };

=head2 set

This function calls C<< $widget->set_KEY(VALUE) >> function
for specified widget.
See L<Gtk2> and Gtk2 API reference.

    my $app = build {
        widget Window => contain {
            set  title        => 'Awesome App';
            set  default_size => 200, 100;
            set  position     => 'center';
        };
    };

=head2 prop

This function sets properties for specified widget.
Actually it is same as C<< $widget->set(KEY, VALUE) >>.
See L<Gtk2> and Gtk2 API reference.

    my $app = build {
        widget Window => contain {
            info id               => 'window';
            set  position         => 'center';
            prop title            => 'Window Example';
            prop opacity          => 0.8;
            prop 'default-width'  => 640;
            prop 'default-height' => 480;
            on   delete_event     => \&quit;
        };
    };