view release on metacpan or  search on metacpan

lib/Parse/Vipar.pm  view on Meta::CPAN

    $view->{left_f} = $view->{main_f}->Frame()
        ->pack(-side => LEFT, -fill => 'both', -expand => 1);
    $view->{state_f} = $view->{left_f}->Frame()
        ->pack(-side => TOP, -fill => 'x');
    $view->{graph_f} = $view->{left_f}->Frame()
        ->pack(-side => TOP, -fill => 'both', -expand => 1);

    # Middle pane
    $view->{ministates_f} = $view->{main_f}->Frame()
        ->pack(-side => LEFT, -fill => 'y');

    # Right pane
    $view->{right_f} = $view->{main_f}->Frame()
	->pack(-fill => 'y', -expand => 1);
    $view->{rules_f} = $view->{right_f}->Frame()
        ->pack(-side => TOP, -fill => 'both', -expand => 1);
    $view->{symbols_f} = $view->{right_f}->Frame()
        ->pack(-side => TOP, -fill => 'both', -expand => 1);
    
    $self->layout_menubar($view);
    $self->layout_statusline($view);

    for my $child (@{ $self->{view_children} }) {
	$child->layout_view($view);
    }

    return $view;
}

sub layout_step_window {
    my $self = shift;
    my ($win) = @_;
    
    my $info = $win->{info} = {};

    # Set up the overall layout
    $info->{topline_f} = $win->Frame()
        ->pack(-side => TOP, -fill => 'x');
    $info->{parse_f} = $win->Frame()
        ->pack(-side => LEFT, -fill => 'y');
    $info->{shell_f} = $win->Frame()
        ->pack(-side => RIGHT, -fill => 'y');

    for my $child (@{ $self->{step_children} }) {
	$child->layout($info, $win);
    }

    return $info;
}

sub layout_menubar {
    my $self = shift;
    my ($view) = @_;

    $view->{topline_m} = $view->{topline_f}->Menubutton(-text => "Pulldown")
      ->pack(-anchor => 'w', -fill => 'x');

    return $view;
}

sub popup_debug_window {
    my $top = Toplevel->new();
    $top->Entry()->pack();
}

sub layout_statusline {
    my $self = shift;
    my ($view) = @_;

    $view->{statusline_l} = $view->{statusline_f}->Label(-text => "Status Line")
      ->pack();

    return $view;
}

sub status {
    my $self = shift;
    $self->{view}->{statusline_l}->configure(-text => shift());
}

################ CONTROLS ######################

######## GENERAL ###########

sub bind_symbol {
    my ($self, $t, $tag, $symbol) = @_;

    $t->tagBind($tag, "<Any-Enter>",
		sub { $self->view_symbols($symbol); });
    $t->tagBind($tag, "<Any-Leave>", sub { });
    $t->tagBind($tag, "<Button-1>",
		sub { $self->select_symbols($symbol); });
    $t->tagBind($tag, "<Double-Button-1>",
		sub { $self->restrict_symbols($symbol) });
}

sub bind_object {
    my ($self, $obj, $t, $tag, $id) = @_;

    $t->tagBind($tag, "<Any-Enter>",
		sub { $obj->view($id); });
    $t->tagBind($tag, "<Any-Leave>", sub { });
    $t->tagBind($tag, "<Button-1>",
		sub { $obj->select($id); });
    $t->tagBind($tag, "<Double-Button-1>",
		sub { $obj->restrict($id) });
}

######## SYMBOLS #########

sub view_symbols {
    my $self = shift;
    my (@symbols) = @_;
    my $view = $self->{view};

    $self->{rules}->view_symbols(@symbols);
    $self->{symbols}->view(@symbols);
    $self->{ministates}->view_symbols(@symbols);
}

sub select_symbols {