Commit f219785d authored by Christian Fibich's avatar Christian Fibich Committed by Stefan Tauner
Browse files

Modified net selection: Can now search using regex in a popup window

parent 1a312de7
......@@ -36,12 +36,15 @@ sub Populate {
sub Show {
my ($self) = @_;
# first set action to perform when the main window is closed to be ignored
if (defined $self->{'mw'} && defined $self->{'delete_mw'}) {
$self->{'mw'}->protocol('WM_DELETE_WINDOW' => sub {
return 1;
});
}
# then show the dialog
my $rv = $self->SUPER::Show();
# and finally reset the original action to be performed when the main window is closed
if (defined $self->{'mw'} && defined $self->{'delete_mw'}) {
$self->{'mw'}->protocol('WM_DELETE_WINDOW' => $self->{'delete_mw'});
}
......
#-------------------------------------------------------------------------------
# University of Applied Sciences Technikum Wien
#
# Department of Embedded Systems
# http://embsys.technikum-wien.at
#
# Josef Ressel Center for Verification of Embedded Computing Systems
# http://vecs.technikum-wien.at
#
#-------------------------------------------------------------------------------
# File: FIJITestsViewer.pm
# Created on: 25.08.2015
# $LastChangedBy: fibich $
# $LastChangedDate: 2015-08-31 17:31:32 +0200 (Mon, 31 Aug 2015) $
#
# Description:
# FIJI Net Selection Widget
#-------------------------------------------------------------------------------
## @file
# @brief Contains class \ref Tk::FIJITestsViewer
## @class Tk::FIJITestsViewer
# @brief Tk Widget allowing to view and edit FIJI::Tests settings
package Tk::FIJINetSelection;
use strict;
use warnings;
use utf8;
use Log::Log4perl qw(get_logger);
use Scalar::Util 'blessed';
use Time::HiRes qw(time);
use Clone qw(clone);
use threads;
use threads::shared;
use FIJI qw(:all);
use Tk;
use Tk::Adjuster;
use Tk::widgets qw(Listbox LabFrame Balloon Label Entry Pane Button Dialog Checkbutton CompleteEntry StatusBar NoteBook);
use Tk::FIJIUtils;
use Tk::FIJIModalDialog;
use base qw(Tk::Frame);
use Data::Dumper;
Construct Tk::Widget 'FIJINetSelection';
sub ClassInit {
my ($class, $mw) = @_;
$class->SUPER::ClassInit($mw);
my $self = bless {}, $class;
return $self;
}
#
# Takes the following parameters at creation:
# -nets A list of net names as strings
# All parameters a Tk::Frame accepts
sub Populate {
my $logger = get_logger("");
my ($self, $args) = @_;
$self->{'nets'} = delete $args->{'-nets'};
$self->SUPER::Populate($args);
$self->_populate_widget($self);
$self->update();
}
sub _populate_widget {
my $self = shift;
my $balloon_widget = $self->Balloon();
my $found_listbox_labframe = $self->LabFrame(-label=>'Matching nets');
my $selected_listbox_labframe = $self->LabFrame(-label=>'Selected net');
$self->{'search_entry'} = $self->Entry();
$self->{'found_listbox'} = $found_listbox_labframe->Listbox(-selectmode=>'single')->pack(-expand=>1,-fill=>'both');
$self->{'selected_listbox'} = $selected_listbox_labframe->Listbox(-selectmode=>'single')->pack(-expand=>1,-fill=>'both');
my $search_button = $self->Button(-text=>'Search', -command => [\&_match_nets, $self]);
my $select_button = $self->Button(-text=>'>');
my $unselect_button = $self->Button(-text=>'<',-state=>'disabled');
$self->{'found_strings'} = [];
$self->{'selected_listbox'}->configure(-listvariable=>$self->{'found_strings'});
# if the select button is pressed:
# - copy the currently selected net name to a new list, and set
# that list as listvariable of the right listbox
# - save the index of the selected element in the list of found nets
$select_button->configure(-command => sub {
return if (@{$self->{'found_netnames'}} == 0);
my $selected_index = $self->{'found_listbox'}->index('active');
$self->{'selected_listbox'}->configure(-listvariable=>[@{$self->{'found_netnames'}}[$selected_index]]);
$self->{'selected'} = $selected_index;
$select_button->configure(-state=>'disabled');
$unselect_button->configure(-state=>'active');
});
# if the unselect button is pressed
# - unset the saved index
# - set the listvariable of the right listbox to an empty list
$unselect_button->configure(-command => sub {
$self->{'selected_listbox'}->configure(-listvariable=>[]);
$select_button->configure(-state=>'active');
$unselect_button->configure(-state=>'disabled');
$self->{'selected'} = undef;
});
# place widgets
$self->{'search_entry'}->grid(-column=>0,-row=>0,-columnspan=>3,-sticky=>'nsew');
$search_button->grid(-column=>3,-row=>0,-sticky=>'nse');
$found_listbox_labframe->grid(-column=>0,-row=>1,-columnspan=>1,-rowspan=>3,-sticky=>'nsew');
$selected_listbox_labframe->grid(-column=>2,-row=>1,-columnspan=>2,-rowspan=>3,-sticky=>'nsew');
$select_button->grid(-column=>1,-row=>1);
$unselect_button->grid(-column=>1,-row=>2);
$self->gridColumnconfigure(0, -weight => 1);
$self->gridColumnconfigure(2, -weight => 1);
$self->gridRowconfigure(3, -weight => 1);
# tooltip
$balloon_widget->attach($self->{'search_entry'},-msg=>'Search for net names. Supports Regular Expressions');
}
sub _match_nets {
my ($self) = @_;
my $regex = $self->{'search_entry'}->get;
# check if regex is valid:
eval {qr/$regex/};
if ($@) {
my $msg = "Error in regular expression:\n$@";
my $d = $self->FIJIModalDialog(-text=>$msg,-wraplength=>200,-title=>'Error')->Show();
return
}
my @filtered_nets = sort(grep {$_ =~ /$regex/} @{$self->{'nets'}});
# save the reference to the new list
$self->{'found_netnames'} = \@filtered_nets;
# set this new reference as data base for the left listbox
$self->{'found_listbox'}->configure(-listvariable=>$self->{'found_netnames'});
}
sub get {
my $self = shift;
my $rv;
if (defined $self->{'found_netnames'} && defined $self->{'selected'}) {
$rv = @{$self->{'found_netnames'}}[$self->{'selected'}]
}
return $rv;
}
1;
\ No newline at end of file
......@@ -34,6 +34,7 @@ use FIJI::Utils;
use Tk;
use Tk::widgets qw(LabFrame Balloon Label Entry Pane Button Dialog DialogBox Checkbutton CompleteEntry NoteBook StatusBar FIJISettingsCanvas);
use Tk::FIJIModalDialog;
use Tk::FIJINetSelection;
use constant RESOURCES_REGS_LOWER => 0.1;
use constant RESOURCES_LUTS_LOWER => 0.1;
......@@ -889,10 +890,12 @@ sub _add_fiu ($$) {
my $llbl = $fr_fiu->Label('-text' => "LFSR Mask",);
# Entry for the net to break apart
my $choices = defined($self->{'nets'}) ? $self->{'nets'} : [];
my $net_entry = $fr_fiu->CompleteEntry(
# my $choices = defined($self->{'nets'}) ? $self->{'nets'} : [];
my $net_entry = $fr_fiu->Entry(
'-textvariable' => \$fiu->{'FIU_NET_NAME'},
'-choices' => $choices,
# '-choices' => $choices,
-takefocus => 0,
-state => "readonly",
);
# read-only driver path
......@@ -916,6 +919,39 @@ sub _add_fiu ($$) {
# '-expand' => 1,
);
# Button to open net selection dialog for the FIU
my $net_button = $fr_fiu->Button(
-text => "Select",
-command => sub {
if (!defined $self->{'nets'}) {
my $msg = "Cannot select net (yet). No netlist loaded.";
$logger->error($msg);
my $d = $self->{'mw'}->FIJIModalDialog(-delete_mw => $self->{'delete_mw'},
-mw => $self->{'mw'},
-image => $alert_image,
-wraplength => $fr_fiu->screenwidth,
-text => "$msg",
-title => "Error",
-buttons => ["OK"]);
$d->Show();
} else {
my $d = $self->DialogBox(-title=>"Select Net for FIU $i", -buttons=>[qw/OK Cancel/],-default_button=>'OK');
my $sel = $d->FIJINetSelection(-nets => $self->{'nets'});
$sel->pack(-expand=>1,-fill=>'both',-padx=>5,-pady=>5);
$d->configure(-command => sub {
my $rv = shift;
if(defined $rv && $rv eq 'OK') {
my $netname = $sel->get();
$fiu->{'FIU_NET_NAME'} = $netname if defined $netname;
}
});
$d->Show();
$self->_check_change();
}
}
);
# Button to open driver dialog for the FIU
my $driver_button = $fr_fiu->Button(
-text => "Select",
......@@ -1004,8 +1040,9 @@ sub _add_fiu ($$) {
#$lbl->grid(-row=>$r,-column=>0,-rowspan=>2,-sticky=>'w');
$nlbl->grid(-row => 0, -column => 1, -padx => 5, -sticky => 'e');
$dlbl->grid(-row => 1, -column => 1, -padx => 5, -sticky => 'e');
$net_entry->grid(-row => 0, -column => 2, -columnspan => 2, -sticky => 'ew');
$net_entry->grid(-row => 0, -column => 2, -sticky => 'ew');
$drv_entry->grid(-row => 1, -column => 2, -sticky => 'ew');
$net_button->grid(-row => 0, -column => 3, -sticky => 'ew');
$driver_button->grid(-row => 1, -column => 3, -sticky => 'ew');
$mlbl->grid(-row => 0, -column => 4, -padx => 5, -sticky => 'e');
$model_menu->grid(-row => 0, -column => 5, -sticky => 'ew');
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment