Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
vecs
FIJI Public
Commits
38df28f2
Commit
38df28f2
authored
Sep 23, 2015
by
Christian Fibich
Committed by
Stefan Tauner
Aug 29, 2016
Browse files
Added "unsaved changes" indicator
parent
f238c91b
Changes
4
Hide whitespace changes
Inline
Side-by-side
Tk/FIJISettingsViewer.pm
View file @
38df28f2
...
...
@@ -33,6 +33,19 @@ use Scalar::Util 'blessed';
use
Tk
;
use
Tk::
widgets
qw(LabFrame Balloon Label Entry Pane Button Dialog DialogBox Checkbutton CompleteEntry NoteBook StatusBar FIJISettingsCanvas)
;
use
Tk::
DynaMouseWheelBind
;
# 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)
;
...
...
@@ -60,6 +73,8 @@ sub Populate {
my
$logger
=
get_logger
("");
my
(
$self
,
$args
)
=
@_
;
my
$settings
=
delete
$args
->
{'
-settings
'};
$self
->
{'
change_indicator_ref
'}
=
delete
$args
->
{'
-change_indicator_ref
'};
$self
->
{'
change_indicator_values
'}
=
delete
$args
->
{'
-change_indicator_values
'};
$self
->
{'
documentation_path
'}
=
delete
$args
->
{'
-documentation_path
'};
if
(
!
defined
(
$settings
)
||
!
blessed
(
$settings
)
||
!
$settings
->
isa
("
FIJI::Settings
"))
{
...
...
@@ -70,6 +85,8 @@ sub Populate {
$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
]);
...
...
@@ -88,6 +105,13 @@ sub Populate {
$self
->
update
();
}
sub
set_state_as_original
{
my
$self
=
shift
;
$self
->
{'
original_settings
'}
=
clone
(
$self
->
{'
settings
'});
$self
->
{'
original_settings
'}
->
{'
fius
'}
=
clone
(
$self
->
{'
settings
'}
->
{'
fius
'});
$
{
$self
->
{'
change_indicator_ref
'}}
=
$self
->
{'
change_indicator_values
'}
->
{'
unchanged
'};
}
sub
netlist
{
my
$logger
=
get_logger
("");
my
(
$self
,
$netlist
)
=
@_
;
...
...
@@ -147,6 +171,8 @@ sub settings {
}
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
]);
...
...
@@ -164,7 +190,9 @@ sub settings {
)
->
Show
();
if
(
$rv
eq
"
No
")
{
$logger
->
info
("
Using original settings
");
$self
->
{'
settings
'}
=
$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
]);
...
...
@@ -691,6 +719,7 @@ sub _populate_widget {
sub
_update_canvas
{
my
(
$index
,
$value
,
$op
,
$self
)
=
@_
;
$self
->
{'
settings_canvas
'}
->
update
()
if
defined
$self
->
{'
settings_canvas
'};
$self
->
_check_change
();
return
$value
;
}
...
...
@@ -838,6 +867,7 @@ sub _add_fiu ($$) {
if
(
defined
$rv
)
{
$self
->
Dialog
(
-
title
=>
"
Error
",
-
text
=>
$rv
,
-
buttons
=>
["
OK
"])
->
Show
();
}
$self
->
_check_change
();
}
);
...
...
@@ -864,6 +894,7 @@ sub _add_fiu ($$) {
# $def_button,
$del_button
,
);
$self
->
_check_change
();
}
);
Tk::
grid
(
...
...
@@ -895,6 +926,7 @@ sub _add_fiu ($$) {
);
# update Block Diagram
$self
->
_check_change
();
$self
->
{'
settings_canvas
'}
->
update
()
if
defined
$self
->
{'
settings_canvas
'};
}
...
...
@@ -931,6 +963,7 @@ sub _update_fields {
}
else
{
$logger
->
error
("
Unknown model selected:
$model
");
}
my
$net_valid
=
$net_entry
->
validate
();
$mask_entry
->
validate
();
...
...
@@ -1167,7 +1200,9 @@ sub _validate_fiu_entry {
my
$i
=
shift
;
my
$new_ref
=
\
shift
;
my
$old_ref
=
\
@
{
$self
->
{'
settings
'}
->
{'
fius
'}}[
$i
]
->
{
$name
};
return
_validate_entry
(
FIUMAP
,
$self
,
$widget
,
$name
,
$old_ref
,
$new_ref
,
@
_
);
my
$rv
=
_validate_entry
(
FIUMAP
,
$self
,
$widget
,
$name
,
$old_ref
,
$new_ref
,
@
_
);
$self
->
_check_change
();
return
$rv
;
}
sub
_validate_entry
{
...
...
@@ -1183,7 +1218,7 @@ sub _validate_entry {
$$old_ref
=
$$new_ref
;
}
#
$self->_update_resources();
$self
->
_update_resources
();
return
1
;
# always allow the new value and show the user what happened.
}
...
...
@@ -1204,5 +1239,12 @@ sub _highlight_widget ($$) {
}
}
sub
_check_change
{
my
$self
=
shift
;
$
{
$self
->
{'
change_indicator_ref
'}}
=
eq_deeply
(
$self
->
{'
settings
'},
$self
->
{'
original_settings
'})
?
$self
->
{'
change_indicator_values
'}
->
{'
unchanged
'}
:
$self
->
{'
change_indicator_values
'}
->
{'
changed
'};
}
1
;
Tk/FIJITestsViewer.pm
View file @
38df28f2
...
...
@@ -341,8 +341,8 @@ sub _populate_widget {
$self
->
{'
fr_buttons
'}
->
Label
(
-
text
=>
"
Fault Detect:
")
->
pack
(
-
side
=>
"
left
",
-
padx
=>
5
);
$self
->
{'
fd0
'}
=
$self
->
{'
fr_buttons
'}
->
Label
(
-
width
=>
2
,
-
relief
=>
"
sunken
",
-
borderwidth
=>
"
1
",
-
text
=>
"
1
",
-
bg
=>
OKCOLOR
)
->
pack
(
-
side
=>
"
left
");
$self
->
{'
fd1
'}
=
$self
->
{'
fr_buttons
'}
->
Label
(
-
width
=>
2
,
-
relief
=>
"
sunken
",
-
borderwidth
=>
"
1
",
-
text
=>
"
2
",
-
bg
=>
OKCOLOR
)
->
pack
(
-
side
=>
"
left
");
$self
->
{'
msg_type
'}
=
$self
->
{'
fr_buttons
'}
->
Label
(
-
width
=>
22
,
-
text
=>
"
N/A
",
-
borderwidth
=>
"
1
",
-
relief
=>
"
sunken
")
->
pack
(
-
side
=>
"
left
",
-
padx
=>
5
);
$self
->
{'
duration
'}
=
$self
->
{'
fr_buttons
'}
->
Label
(
-
width
=>
22
,
-
text
=>
"
N/A
",
-
borderwidth
=>
"
1
",
-
relief
=>
"
sunken
")
->
pack
(
-
side
=>
"
left
",
-
padx
=>
5
);
$self
->
{'
msg_type
'}
=
$self
->
{'
fr_buttons
'}
->
Label
(
-
width
=>
22
,
-
text
=>
"
FIJI status
",
-
borderwidth
=>
"
1
",
-
relief
=>
"
sunken
")
->
pack
(
-
side
=>
"
left
",
-
padx
=>
5
);
$self
->
{'
duration
'}
=
$self
->
{'
fr_buttons
'}
->
Label
(
-
width
=>
22
,
-
text
=>
"
Test runtime
",
-
borderwidth
=>
"
1
",
-
relief
=>
"
sunken
")
->
pack
(
-
side
=>
"
left
",
-
padx
=>
5
);
#---
...
...
fiji.cfg
View file @
38df28f2
; Config::Simple 4.58
; Wed Sep 23 10:33:03 2015
; Wed Sep 23 17:14:18 2015
[FIU2]
NET_NAME=i2c_master_top|cnt_RNIOCS1_combout
DRIVER_TYPE=PIN
DRIVER_PATH=i2c_master_top|byte_controller|cnt_RNIOCS1_combout_0
FAULT_MODEL=RUNTIME
LFSR_MASK=0x0
[FIU0]
DRIVER_PATH=i2c_master_bit_ctrl|al_RNIHURE|combout
DRIVER_TYPE=PIN
NET_NAME=i2c_master_top|i2c_master_byte_ctrl|i2c_master_bit_ctrl|N_152_tz
LFSR_MASK=0x0
FAULT_MODEL=RUNTIME
[CONSTS]
FAULT_DETECT_2_NAME=i2c_master_top|i2c_master_byte_ctrl|N_70
CLOCK_NET=i2c_master_top|wb_clk_i_c
RESET_EXT_IN_NAME=s_fiji_reset
FIU_NUM=3
INSTRUMENTATION_LOG=fiji_instrument.log
TRIGGER_DUT_NAME=i2c_master_top|cnt_RNIOCS1_combout
LFSR_WIDTH=32
TX_OUT_NAME=s_fiji_tx_o
LFSR_SEED=0xcafe
RX_IN_NAME=s_fiji_rx_i
BAUDRATE=115200
TRIGGER_EXT_EN=0
RESET_DUT_IN_ACTIVE=1
FAULT_DETECT_2_EN=1
RESET_DUT_IN_DURATION=4
RESET_EXT_ACTIVE=0
CFGS_PER_MSG=2
LFSR_SEED=0xcafe
LFSR_POLY=0x2d
FIU_CFG_BITS=3
TIMER_WIDTH=4
LFSR_WIDTH=32
FAULT_DETECT_1_INVERT=0
RESET_DUT_OUT_NAME=i2c_master_top|i2c_master_byte_ctrl|c_state_ns_0_0_0_5__g1
RESET_DUT_OUT_EN=1
FAULT_DETECT_2_EN=1
FAULT_DETECT_2_INVERT=1
OUTPUT_DIR=.
ID=0xaa4
RESET_DUT_OUT_ACTIVE=0
FAULT_DETECT_1_EN=1
TRIGGER_EXT_IN_NAME=s_fiji_trigger_ext
TRIGGER_EXT_ACTIVE=1
RESET_DUT_IN_EN=0
RESET_DUT_OUT_ACTIVE=0
TIMER_WIDTH=4
ID=0xaa4
RESET_DUT_IN_ACTIVE=1
BAUDRATE=115200
RX_IN_NAME=s_fiji_rx_i
RESET_DUT_OUT_NAME=i2c_master_top|i2c_master_byte_ctrl|c_state_ns_0_0_0_5__g1
FAULT_DETECT_2_NAME=i2c_master_top|i2c_master_byte_ctrl|N_70
CLOCK_NET=i2c_master_top|wb_clk_i_c
TX_OUT_NAME=s_fiji_tx_o
RESET_DUT_OUT_EN=1
RESET_EXT_EN=1
RESET_EXT_ACTIVE=0
FIU_CFG_BITS=3
LFSR_POLY=0x2d
TRIGGER_EXT_ACTIVE=1
FAULT_DETECT_2_INVERT=1
FAULT_DETECT_1_NAME=i2c_master_top|i2c_master_byte_ctrl|N_11_i
TRIGGER_DUT_EN=0
RESET_DUT_IN_DURATION=4
RESET_EXT_IN_NAME=s_fiji_reset
TRIGGER_DUT_NAME=i2c_master_top|cnt_RNIOCS1_combout
TRIGGER_EXT_EN=0
TRIGGER_DUT_ACTIVE=1
RESET_DUT_IN_NAME=wb_rst_i
FAULT_DETECT_1_EN=1
FREQUENCY=50000000
FIU_NUM=3
OUTPUT_DIR=.
TRIGGER_DUT_EN=0
[FIU1]
NET_NAME=i2c_master_top|i2c_master_byte_ctrl|i2c_master_bit_ctrl|c_state_ns_0_0__g0_0_0
FAULT_MODEL=RUNTIME
DRIVER_TYPE=PIN
LFSR_MASK=0x0
DRIVER_PATH=i2c_master_bit_ctrl|c_state_RNO_0_|combout
[FIU2]
DRIVER_TYPE=PIN
FAULT_MODEL=RUNTIME
NET_NAME=i2c_master_top|cnt_RNIOCS1_combout
LFSR_MASK=0x0
DRIVER_PATH=i2c_master_top|byte_controller|cnt_RNIOCS1_combout_0
[FIU0]
NET_NAME=i2c_master_top|i2c_master_byte_ctrl|i2c_master_bit_ctrl|c_state_ns_0_0__g0_0_0
LFSR_MASK=0x0
DRIVER_PATH=i2c_master_bit_ctrl|al_RNIHURE|combout
FAULT_MODEL=RUNTIME
NET_NAME=i2c_master_top|i2c_master_byte_ctrl|i2c_master_bit_ctrl|N_152_tz
DRIVER_TYPE=PIN
fiji_setup.pl
View file @
38df28f2
...
...
@@ -47,6 +47,9 @@ use constant FILE_TYPES_CFG => [['FIJI Configurations', ['.cfg', '*.ini']], ['Al
use
constant
FILE_TYPES_NETLIST
=>
[['
Verilog Netlists
',
['
.v
',
'
*.vqm
']],
['
All files
',
'
*
'],];
use
constant
CHANGED_VALUE
=>
"
<M>
";
use
constant
UNCHANGED_VALUE
=>
"";
my
$abouttxt
=
<<'END_ABOUT';
#-------------------------------------------------------------------------------
# University of Applied Sciences Technikum Wien
...
...
@@ -65,6 +68,8 @@ my $abouttxt = <<'END_ABOUT';
#-------------------------------------------------------------------------------
END_ABOUT
my
$change_indicator
=
UNCHANGED_VALUE
;
sub
main
{
my
$logger
=
get_logger
("");
my
$name
=
$
0
;
...
...
@@ -111,17 +116,21 @@ sub main {
$mw
->
toplevel
()
->
bind
("
<Control-s>
"
=>
sub
{
$self
->
_save
;
});
$mw
->
toplevel
()
->
bind
("
<Control-Shift-S>
"
=>
sub
{
$self
->
_save_as
;
});
$mw
->
toplevel
()
->
bind
("
<F1>
"
=>
sub
{
$self
->
_show_documentation
;
});
$mw
->
toplevel
()
->
bind
("
<Control-q>
"
=>
sub
{
$self
->
_onexit
(
$mw
);
});
$self
->
{'
documentation_path
'}
=
File::
Spec
->
catpath
(
$vol
,
$libdir
,
'
fiji.pdf
');
$self
->
{'
FIJISettingsViewer
'}
=
$mw
->
FIJISettingsViewer
(
-
settings
=>
$self
->
{'
settings
'},
-
documentation_path
=>
$self
->
{'
documentation_path
'},
-
change_indicator_ref
=>
\
$change_indicator
,
-
change_indicator_values
=>
{'
changed
'
=>
CHANGED_VALUE
,
'
unchanged
'
=>
UNCHANGED_VALUE
}
)
->
pack
(
'
-fill
'
=>
'
both
',
'
-expand
'
=>
1
);
$mw
->
protocol
('
WM_DELETE_WINDOW
'
=>
[
\
&_onexit
,
$self
,
$mw
]);
#
# Set icon
#
...
...
@@ -222,7 +231,7 @@ sub _menu {
-
label
=>
"
Quit
",
-
accelerator
=>
'
Ctrl-q
',
-
underline
=>
0
,
-
command
=>
\
&exit
,
-
command
=>
[
\
&
_on
exit
,
$self
,
$mw
],
);
$netlist
->
separator
;
...
...
@@ -271,7 +280,8 @@ sub _ctrl_frame {
# -expand => 1
);
my
$cfg_lbl
;
my
$cfg_lbl
;
my
$cfg_changed_lbl
;
my
$cfg_btn_open
;
my
$cfg_btn_save
;
my
$cfg_btn_save_as
;
...
...
@@ -288,6 +298,11 @@ sub _ctrl_frame {
'
-column
'
=>
0
,
'
-sticky
'
=>
'
w
'
);
$cfg_changed_lbl
=
$fr_ctrl
->
Label
(
-
textvariable
=>\
$change_indicator
,
-
width
=>
4
)
->
grid
(
'
-row
'
=>
0
,
'
-column
'
=>
1
,
'
-sticky
'
=>
'
w
'
);
if
(
!
defined
USE_MENU
||
USE_MENU
==
0
)
{
$cfg_btn_open
=
$fr_ctrl
->
Button
(
...
...
@@ -295,7 +310,7 @@ sub _ctrl_frame {
-
command
=>
[
\
&_open_settings_file
,
$self
],
)
->
grid
(
'
-row
'
=>
0
,
'
-column
'
=>
1
,
'
-column
'
=>
2
,
'
-sticky
'
=>
'
ew
'
);
$cfg_btn_open
->
focus
();
...
...
@@ -305,7 +320,7 @@ sub _ctrl_frame {
-
command
=>
[
\
&_save
,
$self
],
)
->
grid
(
'
-row
'
=>
0
,
'
-column
'
=>
2
,
'
-column
'
=>
3
,
'
-sticky
'
=>
'
ew
'
);
...
...
@@ -314,7 +329,7 @@ sub _ctrl_frame {
-
command
=>
[
\
&_save_as
,
$self
],
)
->
grid
(
'
-row
'
=>
0
,
'
-column
'
=>
3
,
'
-column
'
=>
4
,
'
-sticky
'
=>
'
ew
'
);
}
...
...
@@ -326,7 +341,7 @@ sub _ctrl_frame {
-
takefocus
=>
0
,
# default for disabled
)
->
grid
(
'
-row
'
=>
0
,
'
-column
'
=>
4
,
'
-column
'
=>
5
,
'
-sticky
'
=>
'
ew
'
);
...
...
@@ -336,6 +351,7 @@ sub _ctrl_frame {
$nl_lbl
=
$fr_ctrl
->
Label
(
-
text
=>
'
Input netlist file
',)
->
grid
(
'
-row
'
=>
1
,
'
-column
'
=>
0
,
'
-sticky
'
=>
'
w
',
);
if
(
!
defined
USE_MENU
||
USE_MENU
==
0
)
{
...
...
@@ -344,7 +360,7 @@ sub _ctrl_frame {
-
command
=>
[
\
&_open_netlist_file
,
$self
],
)
->
grid
(
'
-row
'
=>
1
,
'
-column
'
=>
1
,
'
-column
'
=>
2
,
);
}
...
...
@@ -355,12 +371,12 @@ sub _ctrl_frame {
-
takefocus
=>
0
,
# default for disabled
)
->
grid
(
'
-row
'
=>
1
,
'
-column
'
=>
2
,
'
-column
'
=>
3
,
'
-columnspan
'
=>
4
,
'
-sticky
'
=>
'
ew
',
);
$fr_ctrl
->
gridColumnconfigure
(
4
,
-
weight
=>
1
);
$fr_ctrl
->
gridColumnconfigure
(
5
,
-
weight
=>
1
);
return
$fr_ctrl
;
}
...
...
@@ -538,6 +554,8 @@ sub _save_file {
}
$
{
$self
->
{'
ini_name
'}}
=
$filename
;
$self
->
{'
FIJISettingsViewer
'}
->
set_state_as_original
();
$logger
->
info
("
Successfully saved to file
$filename
.
");
}
...
...
@@ -567,5 +585,16 @@ sub _save_as {
return
$self
->
_save_file
(
$filename
);
}
sub
_onexit
{
my
$logger
=
get_logger
("");
my
(
$self
,
$mw
)
=
@_
;
my
$response
=
$mw
->
Dialog
(
-
title
=>
"
Save changes?
",
-
text
=>
"
Settings changed.
\n
Save?
",
-
buttons
=>
["
Yes
",
"
No
"])
->
Show
()
if
(
$change_indicator
ne
UNCHANGED_VALUE
);
$logger
->
info
("
Settings changed. Asking to save.
")
if
(
$change_indicator
ne
UNCHANGED_VALUE
);
# use _save_as to give the user the chance to save under a different name
$self
->
_save_as
if
(
defined
$response
&&
$response
eq
"
Yes
");
$logger
->
info
("
Save:
"
.
(
defined
$response
?
$response
:
"
undef
"));
exit
;
}
Log::Log4perl::
init_and_watch
('
logger.conf
',
'
HUP
');
exit
main
(
@ARGV
);
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment