Some widgets for a viewer for FIJI::Tests

Tk/FIJITestCanvas.pm

@@ -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 .= "\nFIU $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 $x0 = $self->{'xoff'};
-    my $y0 = $self->{'yoff'};
+    my $x_base = $self->{'xoff'};
+    my $y_base = $self->{'yoff'};
 
-    $self->createLine(0,$y0,$self->{'width'},$y0,-fill=>"black");
-    $self->createLine($x0,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} .= "\nReset 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} .= "\nWait 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

+#-------------------------------------------------------------------------------
+#  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

+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