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
bc042588
Commit
bc042588
authored
Jul 02, 2015
by
Christian Fibich
Committed by
Stefan Tauner
Aug 29, 2016
Browse files
Some widgets for a viewer for FIJI::Tests
parent
cc112604
Changes
3
Hide whitespace changes
Inline
Side-by-side
Tk/FIJITestCanvas.pm
View file @
bc042588
...
...
@@ -39,8 +39,10 @@ sub Populate {
my
$logger
=
get_logger
();
my
(
$self
,
$args
)
=
@_
;
my
$tests
=
delete
$args
->
{'
-tests
'};
$self
->
{'
tf
'}
=
delete
$args
->
{'
-tf
'};
$self
->
{'
xoff
'}
=
delete
$args
->
{'
-xoff
'};
$self
->
{'
yoff
'}
=
delete
$args
->
{'
-yoff
'};
$self
->
{'
xfin
'}
=
delete
$args
->
{'
-xfin
'};
if
(
!
defined
(
$tests
)
||
!
blessed
(
$tests
)
||
!
$tests
->
isa
("
FIJI::Tests
"))
{
$logger
->
error
("
Given settings are not of type FIJI::Settings. No way to report this back from the constructor...
");
...
...
@@ -58,22 +60,27 @@ sub Populate {
}
sub
_hh
{
my
(
$test
,
$global_settings
,
$pattern
)
=
@_
;
my
$duration
;
my
(
$test
,
$
nexttest
,
$
global_settings
,
$pattern
)
=
@_
;
my
$duration
=
""
;
my
$fiucfg
=
"";
if
(
$pattern
==
1
)
{
$duration
=
$test
->
{'
TIMER_VALUE_1
'}
+
1
;
}
elsif
(
$pattern
==
2
)
{
$duration
=
$test
->
{'
TIMER_VALUE_2
'}
+
1
;
$duration
.=
"
Duration:
"
.
(
$test
->
{'
TIMER_VALUE_2
'}
+
1
);
}
elsif
(
$pattern
==
2
&&
defined
$nexttest
)
{
$duration
.=
"
Duration:
"
.
(
$nexttest
->
{'
TIMER_VALUE_1
'}
+
1
);
if
(
$nexttest
->
{'
TRIGGER
'}
ne
"
NONE
")
{
$duration
.=
"
+ time until
"
.
$nexttest
->
{'
TRIGGER
'}
.
"
ernal trigger
";
}
}
elsif
(
$pattern
==
2
)
{
$duration
.=
"
Duration: INF
";
}
for
(
my
$fi
=
0
;
$fi
<
$global_settings
->
{'
design
'}
->
{'
FIU_NUM
'};
$fi
++
)
{
my
$ps
=
"
FIU_
${fi}
_PATTERN_
${pattern}
";
$fiucfg
.=
"
\n
FIU
$fi
:
$test
->{
$ps
}
";
}
return
"
Duration:
$duration
"
.
$fiucfg
;
return
$duration
.
"
\n
"
.
$fiucfg
;
}
sub
tests
{
...
...
@@ -91,37 +98,55 @@ sub tests {
sub
_populate_widget
{
my
(
$self
,
$p
)
=
@_
;
my
$fiji_tests
=
$self
->
{'
tests
'};
$self
->
{'
balloon
'}
=
$p
->
Balloon
();
$self
->
update
;
}
sub
update
{
my
$self
=
shift
;
$self
->
delete
('
all
');
my
$fiji_tests
=
$self
->
{'
tests
'};
my
$total_duration
=
0
;
my
$temp_duration
=
0
;
my
$num_patterns
=
@
{
$fiji_tests
->
{'
tests
'}};
my
$draw_width
=
$self
->
{'
width
'}
-
$self
->
{'
xoff
'};
my
$draw_height
=
$self
->
{'
height
'}
-
$self
->
{'
yoff
'};
if
(
$fiji_tests
->
{'
design
'}
->
{'
REPEAT
'}
==
0
)
{
$draw_width
-=
$self
->
{'
xfin
'};
}
foreach
my
$test
(
@
{
$fiji_tests
->
{'
tests
'}
})
{
my
$t1_duration
=
$test
->
{'
TIMER_VALUE_1
'}
+
1
;
my
$t2_duration
=
$test
->
{'
TIMER_VALUE_2
'}
+
1
;
$total_duration
+=
$t1_duration
+
$t2_duration
;
}
if
(
$fiji_tests
->
{'
design
'}
->
{'
REPEAT
'}
==
0
)
{
$draw_width
-=
$self
->
{'
xfin
'};
}
else
{
$total_duration
+=
@
{
$fiji_tests
->
{'
tests
'}}[
0
]
->
{'
TIMER_VALUE_1
'};
}
my
$xfraction
=
$draw_width
/
$total_duration
;
my
$yfraction
=
$draw_height
/
(
$num_patterns
*
2
);
my
$x
=
$self
->
{'
xoff
'};
my
$y
=
$self
->
{'
yoff
'};
my
$x
0
=
$self
->
{'
xoff
'};
my
$y
0
=
$self
->
{'
yoff
'};
my
$x
_base
=
$self
->
{'
xoff
'};
my
$y
_base
=
$self
->
{'
yoff
'};
$self
->
createLine
(
0
,
$y
0
,
$self
->
{'
width
'},
$y
0
,
-
fill
=>
"
black
");
$self
->
createLine
(
$x
0
,
0
,
$x0
,
$self
->
{'
height
'},
-
fill
=>
"
black
");
$self
->
createLine
(
0
,
$y
_base
,
$self
->
{'
width
'},
$y
_base
,
-
fill
=>
"
black
");
$self
->
createLine
(
$x
_base
,
0
,
$x_base
,
$self
->
{'
height
'},
-
fill
=>
"
black
");
my
$rgbb
=
0
;
$self
->
{'
helphash
'}
=
{};
my
$time
=
0
;
my
$repstart
=
$x
;
my
$repend
=
$x
;
my
$repy
=
$y
;
for
(
my
$ti
=
0
;
$ti
<
@
{
$fiji_tests
->
{'
tests
'}};
$ti
++
)
{
my
$rgb
=
0
;
...
...
@@ -135,65 +160,104 @@ sub _populate_widget {
my
$col
=
sprintf
("
#%06X
",
$rgb
);
my
$test
=
@
{
$fiji_tests
->
{'
tests
'}
}[
$ti
];
my
(
$x1
,
$y1
,
$x2
,
$y2
);
my
$nexttest
;
if
(
$ti
<
@
{
$fiji_tests
->
{'
tests
'}}
-
1
)
{
$nexttest
=
@
{
$fiji_tests
->
{'
tests
'}
}[
$ti
+
1
];
}
elsif
(
$fiji_tests
->
{'
design
'}
->
{'
REPEAT
'}
==
1
)
{
$nexttest
=
@
{
$fiji_tests
->
{'
tests
'}
}[
$fiji_tests
->
{'
design
'}
->
{'
REPEAT_OFFSET
'}];
}
my
(
$x_trigger
,
$x_pattern_1_start
,
$y_pattern_1
,
$x_pattern_2_start
,
$y_pattern_2
,
$x_next_pattern_start
,
$width3
);
my
$width1
=
$xfraction
*
(
$test
->
{'
TIMER_VALUE_1
'}
+
1
);
my
$width2
=
$xfraction
*
(
$test
->
{'
TIMER_VALUE_2
'}
+
1
);
$x1
=
$x
+
$width1
;
$x2
=
$x1
+
$width2
;
$y1
=
$y
+
$yfraction
;
$y2
=
$y1
+
$yfraction
;
my
$t1
=
$self
->
createText
(
$self
->
{'
xoff
'}
/2,$y1-$yfraction/
2
,
-
text
=>
"
$ti
:1
");
my
$t2
=
$self
->
createText
(
$self
->
{'
xoff
'}
/2,$y2-$yfraction/
2
,
-
text
=>
"
$ti
:2
");
$x_pattern_1_start
=
$x
+
$width1
;
$x_pattern_2_start
=
$x_pattern_1_start
+
$width2
;
$y_pattern_1
=
$y
+
$yfraction
;
$y_pattern_2
=
$y_pattern_1
+
$yfraction
;
$x_trigger
=
$x_pattern_1_start
;
if
(
!
defined
(
$nexttest
))
{
$x_next_pattern_start
=
$self
->
{'
width
'};
$width3
=
$x_pattern_2_start
-
$x_next_pattern_start
;
}
else
{
$width3
=
$xfraction
*
(
$nexttest
->
{'
TIMER_VALUE_1
'}
+
1
);
$x_next_pattern_start
=
$x_pattern_2_start
+
$width3
;
}
my
$t1
=
$self
->
createText
(
$self
->
{'
xoff
'}
/2,$y_pattern_1-$yfraction/
2
,
-
text
=>
"
$ti
:1
");
my
$t2
=
$self
->
createText
(
$self
->
{'
xoff
'}
/2,$y_pattern_2-$yfraction/
2
,
-
text
=>
"
$ti
:2
");
$self
->
{'
helphash
'}
->
{
$t1
}
=
"
Test
$ti
, Pattern 1
";
$self
->
{'
helphash
'}
->
{
$t2
}
=
"
Test
$ti
, Pattern 2
";
$self
->
createLine
(
0
,
$y1
,
$self
->
{'
width
'},
$y1
,
-
fill
=>
"
black
",
-
dash
=>
[
2
,
8
]);
$self
->
createLine
(
0
,
$y2
,
$self
->
{'
width
'},
$y2
,
-
fill
=>
"
black
",
-
dash
=>
[
6
,
4
]);
my
$lx1
=
$self
->
createLine
(
$x1
,
$y0
,
$x1
,
$y2
,
-
fill
=>
"
black
",
-
dash
=>
[
2
,
8
]);
my
$lx2
=
$self
->
createLine
(
$x2
,
$y0
,
$x2
,
$y1
,
-
fill
=>
"
black
",
-
dash
=>
[
6
,
4
]);
$self
->
createLine
(
0
,
$y_pattern_1
,
$self
->
{'
width
'},
$y_pattern_1
,
-
fill
=>
"
black
",
-
dash
=>
[
2
,
8
]);
$self
->
createLine
(
0
,
$y_pattern_2
,
$self
->
{'
width
'},
$y_pattern_2
,
-
fill
=>
"
black
",
-
dash
=>
[
6
,
4
]);
my
$lx1
=
$self
->
createLine
(
$x_pattern_2_start
,
$y_base
,
$x_pattern_2_start
,
$y_pattern_2
,
-
fill
=>
"
black
",
-
dash
=>
[
2
,
8
]);
my
$lx2
=
$self
->
createLine
(
$x_next_pattern_start
,
$y_base
,
$x_next_pattern_start
,
$y_pattern_1
,
-
fill
=>
"
black
",
-
dash
=>
[
6
,
4
]);
my
$r1
=
$self
->
createRectangle
(
$x
,
$y
,
$x1
,
$y1
,
-
fill
=>
"
$col
");
my
$r2
=
$self
->
createRectangle
(
$x1
,
$y1
,
$x2
,
$y2
,
-
fill
=>
"
$col
");
my
$r3
=
$self
->
createRectangle
(
$x
,
0
,
$x
+
$width1
+
$width2
,
$self
->
{'
yoff
'}
/
2
,
-
fill
=>
"
$col
");
$self
->
{'
helphash
'}
->
{
$r1
}
=
$self
->
{'
helphash
'}
->
{
$t1
}
.
"
\n
"
.
_hh
(
$test
,
$fiji_tests
->
{'
ext
'}
->
{'
global_settings
'},
1
);
$self
->
{'
helphash
'}
->
{
$r2
}
=
$self
->
{'
helphash
'}
->
{
$t2
}
.
"
\n
"
.
_hh
(
$test
,
$fiji_tests
->
{'
ext
'}
->
{'
global_settings
'},
2
);
$self
->
{'
helphash
'}
->
{
$r3
}
=
"
Test
$ti
\n
Total duration:
"
.
(
$test
->
{'
TIMER_VALUE_1
'}
+
$test
->
{'
TIMER_VALUE_2
'})
.
"
(+2)
";
my
$pattern
=
((
defined
$nexttest
&&
$nexttest
->
{'
TRIGGER
'}
eq
"
NONE
")
?
undef
:
[
6
,
4
]);
if
(
$ti
==
0
)
{
my
$r0
=
$self
->
createRectangle
(
$x_base
,
$y_base
,
$x_pattern_1_start
,
$y_pattern_1
,
-
fill
=>
"
grey
",
-
dash
=>
$pattern
);
my
$r0_top
=
$self
->
createRectangle
(
$x_base
,
0
,
$x_pattern_1_start
,
$self
->
{'
yoff
'}
/
2
,
-
fill
=>
"
grey
");
my
$ht
=
"
No injection (wait for
";
if
(
$nexttest
->
{'
TRIGGER
'}
ne
"
NONE
")
{
$ht
.=
$nexttest
->
{'
TRIGGER
'}
.
"
ernal trigger and
";
}
$ht
.=
"
first t1)
";
$self
->
{'
helphash
'}
->
{
$r0
}
=
$self
->
{'
helphash
'}
->
{
$r0_top
}
=
$ht
;
$x_trigger
=
$x
;
}
my
$r1
=
$self
->
createRectangle
(
$x_pattern_1_start
,
$y
,
$x_pattern_2_start
,
$y_pattern_1
,
-
fill
=>
"
$col
");
my
$r2
=
$self
->
createRectangle
(
$x_pattern_2_start
,
$y_pattern_1
,
$x_next_pattern_start
,
$y_pattern_2
,
-
fill
=>
"
$col
",
-
dash
=>
$pattern
);
my
$r3
=
$self
->
createRectangle
(
$x_pattern_1_start
,
0
,
$x_pattern_1_start
+
$width2
+
$width3
,
$self
->
{'
yoff
'}
/
2
,
-
fill
=>
"
$col
");
#BEGIN remove
if
(
defined
$self
->
{'
tf
'})
{
$self
->
bind
(
$r3
,'
<Button-1>
'
=>
sub
{
$self
->
{'
tf
'}
->
test
(
$test
);}
);
}
#END remove
$self
->
{'
helphash
'}
->
{
$r1
}
=
$self
->
{'
helphash
'}
->
{
$t1
}
.
"
\n
"
.
_hh
(
$test
,
$nexttest
,
$fiji_tests
->
{'
ext
'}
->
{'
global_settings
'},
1
);
$self
->
{'
helphash
'}
->
{
$r2
}
=
$self
->
{'
helphash
'}
->
{
$t2
}
.
"
\n
"
.
_hh
(
$test
,
$nexttest
,
$fiji_tests
->
{'
ext
'}
->
{'
global_settings
'},
2
);
if
(
$test
->
{'
RESET_DUT_AFTER_CONFIG
'}
==
1
)
{
$self
->
createText
(
$x
,
$y1
-
$yfraction
/
4
,
-
text
=>
"
R
",
-
justify
=>
"
right
",
-
fill
=>
"
red
");
$self
->
{'
helphash
'}
->
{
$r1
}
.=
"
\n
Reset DUT
";
$self
->
createText
(
$x
,
$y_pattern_1
-
$yfraction
/
4
,
-
justify
=>
"
right
",
-
text
=>
"
R
",
-
fill
=>
"
red
");
}
if
(
$test
->
{'
TRIGGER
'}
ne
"
NONE
")
{
$self
->
createText
(
$x
,
$y1
-
3
*$yfraction
/
4
,
-
justify
=>
"
right
",
-
text
=>
$test
->
{'
TRIGGER
'},
-
fill
=>
"
red
");
$self
->
{'
helphash
'}
->
{
$r1
}
.=
"
\n
Wait for
"
.
$test
->
{'
TRIGGER
'}
.
"
ernal trigger
";
$self
->
createText
(
$x_trigger
,
$y_pattern_1
-
3
*$yfraction
/
4
,
-
justify
=>
"
right
",
-
text
=>
$test
->
{'
TRIGGER
'},
-
fill
=>
"
red
");
}
if
(
$ti
==
$fiji_tests
->
{'
design
'}
->
{'
REPEAT_OFFSET
'})
{
$repstart
=
$x
;
$repstart
=
$x_pattern_1_start
;
$repy
=
$y_pattern_1
;
}
$
self
->
createText
(
$x
,
$y0
-
$self
->
{'
yoff
'}
/
4
,
-
justify
=>
"
left
",
-
text
=>
(
$time
))
;
$
time
+=
$test
->
{'
TIMER_VALUE_1
'}
+
1
;
$
time
+=
$test
->
{'
TIMER_VALUE_2
'}
+
1
;
$
self
->
createText
(
$x_pattern_2_start
,
$y_base
-
$self
->
{'
yoff
'}
/
4
,
-
justify
=>
"
left
",
-
text
=>
(
$time
))
;
$self
->
{'
helphash
'}
->
{
$lx1
}
=
"
Time:
"
.
$time
;
$self
->
createText
(
$x1
,
$y0
-
$self
->
{'
yoff
'}
/
4
,
-
justify
=>
"
left
",
-
text
=>
(
$time
));
$time
+=
$test
->
{'
TIMER_VALUE_2
'}
+
1
;
$self
->
{'
helphash
'}
->
{
$lx2
}
=
"
Time:
"
.
$time
;
if
(
defined
$nexttest
)
{
$time
+=
(
$nexttest
->
{'
TIMER_VALUE_1
'}
+
1
);
$self
->
createText
(
$x_next_pattern_start
,
$y_base
-
$self
->
{'
yoff
'}
/
4
,
-
justify
=>
"
left
",
-
text
=>
(
$time
));
$self
->
{'
helphash
'}
->
{
$lx2
}
=
"
Time:
"
.
$time
;
}
$x
=
$x2
;
$y
=
$y2
;
$x
=
$x_pattern_2_start
;
$y
=
$y_pattern_2
;
$repend
=
$x_next_pattern_start
;
}
if
(
$fiji_tests
->
{'
design
'}
->
{'
REPEAT
'}
==
1
)
{
my
$ry
=
(
$fiji_tests
->
{'
design
'}
->
{'
REPEAT_OFFSET
'})
*
2
*$yfraction
+
$self
->
{'
yoff
'}
+
$yfraction
/
2
;
my
$rl1
=
$self
->
createLine
(
$repstart
,
$y0
,
$x
,
$y0
,
-
fill
=>
"
black
",
-
arrow
=>
"
first
",
width
=>
"
4
");
my
$rl2
=
$self
->
createLine
(
$repstart
,
$ry
,(
$x
-
$repstart
)
/2,(($y-$yfraction/
2
)
-
$ry
)
/2,$x,$y-$yfraction/
2
,
-
fill
=>
"
red
",
-
arrow
=>
"
first
",
width
=>
"
2
",
-
smooth
=>
1
);
$self
->
{'
helphash
'}
->
{
$rl1
}
=
$self
->
{'
helphash
'}
->
{
$rl2
}
=
"
Repeat:
"
.
$fiji_tests
->
{'
design
'}
->
{'
REPEAT_OFFSET
'}
.
"
- END
";
my
$rl1
=
$self
->
createLine
(
$repstart
,
$repy
-
$yfraction
/2,$repend,$repy-$yfraction/
2
,
-
fill
=>
"
black
",
-
arrow
=>
"
first
",
width
=>
"
4
");
$self
->
{'
helphash
'}
->
{
$rl1
}
=
"
Repeat:
"
.
$fiji_tests
->
{'
design
'}
->
{'
REPEAT_OFFSET
'}
.
"
- END
";
}
$self
->
{'
balloon
'}
->
attach
(
$self
,
-
balloonposition
=>
'
mouse
',
-
msg
=>
$self
->
{'
helphash
'});
}
\ No newline at end of file
Tk/FIJITestFrame.pm
0 → 100644
View file @
bc042588
#-------------------------------------------------------------------------------
# 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: FIJITestFrame.pm
# Created on: 02.07.2015
# $LastChangedBy$
# $LastChangedDate$
#
# Description:
# FIJI Test Editor Frame
#-------------------------------------------------------------------------------
## @file
## @class Tk::FIJITestFrame
#
#
package
Tk::
FIJITestFrame
;
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 CompleteEntry NoteBook)
;
use
Tk::
DynaMouseWheelBind
;
use
base
qw(Tk::Frame)
;
use
FIJI
qw(:all)
;
use
FIJI::
Tests
;
use
Data::
Dumper
;
Construct
Tk::
Widget
'
FIJITestFrame
';
sub
ClassInit
{
my
(
$class
,
$mw
)
=
@_
;
$class
->
SUPER::
ClassInit
(
$mw
);
my
$self
=
bless
{},
$class
;
return
$self
;
}
sub
Populate
{
my
$logger
=
get_logger
();
my
(
$self
,
$args
)
=
@_
;
$self
->
{'
test
'}
=
delete
$args
->
{'
-test
'};
my
$settings
=
delete
$args
->
{'
-settings
'};
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
;
}
$self
->
ConfigSpecs
(
-
test
=>
[
qw/METHOD test Test/
,
undef
],
);
# FIXME: add an option to store a CODE reference that is called when any field is invalid
$self
->
SUPER::
Populate
(
$args
);
$self
->
update
();
}
sub
test
{
my
(
$self
,
$test
)
=
@_
;
$self
->
{'
test
'}
=
$test
;
$self
->
update
;
}
sub
_populate_widget
($)
{
my
(
$self
,
$p
)
=
@_
;
my
$tf
=
$p
->
Frame
();
$tf
->
Label
(
-
text
=>
"
Duration t1
")
->
grid
(
-
column
=>
0
,
-
row
=>
0
);
$tf
->
Label
(
-
text
=>
"
Duration t2
")
->
grid
(
-
column
=>
0
,
-
row
=>
1
);
$tf
->
Label
(
-
text
=>
"
Trigger
")
->
grid
(
-
column
=>
0
,
-
row
=>
2
);
$tf
->
Label
(
-
text
=>
"
Reset DUT after config
")
->
grid
(
-
column
=>
0
,
-
row
=>
3
);
my
@to
=
qw(INT EXT NONE)
;
$tf
->
Entry
(
-
textvariable
=>
$self
->
{'
test
'}
->
{'
TIMER_VALUE_1
'})
->
grid
(
-
column
=>
1
,
-
row
=>
0
);
$tf
->
Entry
(
-
textvariable
=>
$self
->
{'
test
'}
->
{'
TIMER_VALUE_2
'})
->
grid
(
-
column
=>
1
,
-
row
=>
1
);
$tf
->
Optionmenu
(
'
-options
'
=>
\
@to
,
'
-width
'
=>
15
,
'
-variable
'
=>
\
$self
->
{'
test
'}
->
{"
TRIGGER
"}
)
->
grid
(
-
column
=>
1
,
-
row
=>
2
);
my
$cb
=
$tf
->
Checkbutton
(
-
variable
=>
$self
->
{'
test
'}
->
{'
RESET_DUT_AFTER_CONFIG
'})
->
grid
(
-
column
=>
1
,
-
row
=>
3
);
$cb
->
select
()
if
(
$self
->
{'
test
'}
->
{'
RESET_DUT_AFTER_CONFIG
'});
my
$ff
=
$p
->
Frame
();
$ff
->
Label
(
-
text
=>
"
FIU #
")
->
grid
(
-
column
=>
0
,
-
row
=>
0
);
$ff
->
Label
(
-
text
=>
"
Pattern 1
")
->
grid
(
-
column
=>
1
,
-
row
=>
0
);
$ff
->
Label
(
-
text
=>
"
Pattern 2
")
->
grid
(
-
column
=>
2
,
-
row
=>
0
);
for
(
my
$fi
=
0
;
$fi
<
$self
->
{'
settings
'}
->
{'
design
'}
->
{'
FIU_NUM
'};
$fi
++
)
{
my
$ri
=
$fi
+
1
;
$ff
->
Label
(
-
text
=>
"
FIU
$fi
")
->
grid
(
-
column
=>
0
,
-
row
=>
(
$fi
+
1
));
#my $var1;
#my $var2;
my
@optionlist
=
sort
{
FIUENUM
->
{
$a
}
cmp
FIUENUM
->
{
$b
}}
keys
(
FIUENUM
);
$ff
->
Optionmenu
(
'
-options
'
=>
\
@optionlist
,
'
-width
'
=>
15
,
'
-variable
'
=>
\
$self
->
{'
test
'}
->
{"
FIU_
${fi}
_PATTERN_1
"}
)
->
grid
(
-
column
=>
1
,
-
row
=>
(
$ri
));
$ff
->
Optionmenu
(
'
-options
'
=>
\
@optionlist
,
'
-width
'
=>
15
,
'
-variable
'
=>
\
$self
->
{'
test
'}
->
{"
FIU_
${fi}
_PATTERN_2
"}
)
->
grid
(
-
column
=>
2
,
-
row
=>
(
$ri
));
}
$tf
->
pack
();
$ff
->
pack
();
}
sub
update
{
my
(
$self
)
=
@_
;
for
my
$child
(
$self
->
children
)
{
$child
->
destroy
;
}
$self
->
_populate_widget
(
$self
);
}
fiji_test_display_tkcanvas.pl
0 → 100644
View file @
bc042588
use
Log::
Log4perl
qw(get_logger)
;
use
FIJI
qw(:all)
;
use
FIJI::
Tests
;
use
Data::
Dumper
;
use
Tk
;
use
Tk::
FIJITestCanvas
;
use
Tk::
FIJITestFrame
;
my
$WIDTH
=
800
;
my
$HEIGHT
=
600
;
my
$XOFF
=
40
;
my
$YOFF
=
40
;
my
$XFIN
=
40
;
sub
main
{
my
$logger
=
get_logger
();
my
$cfgname
=
$_
[
0
];
my
$fiji_tests
=
FIJI::
Tests
->
new
(
"
automatic
",
$cfgname
);
my
$fiji_config
=
$fiji_tests
->
{'
ext
'}
->
{'
global_settings
'};
my
$mw
=
MainWindow
->
new
(
-
title
=>
"
Viewer for FIJI Tests
");
$mw
->
resizable
(
0
,
0
);
my
$tm
=
$mw
->
FIJITestFrame
(
-
test
=>
@
{
$fiji_tests
->
{'
tests
'}}[
0
],
-
settings
=>
$fiji_config
);
my
$tc
=
$mw
->
FIJITestCanvas
(
-
tests
=>
$fiji_tests
,
-
width
=>
$WIDTH
,
-
height
=>
$HEIGHT
,
-
xoff
=>
$XOFF
,
-
yoff
=>
$YOFF
,
-
xfin
=>
$XFIN
,
-
tf
=>
$tm
)
->
pack
(
'
-fill
'
=>
'
both
',
'
-expand
'
=>
1
);
$logger
->
debug
("
=== Starting new execution of $0 ===
");
$logger
->
debug
(
sprintf
(
"
%d argument(s)%s
",
scalar
(
@
_
),
scalar
(
@
_
)
>
0
?
"
:
@_
"
:
""
)
);
$tc
->
update
;
$tm
->
pack
();
MainLoop
;
}
Log::Log4perl::
init_and_watch
(
'
logger.conf
',
'
HUP
'
);
exit
(
main
(
@ARGV
));
\ No newline at end of file
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