Skip to content
GitLab
Commit 8f8c23fd authored by Stefan Tauner's avatar Stefan Tauner
Browse files

fiji_scripts: add preliminary fiji_setup.pl

parent 81d32b4f
Hide whitespace changes
Inline Side-by-side
FIJI.pm
View file @ 8f8c23fd
......@@ -11,9 +11,12 @@ use warnings;
# Architecture from http://www.perlmonks.org/?node_id=1072731
# Fields:
# ini_name = key name in FIJI Settings file
# is_numeric = (optional) enables conversion of oct, hex, binary
# strings and checking that the value is really a number.
# - ini_name = key name in FIJI Settings file
# - unit = (optional) physical unit
# - not_supplied = (optional) not to be set by the user (but generated e.g. by fiji_instrument)
# - type = (optional) enables type-specific conversions and tests:
# numeric: values must be oct, hex, binary strings looking like a real number.
# boolean: will be convert to a truth value by Perl semantics
# values = (optional) an array reference listing all valid values (emulates an enum)
# default = (optional) default value if not given in file and not determinable otherwise
my %designmap;
......@@ -21,35 +24,47 @@ BEGIN {
%designmap = (
ID => {
ini_name => "ID",
is_numeric => 1,
type => 'numeric',
not_supplied => 1,
},
FIU_NUM => {
ini_name => "FIU_NUM",
default => undef, # optional in .ini, is set to number of FIU blocks
is_numeric => 1,
type => 'numeric',
not_supplied => 1, # auto-generated
},
BAUDRATE => {
ini_name => "BAUDRATE",
default => 115200,
is_numeric => 1,
type => 'numeric',
unit => 'bps',
},
FREQUENCY => {
ini_name => "FREQUENCY",
default => 50e8,
type => 'numeric',
unit => 'Hz',
},
FIU_CFG_BITS => {
ini_name => "FIU_CFG_BITS",
default => 3,
is_numeric => 1,
type => 'numeric',
not_supplied => 1, # currently not user-configurable
},
TIMER_WIDTH => {
ini_name => "TIMER_WIDTH",
default => 32,
is_numeric => 1,
type => 'numeric',
unit => 'bits',
},
ARM_DURATION_WIDTH => {
ini_name => "ARM_DUR_WIDTH",
is_numeric => 1,
type => 'numeric',
not_supplied => 1, # derived from TIMER_WIDTH if need be
},
INJECT_DURATION_WIDTH => {
ini_name => "INJECT_DUR_WIDTH",
is_numeric => 1,
type => 'numeric',
not_supplied => 1, # derived from TIMER_WIDTH if need be
},
);
}
......@@ -66,21 +81,22 @@ BEGIN {
FIU_MODEL => {
ini_name => "FAULT_MODEL",
default => "RUNTIME",
values => [qw(RUNTIME STUCK_AT_0 STUCK_AT_1 DELAY SEU STUCK_OPEN PASS_THRU)],
values => [qw(RUNTIME PASS_THRU STUCK_AT_0 STUCK_AT_1 STUCK_OPEN DELAY SEU)],
},
FIU_LFSR_EN => {
ini_name => "ENABLED_BY_LFSR",
default => 0,
type => 'boolean',
},
FIU_LFSR_MASK => {
ini_name => "LFSR_MASK",
default => 0,
is_numeric => 1,
type => 'numeric',
},
FIU_LFSR_STUCK_OPEN_BIT => {
ini_name => "LFSR_BIT_FOR_STUCK_OPEN",
default => 0,
is_numeric => 1,
type => 'numeric',
},
);
}
......
FIJI/Settings.pm
View file @ 8f8c23fd
......@@ -14,7 +14,87 @@ use Config::Simple;
use FIJI qw(:all);
## @function read_configfile ($fiji_ini_file)
sub new ($;$$) {
my $logger = get_logger();
my ($class, $fiji_ini_file, $existing_settings) = @_;
my $settings_ref;
if (defined($fiji_ini_file)) {
$settings_ref = read_settingsfile($fiji_ini_file, $existing_settings);
if (!defined($settings_ref)) {
return undef;
}
if (defined($existing_settings)) {
return $existing_settings;
}
} else {
# Without any config file as input, simply create an empty settings
# hash with default design constants.
my $consts_ref = {};
my $ret = _set_defaults(DESIGNMAP, $consts_ref);
if (!defined($ret)) {
$logger->error("Could not set defaults for design constants.");
return undef;
}
$settings_ref = { 'design' => $consts_ref };
}
my $r = bless($settings_ref, $class);
if (!ref($r) || !UNIVERSAL::can($r,'can')) {
$logger->error("Could not bless FIJI::Settings class from \"$fiji_ini_file\".");
return undef;
}
return $r;
}
## @method save ($fiji_ini_file)
# @brief Store contained FIJI Settings to file.
#
# @ATTENTION Will happily overwrite existing files!
#
# \param fiji_ini_file The file name to write the FIJI Settings to.
sub save ($$) {
my $logger = get_logger();
my ($self, $fiji_ini_file) = @_;
return "No file name given" if !defined($fiji_ini_file);
my $fiji_ini = new Config::Simple(syntax=>'ini');
foreach my $key (keys %{$self}) {
my $val = $self->{$key};
$logger->debug(sprintf("Key: %s, type: %s, value: %s", $key, ref(\$val), $val));
if (ref(\$val) eq "REF") {
if (ref($val) eq "HASH") {
if ($key eq "design") {
$fiji_ini->set_block("CONSTS", $val);
next;
}
} elsif (ref($val) eq "ARRAY") {
if ($key eq "FIUs") {
my $fiu_cnt = 0;
foreach my $fiu (@{$val}) {
my $ini_fiu;
foreach my $k (keys $fiu) {
$ini_fiu->{FIUMAP->{$k}->{'ini_name'}} = $fiu->{$k};
}
$fiji_ini->set_block("FIU" . $fiu_cnt++, $ini_fiu);
}
next;
}
}
}
my $err = "Unknown element found in FIJI Settings: \"$val\"";
$logger->error($err);
return $err;
}
if (!defined($fiji_ini->write($fiji_ini_file))) {
my $err = Config::Simple->error();
$logger->error($err);
return $err;
}
return undef;
}
## @function read_settingsfile ($fiji_ini_file)
# @brief Load the FIJI Settings file containing design and FIU constants.
#
# \param fiji_ini_file The name of an .ini file with FIJI Settings:
......@@ -25,26 +105,28 @@ use FIJI qw(:all);
# the constants for the respective FIU, see \ref _sanitize_fiu
#
# \returns a reference to the hash containing the read constants.
sub read_configfile {
sub read_settingsfile {
my $logger = get_logger();
my ($fiji_ini_file) = @_;
my ($fiji_ini_file, $existing_settings) = @_;
my $fiji_ini;
eval { $fiji_ini = new Config::Simple($fiji_ini_file) }; # pesky library tries to die on syntax errors
if (!defined($fiji_ini)) {
$logger->fatal("Could not read config file \"$fiji_ini_file\": " . (defined($@) ? $@ : Config::Simple->error()));
$logger->error("Could not read config file \"$fiji_ini_file\": " . (defined($@) ? $@ : Config::Simple->error()));
return undef;
}
my $fiji_settings = (defined($existing_settings)) ? $existing_settings : {};
my $fiji_consts = $fiji_ini->get_block("CONSTS");
if (!(%$fiji_consts)) {
$logger->fatal("Could not fetch CONSTS block from config file \"$fiji_ini_file\"");
$logger->error("Could not fetch CONSTS block from config file \"$fiji_ini_file\"");
return undef;
}
$fiji_consts = _sanitize_consts($fiji_consts);
if (!defined($fiji_consts)) {
$logger->fatal("Design constants in FIJI Settings invalid");
$logger->error("Design constants in FIJI Settings invalid");
return undef;
}
$fiji_settings->{'design'} = $fiji_consts;
my $fiu_num = 0;
while (1) {
......@@ -55,33 +137,32 @@ sub read_configfile {
}
my $fiji_fiu = _sanitize_fiu($fiji_fiu_cfg);
if (!defined($fiji_fiu)) {
$logger->fatal("Constants for $fiu_name in FIJI Settings are invalid");
$logger->error("Constants for $fiu_name in FIJI Settings are invalid");
return undef;
}
push(@{$fiji_consts->{'FIUs'}}, $fiji_fiu);
push(@{$fiji_settings->{'FIUs'}}, $fiji_fiu);
$fiu_num++;
$logger->trace("Read in $fiu_name from FIJI Settings file successfully.");
}
if ($fiu_num == 0) {
$logger->fatal("Could not fetch any FIU block from config file \"$fiji_ini_file\"");
$logger->error("Could not fetch any FIU block from config file \"$fiji_ini_file\"");
return undef;
}
# FIU_NUM is optional in the Settings file... if it was set check that
# it corresponds to the number of FIU<number> blocks.
if (defined($fiji_consts->{'FIU_NUM'}) && $fiji_consts->{'FIU_NUM'} != $fiu_num) {
$logger->fatal(FIU_NUM->{'ini_name'} . " does not match the numbers of FIU blocks found.");
$logger->error(FIU_NUM->{'ini_name'} . " does not match the numbers of FIU blocks found.");
return undef;
} else {
$fiji_consts->{'FIU_NUM'} = $fiu_num; # assume the best if FIU_NUM constant is not given
}
$logger->info("Successfully read in design constants and $fiu_num FIU definitions from FIJI Settings file.");
return $fiji_consts;
return $fiji_settings;
}
## @function _set_defaults (%$map_ref, %$consts_ref)
# @brief Set defaults according to FIJI.pm.
#
......@@ -90,46 +171,69 @@ sub read_configfile {
sub _set_defaults {
my $logger = get_logger();
my ($map_ref, $consts_ref) = @_;
my $new_hash = {};
# my $new_hash = {};
# Iterating over respective hash from FIJI.pm and set defaults if need be
foreach my $k (keys($map_ref)) {
my $ini_name = $map_ref->{$k}->{'ini_name'};
if (exists($consts_ref->{$ini_name})) {
$new_hash->{$k} = $consts_ref->{$ini_name};
$logger->trace(sprintf("Copying setting %s (%s) = %s.", $k, $ini_name, $consts_ref->{$ini_name}));
if ($ini_name ne $k) {
$consts_ref->{$k} = $consts_ref->{$ini_name};
$logger->trace(sprintf("Copying setting %s (%s) = %s.", $k, $ini_name, defined($consts_ref->{$ini_name}) ? $consts_ref->{$ini_name} : "undef"));
delete $consts_ref->{$ini_name};
}
} else {
if (exists($map_ref->{$k}->{default})) {
$new_hash->{$k} = $map_ref->{$k}->{default};
$logger->trace(sprintf("Adding default constant: %s (%s) = %s.", $k, $ini_name, $map_ref->{$k}->{default}));
if (exists($map_ref->{$k}->{'default'})) {
$consts_ref->{$k} = $map_ref->{$k}->{default};
# If the default key is there but its value is undef then
# the value will be set somewhere else later (used for FIU_NUM)
if (!defined($new_hash->{$k})) {
if (!defined($consts_ref->{$k})) {
next;
}
$logger->trace(sprintf("Adding default constant: %s (%s) = %s.", $k, $ini_name, $map_ref->{$k}->{default}));
} elsif ($map_ref->{$k}->{'not_supplied'}) {
next;
} else {
$logger->error(sprintf("%s is missing from FIJI Settings.", $ini_name));
return undef;
}
}
# convert non-decimal (hexadecimal, binary, octal) values to decimal
if ($map_ref->{$k}->{'is_numeric'}) {
my $orig = $new_hash->{$k};
$new_hash->{$k} = oct($orig) if $orig =~ /^0/;
$logger->trace("Converted value of $k (\"$orig\") to \"$new_hash->{$k}\".") if ($orig ne $new_hash->{$k});
if (!looks_like_number($new_hash->{$k})) {
$logger->error("$orig does not look like a number.");
return undef;
if (defined($map_ref->{$k}->{'type'})) {
my $orig = $consts_ref->{$k};
if ($map_ref->{$k}->{'type'} eq 'numeric') {
# convert non-decimal (hexadecimal, binary, octal) values to decimal
$consts_ref->{$k} = oct($orig) if $orig =~ /^0/;
if (!looks_like_number($consts_ref->{$k})) {
$logger->error("$orig does not look like a number.");
return undef;
}
} elsif ($map_ref->{$k}->{'type'} eq 'boolean') {
# convert strings to binary if need be
if (!defined($orig)) {
$logger->error("\"undef\" is not a boolean value.");
return undef;
} elsif (lc($orig) eq 'true') {
$orig = 1;
} elsif (lc($orig) eq 'false') {
$orig = 0;
}
if (($orig ne '0') && ($orig ne '1')) {
$logger->error("\"$orig\" does not look like a boolean value.");
return undef;
}
# ensure proper boolean value, i.e. 0 or 1
$consts_ref->{$k} = (!!$orig) ? 1 : 0;
}
$logger->trace("Converted value of $k (\"$orig\") to \"$consts_ref->{$k}\".") if ($orig ne $consts_ref->{$k});
} elsif (defined($map_ref->{$k}->{'values'})) {
if (!grep {$_ eq $new_hash->{$k}} @{$map_ref->{$k}->{'values'}}) {
$logger->error("$new_hash->{$k} is not allowed. Allowed values are: " . join(", ", @{$map_ref->{$k}->{'values'}}));
if (!grep {$_ eq $consts_ref->{$k}} @{$map_ref->{$k}->{'values'}}) {
$logger->error("$consts_ref->{$k} is not allowed. Allowed values are: " . join(", ", @{$map_ref->{$k}->{'values'}}));
return undef;
}
}
}
return $new_hash;
return $consts_ref;
}
## @function _sanitize_fiu (%$fiu_ref)
......@@ -148,9 +252,9 @@ sub _sanitize_fiu {
return undef;
}
my $new_consts = _set_defaults(FIUMAP, $fiu_ref);
if (!defined($new_consts)) {
$logger->fatal("Could not set defaults for design constants.");
my $ret = _set_defaults(FIUMAP, $fiu_ref);
if (!defined($ret)) {
$logger->error("Could not set defaults for design constants.");
return undef;
}
......@@ -220,34 +324,34 @@ sub _sanitize_consts {
}
}
my $new_consts = _set_defaults(DESIGNMAP, $consts_ref);
if (!defined($new_consts)) {
$logger->fatal("Could not set defaults for design constants.");
my $ret = _set_defaults(DESIGNMAP, $consts_ref);
if (!defined($ret)) {
$logger->error("Could not set defaults for design constants.");
return undef;
}
# check for sane values
if (($new_consts->{FIU_CFG_BITS} <= 0)) {
if (($consts_ref->{FIU_CFG_BITS} <= 0)) {
$logger->error("FIU_CFG_BITS is <= 0.");
return undef;
}
if (($new_consts->{ARM_DURATION_WIDTH} <= 0) || ($new_consts->{ARM_DURATION_WIDTH} % 8 != 0)) {
$logger->error("ARM_DURATION_WIDTH is invalid ($new_consts->{ARM_DURATION_WIDTH}).");
if (($consts_ref->{ARM_DURATION_WIDTH} <= 0) || ($consts_ref->{ARM_DURATION_WIDTH} % 8 != 0)) {
$logger->error("ARM_DURATION_WIDTH is invalid ($consts_ref->{ARM_DURATION_WIDTH}).");
return undef;
}
if (($new_consts->{INJECT_DURATION_WIDTH} <= 0) || (($new_consts->{INJECT_DURATION_WIDTH} % 8) != 0)) {
$logger->error("INJECT_DURATION_WIDTH is invalid ($new_consts->{INJECT_DURATION_WIDTH}).");
if (($consts_ref->{INJECT_DURATION_WIDTH} <= 0) || (($consts_ref->{INJECT_DURATION_WIDTH} % 8) != 0)) {
$logger->error("INJECT_DURATION_WIDTH is invalid ($consts_ref->{INJECT_DURATION_WIDTH}).");
return undef;
}
if (($new_consts->{ID} <= 0) || ($new_consts->{ID} > (2**15 - 1))) {
$logger->error("ID is invalid ($new_consts->{ID}).");
if (defined($consts_ref->{ID}) && ($consts_ref->{ID} <= 0 || $consts_ref->{ID} > (2**15 - 1))) {
$logger->error("ID is invalid ($consts_ref->{ID}).");
return undef;
}
if (($new_consts->{BAUDRATE} <= 0)) {
if (($consts_ref->{BAUDRATE} <= 0)) {
$logger->error("BAUDRATE missing is <= 0.");
return undef;
}
return $new_consts;
return $consts_ref;
}
1;
Tk/DynaMouseWheelBind.pm 0 → 100644
View file @ 8f8c23fd
# https://rt.cpan.org/Public/Bug/Display.html?id=33655
require Tk::Widget;
package Tk::Widget;
use strict;
use warnings;
use constant SCROLL_FACTOR => 2;
# keep Tk::Widgets namespace clean
my($motion,
$do_scroll,
$mousewheel_event,
$setup,
);
sub DynaMouseWheelBind{
my $w = shift;
my @classes = @_;
my $mw = $w->MainWindow;
$setup->($mw);
for my $class (@classes) {
eval "require $class" or die $@;
# initialize class bindings so the following changes
# won't get overridden
$class->InitClass($mw);
# replace MouseWheel bindings - these should be processed
# through the $mw binding only
my @mw_events = ('<MouseWheel>',
'<4>',
'<5>',
);
$mw->bind($class,$_,'') for (@mw_events);
$mw->bind($class,'<<DynaMouseWheel>>',$do_scroll);
}
}
# setup two bindings to track the window under the cursor
# and globally receive <MouseWheel>
$setup = sub{
my $mw = shift;
$mw->bind('all','<Enter>',$motion);
$mw->bind('all','<MouseWheel>',[$mousewheel_event, Tk::Ev('D')]);
$mw->bind('all','<4>',[$mousewheel_event, 120]);
$mw->bind('all','<5>',[$mousewheel_event, -120]);
};
{
my $under_cursor ;
my $scrollable;
my $delta;
$motion = sub {
$under_cursor = $_[0]->XEvent->Info('W');
};
$do_scroll = sub{
$scrollable->yview('scroll',
-($delta/120) * SCROLL_FACTOR,
'units');
};
$mousewheel_event = sub{
my $widget = shift;
$delta = shift;
# just in case, the mouse has not been moved yet:
my $w = $under_cursor ||= $widget;
# print "under_cursor:[$under_cursor]\n";
my @tags = $w->bindtags;
my $has_binding;
until ($has_binding || $w->isa('Tk::Toplevel')){
if($w->Tk::bind(ref($w),'<<DynaMouseWheel>>')){
$has_binding = 1 ;
}else{
$w = $w->parent;
}
}
if ($has_binding) {
$scrollable = $w;
$w->eventGenerate('<<DynaMouseWheel>>');
}
};
} # end of scope for $under_cursor, $scrollable, $delta
1;
Tk/FIJISettingsViewer.pm 0 → 100644
View file @ 8f8c23fd
## @file
## @class Tk::FIJISettingsViewer
#
#
package Tk::FIJISettingsViewer;
use strict;
use warnings;
use Log::Log4perl qw(get_logger);
use Scalar::Util 'blessed';
use Tk;
use Tk::widgets qw(LabFrame Label Entry Pane Button Dialog Checkbutton);
use Tk::DynaMouseWheelBind;
use base qw(Tk::Frame);
use FIJI qw(:all);
Construct Tk::Widget 'FIJISettingsViewer';
my $fr_design; # labled frame surrounding widgets representing design constant
my $fr_fius; # labled frame surrounding widgets representing design constant
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'};
if (!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->SUPER::Populate($args);
$self->_populate_widget($self);
$self->update();
}
## @method _populate_widget()
# Creates, aranges and binds all widgets
#
sub _populate_widget {
my $logger = get_logger();
my ($self, $fr) = @_;
my $i;
$fr->DynaMouseWheelBind('Tk::Pane');
################
# design panel #
################
$fr_design = $fr->LabFrame(
-label => "Design Constants",
-labelside => "acrosstop"
)->pack(
'-side' => 'top',
'-anchor' => 'nw',
'-fill' => 'x'
);
$fr_design->gridColumnconfigure(2, -weight => 1);
$i = 0;
foreach my $hdr (qw(Name Unit Value)) {
$fr_design->Label(
-text => $hdr,
)->grid(
'-row' => 0,
'-column' => $i++,
);
}
$fr_design->Label(
-text => "Control",
)->grid(
'-row' => 0,
'-column' => $i++,
'-columnspan' => 2,
);
my $designmap = DESIGNMAP;
foreach my $k (qw(FREQUENCY BAUDRATE TIMER_WIDTH)) {
Tk::grid(
$fr_design->Label(
'-text' => DESIGNMAP->{$k}->{'ini_name'},
),
$fr_design->Label(
'-text' => DESIGNMAP->{$k}->{'unit'},
),
$fr_design->Entry(
'-textvariable' => \${$self->{'settings'}}->{'design'}->{$k},
'-width' => -1,
),
$fr_design->Button(
-text => 'Defaults',
# -command => [\&_save, $self],
# sub {
# my $state = defined($filename) ? 'normal' : 'disabled';
# $btn_open->configure(-state => $state);
# $btn_save->configure(-state => $state);
# },
),
'-sticky' => 'ew'
);
}
##############
# FIUs panel #
##############
my $fr_fius_main = $fr->LabFrame(