great progress ... can now draw meander pattern as svg and move the table along pattern

diff --git a/user_interface/table_control.pl b/user_interface/table_control.pl
index df99afb8903dbbcdefdae9f9bf7b5e2214e13b09..ecc158f0303f79f6a2a0dc349d175c8cb7eeff51 100755 (executable)
--- a/user_interface/table_control.pl
+++ b/user_interface/table_control.pl
@@ -24,7 +24,11 @@ my $dispatch_table = {
   communicate => 1,
   set_zero => 1,
   go_xy    => 1,
-  home   => 1
+  home   => 1,
+  go_startpoint => 1,
+  scan_pattern => 1,
+  scan_pattern_to_svg => 1,
+  scan => 1
 };
 
 CGI_dispatch::dispatch_sub($self,$dispatch_table);

diff --git a/user_interface/table_control.pm b/user_interface/table_control.pm
index ab09c1b46b4175e09fa070604fd7702b130a65aa..366b39683be4252e41be0efd212ae5f0ebfc6302 100644 (file)
--- a/user_interface/table_control.pm
+++ b/user_interface/table_control.pm
@@ -8,6 +8,8 @@ use POSIX qw/strftime/;
 use POSIX;
 use Device::SerialPort;
 
+use SVG;
+
 use Storable qw(lock_store lock_retrieve);
 
 
@@ -20,8 +22,8 @@ sub new {
   
   my $self = {}; # put tons of default values here (if you wish);
   
-  $self->{setpos} = { x => 0, y => 0};
-  $self->{realpos} = { x => 0, y => 0};
+  $self->{setpos} = { x => undef , y => undef};
+  $self->{realpos} = { x => undef , y => undef};
   
   $self->{constants} = {
   };
@@ -34,9 +36,23 @@ sub new {
     tty => "/dev/ttyACM0",
     baudrate => 115200,
     approx_speed => 10, #mm per second,
-    size_x => 300,
-    size_y => 150,
-    table_precision => 0.015*2 #mm ... 3mm per round, 200 steps per round
+    size_x => 290,
+    size_y => 140,
+    table_precision => 0.015, #mm ... 3mm per round, 200 steps per round,
+    
+    # defines the sample measures/coordinates
+    sample_rect_x1 => 2.5,
+    sample_rect_x2 => 289.5,
+    sample_rect_y1 => 107.5,
+    sample_rect_y2 => 124.5,
+    # defines the sample raster step size
+    sample_step_size => 1,
+    sample_aperture_dia => 1,
+    
+    scan_pattern_svg_file => "./scan_pattern.svg",
+    scan_pattern_style => "meander"
+    
+    
   };
 
   $self->{has_run} = {}; # remember which subs already have run
@@ -210,7 +226,7 @@ sub receive {
       Time::HiRes::sleep(.01);
   }
 
-  die "no answer";
+  die "no answer from table\n";
 }
 
 sub communicate {
@@ -230,7 +246,12 @@ sub communicate {
 
 sub status {
   my $self = shift;
-  $self->communicate();
+  my $answer = $self->communicate();
+  
+  $self->{realpos}->{x} = $answer->{x_pos};
+  $self->{realpos}->{y} = $answer->{y_pos};
+  
+  return $answer;
   
 }
 
@@ -238,10 +259,20 @@ sub go_xy {
   my $self = shift;
   my %options = @_;
   
+  $self->require_run("status");
+  
+  
   my $new_x = (defined $options{x}) ? $options{x} : $self->{setpos}->{x};
-  my $old_x = $self->{setpos}->{x};
+  unless( defined($new_x) ){
+    $new_x = $self->{realpos}->{x};
+  }
+  my $old_x = $self->{realpos}->{x};
   my $new_y = (defined $options{y}) ? $options{y} : $self->{setpos}->{y};
-  my $old_y = $self->{setpos}->{y};
+  unless( defined($new_y) ){
+    $new_y = $self->{realpos}->{y};
+  }
+  my $old_y = $self->{realpos}->{y};
+  
   
   my $dx = $new_x - $old_x;
   my $dy = $new_y - $old_y;
@@ -255,27 +286,213 @@ sub go_xy {
   $self->send(command => "gy$new_y");
   # hier musst du noch weiterarbeiten!
  
-  my $answer = $self->receive(wait => $travel_timeout);
+  for ( my $i = 0; $i <2; $i++ ){
+    my $got_x = 0;
+    my $got_y = 0;
+    
+    my $answer = $self->receive(wait => $travel_timeout);
+  
+    if($new_x - $answer->{x_pos} < $self->{settings}->{table_precision} 
+    || $answer->{xend2_sw} || $answer->{xend1_sw} ){
+      $self->{setpos}->{x}  = $new_x;
+      $self->{realpos}->{x} = $answer->{x_pos};
+      $got_x = 1;
+    }
+    
+    
+    if($new_y - $answer->{y_pos} < $self->{settings}->{table_precision} 
+    || $answer->{yend2_sw} || $answer->{yend1_sw} ){
+      $self->{setpos}->{y}  = $new_y;
+      $self->{realpos}->{y} = $answer->{y_pos};
+      $got_y = 1;
+    }
+    
+    if($got_x && $got_y){
+      if( $answer->{xend2_sw} ){
+        warn "hit lower X axis end switch\n";
+      }
+      if( $answer->{yend2_sw} ){
+        warn "hit lower Y axis end switch\n";
+      }
+      if( $answer->{xend1_sw} ){
+        warn "hit upper X axis end switch\n";
+      }
+      if( $answer->{yend1_sw} ){
+        warn "hit upper Y axis end switch\n";
+      }
+      return $answer;
+    }
+  
+  }
   
+  die "could not drive to the desired coordinates";
+  
+}
+
+sub go_startpoint {
+  my $self = shift;
+  
+  $self->go_xy(
+    x => $self->{settings}->{sample_rect_x1},
+    y => $self->{settings}->{sample_rect_y1}
+  );
+}
+
+
+sub scan_pattern {
+  my $self = shift;
+  my %options = @_;
+  my $style = $options{style} || $self->{settings}->{scan_pattern_style};
+  
+  $self->require_run("load_settings");
+  
+  my $sample_rect_x1 = $self->{settings}->{sample_rect_x1};
+  my $sample_rect_x2 = $self->{settings}->{sample_rect_x2};
+  my $sample_rect_y1 = $self->{settings}->{sample_rect_y1};
+  my $sample_rect_y2 = $self->{settings}->{sample_rect_y2};
+  my $sample_step_size = $self->{settings}->{sample_step_size};
+  
+  my $sample_rect_size_x = $sample_rect_x2 - $sample_rect_x1;
+  my $sample_rect_size_y = $sample_rect_y2 - $sample_rect_y1;
+  
+  
+  my $steps_in_x = $sample_rect_size_x / $sample_step_size +1;
+  my $steps_in_y = $sample_rect_size_y / $sample_step_size +1;
+  
+  my $coordinate_array = [];
+  
+  for( my $i = 0; $i < $steps_in_x; $i++ ) {
+  
+    for( my $j = 0; $j < $steps_in_y; $j++ ) {
+      
+      if( $style eq "linebyline" ) {
+        push(@$coordinate_array,{
+          x => $sample_rect_x1 + $i*$sample_step_size,
+          y => $sample_rect_y1 + $j*$sample_step_size
+        });
+      } elsif ( $style eq "meander" ) {
+        #reverse the y stepping direction every row
+        my $y;
+        if ( $i % 2 ) {  # is the row number uneven ?
+          $y = $sample_rect_y1 + ($steps_in_y-$j-1)*$sample_step_size; # other direction
+        } else {
+          $y = $sample_rect_y1 + $j*$sample_step_size; # else default direction
+        }
+        push(@$coordinate_array,{
+          x => $sample_rect_x1 + $i*$sample_step_size,
+          y => $y
+        });
+      }
+    
+    }
   
-  if(abs($answer->{x_pos} - $new_x) <= $self->{settings}->{table_precision} ){
-    $self->{setpos}->{x}  = $new_x;
-    $self->{realpos}->{x} = $answer->{x_pos};
-  } else {
-    print "did not move to correct x position!\n";
   }
   
-  if(abs($answer->{y_pos} - $new_y) <= $self->{settings}->{table_precision} ){
-    $self->{setpos}->{y}  = $new_y;
-    $self->{realpos}->{y} = $answer->{y_pos};
-  } else {
-    print "did not move to correct y position!\n";
+  return $coordinate_array;
+}
+
+sub scan_pattern_to_svg {
+
+  my $self = shift;
+  my %options = @_;
+  my $style = $options{style};
+  
+  $self->require_run("load_settings");
+  
+  my $scan_pattern = $self->scan_pattern(style => $style);
+  
+  
+  my $sample_rect_x1 = $self->{settings}->{sample_rect_x1};
+  my $sample_rect_x2 = $self->{settings}->{sample_rect_x2};
+  my $sample_rect_y1 = $self->{settings}->{sample_rect_y1};
+  my $sample_rect_y2 = $self->{settings}->{sample_rect_y2};
+  
+  my $mm2pix = 12 / 2.54; # pixels per mm
+  
+  # create an SVG object with a size of 40x40 pixels
+  my $svg = SVG->new(
+  width => 300*$mm2pix,
+  height => 150*$mm2pix
+  );
+  
+  $svg->rectangle(
+    x => $sample_rect_x1 * $mm2pix,
+    width => ($sample_rect_x2 -$sample_rect_x1)* $mm2pix,
+    y => $sample_rect_y1 * $mm2pix,
+    height => ($sample_rect_y2 - $sample_rect_y1)* $mm2pix,
+    style=>{
+          'stroke'=>'black',
+          'fill'=>'none',
+          'stroke-width'=>'0.5',
+    }
+  );
+  
+  my $lastpoint;
+#   my $counter=0;
+  for my $point (@$scan_pattern) {
+ 
+ 
+    if(0){ 
+      $svg->circle(
+        cx => $point->{x} * $mm2pix,
+        cy => $point->{y} * $mm2pix,
+        r => $self->{settings}->{sample_aperture_dia}/2 * $mm2pix,
+        style=>{
+              'stroke'=>'none',
+              'fill'=>'rgb(100,100,100)',
+              'stroke-width'=>'0.5',
+  #             'stroke-opacity'=>'0.5',
+  #             'fill-opacity'=>'0.0'
+          }
+      );
+    }
+    
+    if( defined ($lastpoint)) {
+      $svg->line(
+#           id=>'l1.'.$counter++,
+          x1=> $lastpoint->{x}*$mm2pix, y1=>$lastpoint->{y}*$mm2pix,
+          x2=> $point->{x}*$mm2pix    , y2=>$point->{y}*$mm2pix,
+        style=>{
+              'stroke'=>'red',
+              'fill'=>'none',
+              'stroke-width'=>'.5',
+  #             'stroke-opacity'=>'0.5',
+  #             'fill-opacity'=>'0.0'
+          }
+      );
+    
+    }
+    
+    $lastpoint = $point;
+      
+  
   }
   
-  return $answer;
+
+  my $svgfile = $self->{settings}->{scan_pattern_svg_file};
   
+  open(SVGFILE, ">".$svgfile);
+  # now render the SVG object, implicitly use svg namespace
+  print SVGFILE $svg->xmlify;
+  close(SVGFILE);
 }
 
+
+sub scan {
+  my $self = shift;
+  my %options = @_;
+  my $eval = $options{eval};
+  
+  $self->require_run("load_settings");
+  
+  for my $point (@{$self->scan_pattern()}) {
+    $self->go_xy( x => $point->{x}, y => $point->{y});
+    eval $eval;
+  }
+  
+}
+
+
 sub set_zero {
   my $self = shift;
   $self->communicate(command => "z");
@@ -307,6 +524,9 @@ sub home {
   }
 }
 
+
+
+
 # simple subs
 
 sub echo {