FIJISettingsViewer.pm

#-------------------------------------------------------------------------------
#  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:              FIJISettingsViewer.pm
#  Created on:        25.02.2015
#  $LastChangedBy$
#  $LastChangedDate$
#
#  Description:
#  FIJI Settings Viewer class
#-------------------------------------------------------------------------------

## @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 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;

use Data::Dumper;

Construct Tk::Widget 'FIJISettingsViewer';

my $delete_image;
my $alert_image;
my $error_image;

## @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;

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'};
    $self->{'delete_mw'} = delete $args->{'-delete_mw'};
    $self->{'mw'}        = delete $args->{'-mw'};

    my $icon_path = delete $args->{'-icon_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();
    $self->{'mw'} = $self->toplevel;
    $delete_image = $self->Photo(-file => File::Spec->catfile($icon_path, 'delete_48x48.xpm'), -format => 'XPM');
    $error_image  = $self->Photo(-file => File::Spec->catfile($icon_path, 'stop_48x48.xpm'),   -format => 'XPM');
    $alert_image  = $self->Photo(-file => File::Spec->catfile($icon_path, 'alert_48x48.xpm'),  -format => 'XPM');
}

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->{'nets_ok'} = 1;
        $self->update();

        if ($self->{'nets_ok'} != 1) {
            my $msg = "Some nets defined in the specified netlist do not match the loaded settings.";
            $logger->error($msg);

            my $d = $self->{'mw'}->FIJIModalDialog(-delete_mw   => $self->{'delete_mw'},
                                                   -mw          => $self->{'mw'},
                                                   -image       => $alert_image,
                                                   -text        => $msg . "\n" . "Proceed with new netlist nevertheless?",
                                                   -wraplength  => 200,
                                                   -title       => 'Warning',
                                                   -buttons     => [qw/Yes No/]);

            my $rv = $d->Show();
            if (!defined $rv || $rv eq "No") {
                $logger->info("Using original netlist");
                $self->{'nets'}    = $old_nets;
                $self->{'netlist'} = $old_netlist;
                $self->update();
                return undef;
            } else {
                $logger->info("Using new nets nevertheless");
            }
        }
        $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->{'nets_ok'} = 1;
        $self->update();

        if (defined $self->{'nets'} && $self->{'nets_ok'} != 1) {
            my $msg = "Some nets defined in the specified settings do not match the loaded netlist.";
            $logger->info($msg);

            my $d = $self->{'mw'}->FIJIModalDialog(-delete_mw   => $self->{'delete_mw'},
                                                   -mw          => $self->{'mw'},
                                                   -image       => $alert_image,
                                                   -text        => $msg . "\n" . "Proceed with new netlist nevertheless?",
                                                   -wraplength  => 200,
                                                   -title       => 'Warning',
                                                   -buttons     => [qw/Yes No/]);

            my $rv = $d->Show();
            if (!defined $rv || $rv eq "No") {
                $logger->info("Using original settings");
                $self->{'settings'}                    = $old_settings;
                $self->{'original_settings'}           = clone($old_settings);
                $self->{'original_settings'}->{'fius'} = clone($old_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 0;
            } else {
                $logger->info("Using new settings nevertheless");
            }
        }
    }
    return $self->{'settings'};
}

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

## @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'}}) {
        foreach my $c ($f->children) {
            push @design_widgets, $c;
        }
    }

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

    for (my $i = 0 ; $i < $const_cnt ; $i += 3) {

        # The order of the widgets depends on their *construction* time(!)
        my ($namew, $unitw, $valw) = @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 $d = $self->{'mw'}->FIJIModalDialog(-delete_mw   => $self->{'delete_mw'},
                                                   -mw          => $self->{'mw'},
                                                   -image       => $error_image,
                                                   -text        => 'Something went horribly wrong!',
                                                   -wraplength  => 200,
                                                   -title       => 'Warning',
                                                   -buttons     => ["OK"]);

            $d->Show();
            return;
        }

        $logger->trace("Connect widget ($name) with new settings instance hash ($k)");
        my $orig_ref = \$self->{'settings'}->{'design'}->{$k};
        my $type     = DESIGNMAP->{$k}->{'type'};
        my $orig     = $$orig_ref;
        my $val      = defined($type) && ($type eq 'hexadecimal' || $type eq 'lfsrpoly') ? sprintf("0x%x", $orig) : $orig;
        my $autocomplete_choices;

        if (defined $type) {
            if ($type eq 'toplevel_port') {
                $autocomplete_choices = $toplevel_port_choices;
            } elsif ($type eq 'lfsrpoly') {
                $orig_ref = \$val;
            }
        }

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

            # Update CompleteEntry Fields with the new choices if defined
            $valw->configure(
                '-choices' => $autocomplete_choices,
              )
              if defined($autocomplete_choices);
            $valw->configure('-textvariable' => $orig_ref);
            my $valid = $valw->validate();
        } elsif (ref($valw) eq 'Tk::Checkbutton') {

            # Set fields depending on checkbuttons, check if checkbutton forbids another
            $valw->configure('-variable' => $orig_ref);
            if (defined($self->{'depends'}->{$k}) && defined($self->{'forbidden_by'}->{$k})) {
                $valw->configure('-command' => [\&_set_fields_by_button, $self, $valw, $self->{'depends'}->{$k}, $self->{'forbidden_by'}->{$k}]);
            } elsif (defined($self->{'depends'}->{$k})) {
                $valw->configure('-command' => [\&_set_fields_by_button, $self, $valw, $self->{'depends'}->{$k}, []]);
            } elsif (defined($self->{'forbidden_by'}->{$k})) {
                $valw->configure('-command' => [\&_set_fields_by_button, $self, $valw, [], $self->{'forbidden_by'}->{$k}]);
            }
            _set_fields_by_button($self, $valw, $self->{'depends'}->{$k}, $self->{'forbidden_by'}->{$k});
        } elsif (ref($valw) eq 'Tk::Optionmenu') {
            $valw->configure('-textvariable' => $orig_ref);
        } elsif (ref($valw) eq 'Tk::Frame' && defined($type)) {
            # 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
                (($valw->children)[1])->configure('-text' => (defined $val) ? $val : "");
            } elsif ($type eq 'net') {
                (($valw->children)[1])->configure('-text' => (defined $val) ? $val : "");
            }
            
        } else {
            if (defined($val)) {
                $valw->configure('-text' => $val);
            } else {
                $valw->delete('0', 'end');
            }
            my $valid = $valw->validate();
        }
    }

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

    my $parent = $self->{'fr_fius'}->parent();
    $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;

    # Create column headers
    #    foreach my $hdr ("Net Name", "Driver", "Fault Model", "LFSR Mask") {
    #        $self->{'fr_fius'}->Label(-text => $hdr,)->grid(
    #            '-row'    => $hdr_row,
    #            '-column' => $i++,
    #        );
    #    }

    # 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($fiu_ref, $i);
    }

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

    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();

    # 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");

    # Button to open the documentation
    my $bd;
    if (defined FIJI_DOCUMENTATION_PATH) {
        $bd = $bf->Button(
            -text    => "Open Documentation",
            -command => sub {
                my $ret;
                if ($^O eq "MSWin32") {
                    $ret = FIJI::Utils::system(1, "start " . FIJI_DOCUMENTATION_PATH);
                } elsif ($^O eq "linux") {
                    $ret = FIJI::Utils::system("xdg-open " . FIJI_DOCUMENTATION_PATH);
                } else {
                    my $d = $self->{'mw'}->FIJIModalDialog(-delete_mw => $self->{'delete_mw'},
                                                           -mw        => $self->{'mw'},
                                                           -image     => $error_image,
                                                           -text      => "No default PDF viewer for OS \"" . $^O . "\"...",
                                                           -title     => "Open Documentation failed",
                                                           -buttons   => ["OK"]);
                    $d->Show();
                    return;
                }
                if (defined($ret)) {
                    my $d = $self->{'mw'}->FIJIModalDialog(-delete_mw => $self->{'delete_mw'}, 
                                                           -mw        => $self->{'mw'},
                                                           -image     => $error_image,
                                                           -text      => $ret,
                                                           -title     => "Open Documentation failed",
                                                           -buttons   => ["OK"]);
                    $d->Show();
                }
            }
        );
    }

    # Switch tabs by buttons in "status bar"
    my $bb = $bf->Button(
        -text    => "< Back",
        -command => [\&_switchtab, undef, $self->{'nb'}, -1],
    );
    my $bn = $bf->Button(
        -text    => "Next >",
        -command => [\&_switchtab, undef, $self->{'nb'}, 1],
    );

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

    $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");

    foreach my $displaygroup (sort { DISPLAYGROUPS->{$a}->{'order'} <=> DISPLAYGROUPS->{$b}->{'order'} } keys(%{$dg_ref})) {

        # 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 $row = 1;
        my $i   = 0;

        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'}
        );

        # add frame for Block Diagram / Description
        my $description_frame = $page->Frame();
        $description_frame->Label(-text => DISPLAYGROUPS->{$displaygroup}->{'description'})->pack(-anchor => "nw", -side => "top", -fill => "x");

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

        # 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", -in => $description_frame);
                $self->{'settings_canvas'}->update();
            }
        );

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

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

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

            # 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();
                $entry->Button(
                    -text    => "Select",
                    -command => sub {
                        my $netname = $self->{'settings'}->{'design'}->{$k};
                        my $rv = $self->_select_net_dialog(\$netname,"Select Net for $k");
                        if (defined $rv) {
                            $logger->warn($rv);
                            $logger->error($rv);
                            my $d = $self->{'mw'}->FIJIModalDialog(-delete_mw => $self->{'delete_mw'},
                                                                   -mw        => $self->{'mw'},
                                                                   -image     => $alert_image,
                                                                   -wraplength => $self->screenwidth,
                                                                   -text      => "$rv",
                                                                   -title     => "Warning",
                                                                   -buttons   => ["OK"]);
                            $d->Show();
                        } elsif (defined $netname) {
                            $self->{'settings'}->{'design'}->{$k} = $netname;
                            $self->update;
                        }
                        $self->_check_change();

                    }
                )->grid(
                    -row    => 0,
                    -column => 1,
                    -sticky => "ew"
                  );
                $entry->Entry(-state=>"readonly",-textvariable=>\$self->{'settings'}->{'design'}->{$k},-takefocus=>0)->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_toplevel_port_entry, $self, $entry, $k, 1],
                );
                $entry->grid(
                    -row      => $row,
                    -column   => 2,
                    '-sticky' => 'ew'
                );

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

                # entry for a DUT port name
                $entry = $config_frame->CompleteEntry();
                $entry->configure(
                    '-validate'        => 'key',
                    '-validatecommand' => [\&_validate_toplevel_port_entry, $self, $entry, $k, 0],
                );
                $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'        => 'focusout',
                    '-validatecommand' => [\&_validate_design_entry, $self, $entry, $k],
                );
                $entry->grid(
                    -row      => $row,
                    -column   => 2,
                    '-sticky' => 'ew'
                );
            } 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 $val = $entry->FBox(
                            -type  => $dialog_type,
                            -title => "Select " . lc(DESIGNMAP->{$k}->{'description'}),
                        )->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, $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 for widget
            if (defined DESIGNMAP->{$k}->{'help'}) {
                $balloon->attach(
                    $entry,
                    -balloonposition => 'mouse',
                    -msg             => DESIGNMAP->{$k}->{'help'}
                );
                $balloon->attach(
                    $label,
                    -balloonposition => 'mouse',
                    -msg             => DESIGNMAP->{$k}->{'help'}
                );
            }

            $entry->bind(
                '<Control-a>',
                sub {
                    my $w = shift;
                    $w->selectionRange(0, 'end');
                    $w->icursor('end');
                },
            );

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

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

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

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

    $self->{'page_fius'} = $self->{'nb'}->add(
        'fius',
        -label     => 'FIUs',
        -underline => 0
    );

    # add frame for Block Diagram / Description
    my $description_frame = $self->{'page_fius'}->Frame();
    $description_frame->Label(-text => "Settings concerning Fault Injection Units")->pack(-fill => "both");

    # add frame for configuration widgets
    my $config_frame = $self->{'page_fius'}->Frame();

    $description_frame->pack(-anchor => "nw", -side => "left", -fill => "x", -padx => 5, -pady => 5);
    $config_frame->pack(-anchor => "nw", -side => "top", -fill => "both", -expand => 1, -padx => 5, -pady => 30);

    # if the tab is changed, delete the existing canvas
    # and create a new one in the tab currently shown.
    $self->{'nb'}->pageconfigure(
        "fius",
        -raisecmd => sub {
            $self->{'settings_canvas'}->packForget() if defined $self->{'settings_canvas'};
            $self->{'settings_canvas'}->pack(-in => $description_frame);
            $self->{'settings_canvas'}->update();
        }
    );
    $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;

    $fr_fius_main->Button(
        -text    => 'Append empty FIU',
        -command => [\&_add_fiu, $self],
      )->pack(
        '-side'   => 'top',
        '-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->{'mw'},$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, $fiu) = @_;
    $self->_add_fiu($fiu);
}

sub remove_fiu ($) {
    my ($self, $i) = @_;
    $i = 0 if !defined($i);
    splice(@{$self->{'settings'}->{'fius'}}, $i, 1);