From 96f058c06102add29bca9c1b6a42c30114797fd7 Mon Sep 17 00:00:00 2001 From: Michael Wiebusch Date: Tue, 13 Jan 2015 16:14:58 +0100 Subject: [PATCH] great progress ... can now draw meander pattern as svg and move the table along pattern --- user_interface/table_control.pl | 6 +- user_interface/table_control.pm | 262 +++++++++++++++++++++++++++++--- 2 files changed, 246 insertions(+), 22 deletions(-) diff --git a/user_interface/table_control.pl b/user_interface/table_control.pl index df99afb..ecc158f 100755 --- 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 ab09c1b..366b396 100644 --- 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 { -- 2.43.0