FIJISettingsViewer.pm

#-----------------------------------------------------------------------
# Fault InJection Instrumenter (FIJI)
# https://embsys.technikum-wien.at/projects/vecs/fiji
#
# Copyright (C) 2017 Christian Fibich <fibich@technikum-wien.at>
# Copyright (C) 2017 Stefan Tauner <tauner@technikum-wien.at>
#
# This module is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#
# See the LICENSE file for more details.
#-----------------------------------------------------------------------

## @file
# @brief Contains class \ref Tk::FIJISettingsViewer

## @class Tk::FIJISettingsViewer
# @brief A Tk::Frame widget to display all \ref FIJI::Settings

package Tk::FIJISettingsViewer;

use strict;
use warnings;
use utf8;

use Log::Log4perl qw(get_logger);
use Scalar::Util 'blessed';
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 Tk::FIJIUtils;

use constant RESOURCES_REGS_LOWER => 0.1;
use constant RESOURCES_LUTS_LOWER => 0.1;
use constant RESOURCES_TEXT       => "Resource factors are relative to the FIJI default configuration.\n" . "The default configuration can be obtained by starting FIJI Setup without a .cfg file";

# Test::Deep::NoTest exports Test::Deep which exports
# an undocumented blessed() which clashes with Scalar::Util's blessed().
# see http://stackoverflow.com/a/2837016
BEGIN {
    require Test::Deep;
    @Test::Deep::EXPORT = grep { $_ ne 'blessed' } @Test::Deep::EXPORT;
}

use Test::Deep::NoTest;
use Clone qw(clone);

use File::Spec qw (file_name_is_absolute abs2rel splitpath catpath);
use base qw(Tk::Frame);

use FIJI qw(:all);
use FIJI::Netlist;

Construct Tk::Widget 'FIJISettingsViewer';


## @var $widget_background stores the default background of entry widgets
# this is needed under Linux, because the default background retrievable by
# cget() is different from the actual default background
my $widget_background;
my $widget_ro_background;

# Remember if the user does not want to see the information message about
# automatic driver selection for nets with a single driver.
my $show_single_driver_info = 1;

sub ClassInit {
    my ($class, $mw) = @_;
    $class->SUPER::ClassInit($mw);

    my $self = bless {}, $class;
    return $self;
}

sub Populate {
    my $logger = get_logger("");
    my ($self, $args) = @_;
    my $settings = delete $args->{'-settings'};
    $self->{'changes_callback'} = delete $args->{'-changes_callback'};

    my $lib_path = delete $args->{'-lib_path'};

    if (!defined($settings) || !blessed($settings) || !$settings->isa("FIJI::Settings")) {
        $logger->error("Given settings are not of type FIJI::Settings. No way to report this back from the constructor...");
    } else {
        $self->{'settings'} = $settings;
        if (ref($self->{'settings'}->{'fius'}) ne 'ARRAY') {
            $logger->debug("Adding empty fius array to settings reference.");
            $self->{'settings'}->{'fius'} = [];
        }
        $self->{'original_settings'} = clone($settings);
        $self->{'original_settings'}->{'fius'} = clone($settings->{'fius'});

        # tk:trace for canvas update
        $self->traceVariable($self->{'settings'}->{'design'}, 'w' => [\&_update_canvas, $self]);
        $self->traceVariable($self->{'settings'}->{'fius'},   'w' => [\&_update_canvas, $self]);

    }

    $self->{'settings_validation_results'} = {};

    # @FIXME: add an option to store a CODE reference that is called when any field is invalid
    $self->{'lfsr_poly_choices'} = [];
    $self->SUPER::Populate($args);
    $self->_populate_widget($self);
    $self->ConfigSpecs(
        -netlist   => [qw/METHOD netlist    Netlist/,   undef],
        -settings  => [qw/METHOD settings   Settings/,  undef],
        -resources => [qw/METHOD resources  Resources/, undef],
    );
    $self->update();
}

sub netlist {
    my $logger = get_logger("");
    my ($self, $netlist) = @_;
    if (defined($netlist)) {
        if (ref($netlist) ne 'FIJI::Netlist') {
            $logger->error("Ignoring invalid Netlist");
            return undef;
        }

        my $nets = $netlist->get_nets();

        if (ref($nets) ne 'ARRAY') {
            $logger->error("Ignoring invalid nets array");
            return undef;
        }

        my $old_netlist = $self->{'netlist'};
        my $old_nets    = $self->{'nets'};

        # generates a list of all nets with full paths from the nets hashref
        my @n = map { $_->{'path'} . FIJI::Netlist::HIERSEP . $_->{'name'} } @{$nets};
        $self->{'nets'}    = \@n;
        $self->{'netlist'} = $netlist;
        $self->update();
    }
    return $self->{'netlist'};
}

sub settings {
    my $logger = get_logger("");
    my ($self, $settings) = @_;
    if (defined($settings)) {
        if (!blessed($settings) || !$settings->isa("FIJI::Settings")) {
            $logger->error("Given settings are not of type FIJI::Settings.");
            return undef;
        }
        my $old_settings = $self->{'settings'};
        $self->{'settings'}                    = $settings;
        $self->{'original_settings'}           = clone($settings);
        $self->{'original_settings'}->{'fius'} = clone($settings->{'fius'});

        # tk:trace for canvas update
        $self->traceVariable($self->{'settings'}->{'design'}, 'w' => [\&_update_canvas, $self]);
        $self->traceVariable($self->{'settings'}->{'fius'},   'w' => [\&_update_canvas, $self]);
        $self->update();
    }
    return $self->{'settings'};
}

sub resources {
    my ($self, $resources) = @_;
    if (defined($resources)) {
        $self->{'resources'} = $resources;
        $self->update();
    }
    return $self->{'resources'};
}

## @method update()
# @brief redraws the widget on fundamental changes
#
sub update {
    my $self   = shift;
    my $logger = get_logger("");

    #################
    # design panels #
    #################

    # Ugly hack to retrieve the design constants widgets.
    # Alternatively to below one could store the respective widgets separately.
    # To limit the complexity elsewhere we jump though a few hoops here.
    # 1. fetch the widgets comprising the GUI for the design constants
    # 2. loop over the tuples that represent one constant each
    # 3. fetch the internal constant name for the ini_name (stored in the first label)
    # 4. set the reference to the value of that name within the current settings instance
    #    as textvariable of the respective widget.

    my @design_widgets;

    foreach my $f (@{$self->{'pages_design'}}) {
        my @children = @{$f->children};
        push @design_widgets, @children[1..$#children]; # Ignore headline label
    }

    my $const_cnt             = @design_widgets;
    my $dut_port_choices = defined($self->{'netlist'}) ? $self->{'netlist'}->get_toplevel_port_names("i") : [];

    # Update widgets' values depending on their type
    for (my $i = 0 ; $i < $const_cnt ; $i += 3) {

        # The order of the widgets depends on their *construction* time(!)
        my ($namew, $unitw, $val_w) = @design_widgets[$i .. $i + 3];
        my $name = $namew->{'fiji_id'};

        # get DESIGNMAP key from stored INI Field name
        my $k = FIJI::ini2constkey($name);
        if (!defined($k)) {
            my $msg = "Could not find FIJI definition for constant named \"$name\"";
            $logger->error($msg);

            my $error_dialog = $self->MainWindow->FIJIModalDialog(
                -image       => Tk::FIJIUtils::error_image($self->MainWindow),
                -text        => 'Something went horribly wrong!',
                -wraplength  => $self->MainWindow->screenwidth,
                -title       => 'Error',
            );

            $error_dialog->Show();
            return;
        }

        $logger->trace("Connect widget ($name) with new settings instance hash ($k)");
        my $val_ref = \$self->{'settings'}->{'design'}->{$k};
        my $type    = DESIGNMAP->{$k}->{'type'};
        $val_ref    = \(sprintf("0x%x", $$val_ref)) if ($type eq 'hexadecimal' || $type eq 'lfsrpoly');

        if (ref($val_w) eq 'Tk::CompleteEntry') {
            # Update CompleteEntry Fields with the new choices if defined
            if ($type eq 'dut_port') {
                $val_w->configure('-choices' => $dut_port_choices,);
            }
            $val_w->configure('-textvariable' => $val_ref);
        } elsif (ref($val_w) eq 'Tk::Checkbutton') {

            # Set fields depending on checkbuttons, check if checkbutton forbids another
            $val_w->configure('-variable' => $val_ref);
        } elsif (ref($val_w) eq 'Tk::Optionmenu') {
            $val_w->configure('-textvariable' => $val_ref);
        } elsif (ref($val_w) eq 'Tk::Frame') {
            # Tk::Frames need a little extra work, because the design widget is a child widget
            if ($type eq 'dir' || $type eq 'file') {
                # If the frame is a 'dir' type Frame, it contains an "open" button as child 0
                # and a readonly entry field for the path as child 1
                (($val_w->children)[1])->configure('-text' => $$val_ref);
            } elsif ($type eq 'net') {
                my $entry =  ($val_w->children)[1];
                $entry->configure('-textvariable' => $val_ref);
            }
        } else {
            $val_w->configure('-textvariable' => $val_ref);
        }
    }

    # Validate the new settings
    for (my $i = 0 ; $i < $const_cnt ; $i += 3) {

        # The order of the widgets depends on their *construction* time(!)
        my ($namew, $unitw, $val_w) = @design_widgets[$i .. $i + 3];
        my $name = $namew->{'fiji_id'};
        my $k = FIJI::ini2constkey($name);

        my $type    = DESIGNMAP->{$k}->{'type'};

        # Update widgets depending on their type
        # FIXME: use isa() instead?
        if (ref($val_w) eq 'Tk::Checkbutton') {

            # Check if checkbutton forbids another
            if (defined($self->{'depends'}->{$k}) && defined($self->{'forbidden_by'}->{$k})) {
                $val_w->configure('-command' => [\&_set_fields_by_button, $self, $val_w, $self->{'depends'}->{$k}, $self->{'forbidden_by'}->{$k}]);
            } elsif (defined($self->{'depends'}->{$k})) {
                $val_w->configure('-command' => [\&_set_fields_by_button, $self, $val_w, $self->{'depends'}->{$k}, []]);
            } elsif (defined($self->{'forbidden_by'}->{$k})) {
                $val_w->configure('-command' => [\&_set_fields_by_button, $self, $val_w, [], $self->{'forbidden_by'}->{$k}]);
            }
            _set_fields_by_button($self, $val_w, $self->{'depends'}->{$k}, $self->{'forbidden_by'}->{$k});
        } elsif (ref($val_w) eq 'Tk::Frame') {
            if ($type eq 'net') {
                my $entry =  ($val_w->children)[1];
                $entry->validate();
            }
        } else {
            my $valid = $val_w->validate() if (ref($val_w) ne 'Tk::Optionmenu');
        }
    }

    ##############
    # fius panel #
    ##############

    my $parent = $self->{'fr_fius'}->parent();
    my $fiu_displaygroup = DISPLAYGROUPS_FIU_KEY;
    undef($self->{'highlit_widgets'}->{$fiu_displaygroup});
    $parent->packForget();            # This and the next line would be redundant if
    $self->{'fr_fius'}->destroy();    # the $parent->destroy() call would work.
    $self->_add_fiu_frame($parent->parent());

    # The code line below creates a segfault. It should delete all children
    # of the parent frame of self->{'fr_fius'}.
    # $parent->destroy();
    # @FIXME: Without this we have an obvious memory leak

    # An alternative solution is apparently to start destroying higher up
    # in the stack. This does not cause a segfault (but some more flickering).
    #             self->{'fr_fius'}<-frame   <-pane    <-frame   <-frame1  <-border  <-labframe1<-self
    # my $parent = $self->{'fr_fius'}->parent()->parent()->parent()->parent()->parent()->parent();
    # $self->_add_fiu_panel($parent->parent());
    # $parent->destroy();

    # This recreates the entire FIU list:

    my $i       = 1;
    my $hdr_row = 0;

    # Add fields for each FIU
    my $fiu_cnt = $self->_fiu_cnt();
    for (my $i = 0 ; $i < $fiu_cnt ; $i++) {
        my $fiu_ref = @{$self->{'settings'}->{'fius'}}[$i];
        $self->_add_fiu_widgets($fiu_ref, $i);
    }

    $self->{'settings_canvas'}->configure(-settings_ref => \($self->{'settings'})) if defined $self->{'settings_canvas'};

    # Ensure correct behavior even without any FIUs (e.g., if we just deleted the last FIU)
    if ($fiu_cnt == 0) {
        $self->_update_resources();
    }
    return 1;
}

## @method _update_resources()
# Calculates resource estimate and updates the "Status Bar"
#
sub _update_resources {
    my $self = shift;
    my $rh   = FIJI::Settings::estimate_resources($self->{'settings'});
    $rh->{'regs'}     = "< " . RESOURCES_REGS_LOWER if ($rh->{'regs'} < RESOURCES_REGS_LOWER);
    $rh->{'lut_calc'} = "< " . RESOURCES_LUTS_LOWER if ($rh->{'lut_calc'} < RESOURCES_LUTS_LOWER);
    $self->{'resources'} = "Virtual resource factors: " . $rh->{'regs'} . " registers, " . $rh->{'lut_calc'} . " combinational resources";
}

## @method _switchtab(nb, inc)
# Raises the tab $inc frames left ($inc < 0) or right ($inc > 0) of the
# currently selected tab of $nb
#
sub _switchtab {
    my ($dummy, $nb, $inc) = @_;
    my @pages        = $nb->pages();
    my $current_page = $nb->raised();
    my ($index) = grep { $pages[$_] eq $current_page } 0 .. (@pages - 1);
    my $next_page = $pages[$index + $inc];

    $nb->raise($next_page) if (($inc > 0 && defined $next_page)
        || ($inc < 0 && $index > 0));
}

## @method _populate_widget(self, fr)
# Creates, aranges and binds all widgets
#
sub _populate_widget {
    my $logger = get_logger("");
    my ($self, $fr) = @_;

    # Add and init Buttons to bottom frame for "Wizard-Like" navigation
    $self->{'nb'} = $fr->NoteBook()->pack(
        -expand => 1,
        -fill   => 'both'
    );
    my $bf = $fr->Frame(-borderwidth => 1, -relief => 'raised',)->pack(-anchor => "nw", -side => "top", -fill => 'x');

    # create Tk::Balloon instance for tooltips
    my $balloon = $fr->Balloon();
    $self->{'balloon'} = $balloon;

    # Add resources field to bottom frame
    my $rl = $bf->Label(-textvariable => \$self->{'resources'});
    $balloon->attach($rl, -balloonposition => 'mouse', -msg => RESOURCES_TEXT);
    $rl->pack(-side => "left");

    # Switch tabs by buttons in "status bar"
    my $bb = $bf->Button(
        -text    => "< Back",
        -command => [\&_switchtab, undef, $self->{'nb'}, -1],
    );
    $balloon->attach(
        $bb,
        -balloonposition => 'mouse',
        -msg             => "Previous Tab (Alt+Left)",
    );

    my $bn = $bf->Button(
        -text    => "Next >",
        -command => [\&_switchtab, undef, $self->{'nb'}, 1],
    );
    $balloon->attach(
        $bn,
        -balloonposition => 'mouse',
        -msg             => "Next Tab (Alt+Right)",
    );

    $bn->pack(-side => "right");
    $bb->pack(-side => "right");

    $self->{'pages_design'} = [];

    my $dm_ref      = DESIGNMAP;                                         # Work around Perl limitation: use constant <hash> and dereferencing does not play well together
    my $dg_ref      = DISPLAYGROUPS;
    my $net_choices = defined($self->{'nets'}) ? $self->{'nets'} : [];
    my $entry;

    # Allow to switch tabs by pressing ALT+left and ALT+right
    $self->{'nb'}->parent->parent->bind('<Alt-Key-Left>'  => [\&_switchtab, $self->{'nb'}, -1]);
    $self->{'nb'}->parent->parent->bind('<Alt-Key-Right>' => [\&_switchtab, $self->{'nb'}, 1]);

    # create canvas widget which draws a block diagram of the current settings
    $self->{'settings_canvas'} = $fr->FIJISettingsCanvas(-relief => "solid", -borderwidth => "1", -takefocus => "0", -settings_ref => \($self->{'settings'}))->pack(-anchor => "nw", -side => "top", -fill => "x");

    # Loop through tab descriptions ('display groups') and create the tabs
    foreach my $displaygroup (sort { DISPLAYGROUPS->{$a}->{'order'} <=> DISPLAYGROUPS->{$b}->{'order'} } keys(%{$dg_ref})) {

        # The FIU panel is generated separately
        next if $displaygroup eq DISPLAYGROUPS_FIU_KEY;

        # filter out just the Settings Fields in this Display group
        my @keys = map { my $foo = $_; (defined DESIGNMAP->{$foo}->{'group'} && DESIGNMAP->{$foo}->{'group'} eq $displaygroup) ? ($_) : () } keys(%{$dm_ref});

        if (@keys == 0) { next }

        my $title = DISPLAYGROUPS->{$displaygroup}->{'title'};
        $title .= ": " . DISPLAYGROUPS->{$displaygroup}->{'subtitle'} if DISPLAYGROUPS->{$displaygroup}->{'subtitle'} ne "";

        # add new notebook page
        my $page = $self->{'nb'}->add(
            $displaygroup,
            -anchor   => "ne",
            -label    => DISPLAYGROUPS->{$displaygroup}->{'title'},
            # FIXME: Menubar overrides the ALT-(Key) bindings, how can we propagate the events to the notebook?
            #-underline => 0,
        );

        # add frame for configuration widgets
        my $config_frame = $page->Frame();

        $config_frame->Label(-text => DISPLAYGROUPS->{$displaygroup}->{'description'},
            '-justify' => 'center',
            '-pady'    => "15",
            '-font'    => [ '-size' => 11 ],
        )->grid(
            '-row'        => 0,
            '-column'     => 0,
            '-sticky'     => 'nsew',
            '-columnspan' => 3,
        );

        # if the tab is changed, reparent the canvas widget
        $self->{'nb'}->pageconfigure(
            $displaygroup,
            -raisecmd => sub {
                $self->{'settings_canvas'}->packForget() if defined $self->{'settings_canvas'};
                $self->{'settings_canvas'}->pack(-anchor => "nw", -side => "top", -padx => 5, -pady => 15, -in => $page);
                $self->{'settings_canvas'}->update();
                $config_frame->focus;
            }
        );

        # let entries eat up all the remaining space
        $config_frame->gridColumnconfigure(2, -weight => 1);

        # add tooltip to the config frame
        if (defined DISPLAYGROUPS->{$displaygroup}->{'description'}) {
            $balloon->attach(
                $config_frame,
                -balloonposition => 'mouse',
                -msg             => DISPLAYGROUPS->{$displaygroup}->{'description'}
            );
        }

        my $row = 1;
        # add matching widgets for all values in this displaygroup
        foreach my $k (sort { DESIGNMAP->{$a}->{'order'} <=> DESIGNMAP->{$b}->{'order'} } @keys) {

            my $tooltip;

            # label
            my $label = $config_frame->Label(
                '-text'    => DESIGNMAP->{$k}->{'description'},
                '-justify' => 'left',
            );
            $label->{'fiji_id'} = DESIGNMAP->{$k}->{'ini_name'};
            $label->grid(
                -row      => $row,
                -column   => 0,
                '-sticky' => 'w',
            );

            # unit
            my $unit = $config_frame->Label('-text' => DESIGNMAP->{$k}->{'unit'},);
            $unit->grid(
                -row      => $row,
                -column   => 1,
                '-ipadx'  => ".5c",
                '-sticky' => 'w',
            );

            # entry
            my $type = DESIGNMAP->{$k}->{'type'};
            if (defined($type) && $type eq 'net') {

                # entry for NET
                $entry = $config_frame->Frame();
                my $select_button = $entry->Button(-text    => "Select");
                my $net_roentry = $entry->Entry();

                $net_roentry->{'displaygroup'} = $displaygroup;
                $net_roentry->{'key'}          = $k;

                $net_roentry->configure(
                              '-state' => "readonly",
                              '-validatecommand' => [\&_validate_design_entry, $self, 1, $net_roentry, $k],
                              '-textvariable' => \$self->{'settings'}->{'design'}->{$k},
                              '-takefocus' => 0);

                $select_button->configure(
                    -command => sub {
                        my $netnames   = [];
                        my $old_value = $self->{'settings'}->{'design'}->{$k};
                        # only display old value if not empty
                        push @{$netnames}, $old_value if (defined $old_value && !($old_value =~ /^\s*$/));

                        my $rv = $self->_select_net_dialog($netnames,"Select Net for $k");
                        if (defined $rv) {
                            Tk::FIJIUtils::show_warning($self, $rv);
                        } elsif ($old_value ne @{$netnames}[0]) {
                            $self->{'settings'}->{'design'}->{$k} = defined(@{$netnames}[0]) ? @{$netnames}[0] : "";
                            $self->update;
                            $self->_check_change();
                        } else {
                            $logger->debug("Net selection was not changed for $k");
                        }
                    }
                );
                $select_button->grid(-row => 0, -column => 1, -sticky => "ew");
                $net_roentry->grid(-row => 0, -column => 0, -sticky => "ew");

                $entry->gridColumnconfigure(0, -weight => 1);
                $entry->grid(
                    -row      => $row,
                    -column   => 2,
                    '-sticky' => 'ew'
                );

            } elsif (defined($type) && $type eq 'external_port') {

                # entry for an external port name
                $entry = $config_frame->Entry();
                $entry->configure(
                    '-validate'        => 'key',
                    '-validatecommand' => [\&_validate_design_entry, $self, 1, $entry, $k],
                );
                $entry->grid(
                    -row      => $row,
                    -column   => 2,
                    '-sticky' => 'ew'
                );

            } elsif (defined($type) && $type eq 'dut_port') {

                # entry for a DUT port name
                $entry = $config_frame->CompleteEntry();
                $entry->configure(
                    '-validate'        => 'key',
                    '-validatecommand' => [\&_validate_design_entry, $self, 1, $entry, $k],
                );
                $entry->grid(
                    -row      => $row,
                    -column   => 2,
                    '-sticky' => 'ew'
                );
            } elsif (defined($type) && $type eq 'lfsrpoly') {

                # entry for the LFSR poly
                $entry = $config_frame->CompleteEntry();
                $entry->configure(
                    '-validate'        => 'key',
                    '-validatecommand' => [\&_validate_design_entry, $self, 1, $entry, $k],
                );
                $entry->grid(
                    -row      => $row,
                    -column   => 2,
                    '-sticky' => 'ew'
                );
                my $lfsr_width = $self->{'settings'}->{'design'}->{'LFSR_WIDTH'};
                my $lpc = LFSR_POLY_CHOICES;
                my $c   = $lpc->{$lfsr_width};
                my $tmp =  FIUMAP->{'FIU_LFSR_MASK'}->{'help'} . " [" . FIUMAP->{'FIU_LFSR_MASK'}->{'ini_name'} . "]\nPossible maximum polynomials for a LFSR with a width of ".$lfsr_width.": " . join(",", @{$c});
                $tooltip = \$tmp;
                $entry->{'LFSR_tooltip'} = \$tmp;
            } elsif (defined($type) && $type eq 'boolean') {

                # checkbutton for values which can only be "enabled" or "disabled"
                $entry = $config_frame->Checkbutton('-justify' => 'left',);
                $entry->grid(
                    -row      => $row,
                    -column   => 2,
                    '-sticky' => 'w'
                );
            } elsif (defined($type) && ($type eq 'bit' || $type eq 'dropdown')) {

                # dropdown for bit levels which can be "0" or "1" and have no 'yes/no' or 'truth' value
                $entry = $config_frame->Optionmenu(
                    '-options'      => DESIGNMAP->{$k}->{'values'},
                    '-textvariable' => \$self->{'settings'}->{'design'}->{$k},

                    #                    '-width'        =>
                    '-anchor'  => 'w',
                    '-justify' => 'left'
                );
                $entry->grid(
                    -row      => $row,
                    -column   => 2,
                    '-sticky' => 'ew',
                );
            } elsif (defined($type) && ($type eq 'dir' || $type eq 'file')) {

                my $dialog_type = ($type eq 'dir') ? 'dir' : 'save';

                # complex widget (frame) for selecting directories
                $entry = $config_frame->Frame();
                my $btn = $entry->Button(
                    -justify => "left",
                    -text    => "Open",
                    -command => sub {
                        my $fb = $entry->FBox(
                            -type  => $dialog_type,
                            -title => "Select " . lc(DESIGNMAP->{$k}->{'description'}),
                        );
                        Tk::FIJIUtils::set_icon($fb);
                        my $val = $fb->Show();
                        if (defined $val) {
                            my ($basevolume, $basedirs, $file) = File::Spec->splitpath($self->{'settings'}->{'filename'});
                            my $nv = File::Spec->abs2rel($val, File::Spec->catpath($basevolume, $basedirs, ""));
                            $logger->info("Setting $k to relative path $nv") if (File::Spec->file_name_is_absolute($val));
                            $self->{'settings'}->{'design'}->{$k} = $nv;
                            $self->update;
                        }
                    }
                  )->grid(
                    -row    => 0,
                    -column => 0,
                    -sticky => "w"
                  );
                $entry->Entry(-state => "readonly", -takefocus => 0, -textvariable => \$self->{'settings'}->{'design'}->{$k})->grid(-row => 0, -column => 1, -sticky => "ew");
                $entry->gridColumnconfigure(1, -weight => 1);
                $entry->grid(
                    -row      => $row,
                    -column   => 2,
                    '-sticky' => 'ew'
                );
            } else {

                # a simple text entry for all other types
                $entry = $config_frame->Entry();
                $entry->configure(
                    '-validate'        => 'key',
                    '-validatecommand' => [\&_validate_design_entry, $self, 1, $entry, $k],
                );
                $entry->grid(
                    -row      => $row,
                    -column   => 2,
                    '-sticky' => 'ew'
                );
            }

            # set dependencies (widgets which depend on a single config value to be true or false)
            if (defined(DESIGNMAP->{$k}->{'depends_on'})) {
                push @{$self->{'depends'}->{DESIGNMAP->{$k}->{'depends_on'}}}, $entry;
            }

            # set exclusions (widgets which mutually exclude each other)
            if (defined(DESIGNMAP->{$k}->{'forbidden_by'})) {
                push @{$self->{'forbidden_by'}->{DESIGNMAP->{$k}->{'forbidden_by'}}}, $entry;
            }

            # add tooltip to widget and its label
            if (defined DESIGNMAP->{$k}->{'help'}) {
                $self->_attach_help_balloon($entry, DESIGNMAP, $k, $tooltip);
                $self->_attach_help_balloon($label, DESIGNMAP, $k, $tooltip);
            }

            Tk::FIJIUtils::entry_rebind($entry);

            # Widget description is needed for widget-based error messages such as
            # "Forbids"
            $entry->{'description'}  = DESIGNMAP->{$k}->{'description'};
            $entry->{'displaygroup'} = $displaygroup;
            $entry->{'key'}          = $k;
            $row++;
        }
        $config_frame->pack(-anchor => "nw", -side => "right", -fill => "x", -expand => 1, -padx => 5, -pady => 5);

        push @{$self->{'pages_design'}}, $config_frame;
    }

    $widget_background = $entry->cget('-bg');

    ##############
    # fius panel #
    ##############

    $self->{'page_fius'} = $self->{'nb'}->add(
        DISPLAYGROUPS_FIU_KEY,
        -label     => DISPLAYGROUPS->{DISPLAYGROUPS_FIU_KEY()}->{'title'},
       # FIXME: Menubar overrides the ALT-(Key) bindings, how can we propagate the events to the notebook?
       #-underline => 0
    );

    # add frame for Block Diagram / Description

    # add frame for configuration widgets
    my $config_frame = $self->{'page_fius'}->Frame();
    $config_frame->Label(-text => DISPLAYGROUPS->{DISPLAYGROUPS_FIU_KEY()}->{'description'},
        '-justify' => 'center',
        '-pady'    => "15",
        '-font'    => [ '-size' => 11 ],
    )->pack(
        '-fill'     => 'x',
    );
    $config_frame->pack(-anchor => "nw", -side => "right", -fill => "both", -expand => 1, -padx => 5, -pady => 5);

    # if the tab is changed, delete the existing canvas
    # and create a new one in the tab currently shown.
    $self->{'nb'}->pageconfigure(
        DISPLAYGROUPS_FIU_KEY,
        -raisecmd => sub {
            $self->{'settings_canvas'}->packForget() if defined $self->{'settings_canvas'};
            $self->{'settings_canvas'}->pack(-anchor => "nw", -side => "left", -padx => 5, -pady => 15, -in => $self->{'page_fius'});
            $self->{'settings_canvas'}->update();
            $config_frame->focus;
        }
    );
    $self->_add_fiu_panel($config_frame);


}

# This is the Tk::Trace callback for FIJI::Settings.
# It is needed for updating the Block Diagram whenever the Settings change
sub _update_canvas {
    my ($index, $value, $op, $self) = @_;
    $self->{'settings_canvas'}->update() if defined $self->{'settings_canvas'};
    $self->_check_change();
    return $value;
}

sub _add_fiu_panel {
    my ($self, $fr) = @_;

    my $fr_fius_main = $fr;

    my $fr_fius_buttons = $fr_fius_main->Frame()->pack('-side' => 'top', '-anchor' => 'nw');

    $fr_fius_buttons->Button(
        -text    => 'Append empty FIU',
        -command => [\&append_fiu, $self],
      )->pack(
        '-side'   => 'left',
        '-anchor' => 'nw',
      );

    $fr_fius_buttons->Button(
        -text    => 'Append FIUs for multiple nets',
        -command => [\&_add_fius, $self, 1],
      )->pack(
        '-side'   => 'left',
        '-anchor' => 'nw',
      );

    # Make the grid containing the fius scrollable
    my $fr_fius_scroll = $fr_fius_main->Scrolled(
        'Pane',
        '-scrollbars' => 'osre',
        '-sticky'     => 'nwse',
    );

    Tk::FIJIUtils::bind_mousewheel($self->MainWindow,$fr_fius_scroll);

    $fr_fius_scroll->pack(
        '-expand' => 1,
        '-fill'   => 'both',
        '-anchor' => 'nw',
        '-side'   => 'top',
    );
    $self->_add_fiu_frame($fr_fius_scroll);
}

sub _add_fiu_frame {
    my ($self, $parent) = @_;
    $self->{'fr_fius'} = $parent->Frame()->pack(
        '-fill'   => 'both',
        '-side'   => 'top',
        '-anchor' => 'nw',
    );
}

sub _fiu_cnt {
    my ($self) = @_;
    my $fius = $self->{'settings'}->{'fius'};
    return (defined($fius) && ref($fius) eq 'ARRAY') ? scalar(@{$fius}) : 0;
}

sub append_fiu ($) {
    my ($self) = @_;
    $self->_add_fiu_widgets();
    $self->{'settings_canvas'}->update(); # update Block Diagram
}

sub remove_fiu ($) {
    my ($self, $i) = @_;
    $i = 0 if !defined($i);
    splice(@{$self->{'settings'}->{'fius'}}, $i, 1); # actually remove it from the array
    my $fiu_cnt = @{$self->{'settings'}->{'fius'}};
    # Make sure we eliminate this FIU's (index') validation results.
    # They would be overwritten by the update function but when deleting
    # the last FIU its results would remain with no corresponding FIU
    # which could lead to false positive error messages (e.g., on saving).
    for my $name ('FIU_NET_NAME', 'FIU_DRIVER_PATH', 'FIU_LFSR_MASK') {
        delete($self->{'settings_validation_results'}->{"FIU[$fiu_cnt] $name"});
    }