var timer;
-var clientId = Math.random();
+// var clientId = Math.random();
timer = $.timer(function() {
+ get_scan_status()
});
unfolds($("#show_main_controls"),$("#main_controls_container"));
unfolds($("#show_pmt_ro_settings"),$("#pmt_ro_settings_container"));
unfolds($("#show_table_control_settings"),$("#table_control_settings_container"));
+ $("#button_start_scan").click(function(){
+ start_scan();
+ });
+ $("#button_stop_scan").click(function(){
+ stop_scan();
+ });
+
+
+ set_clear_timer();
+
});
-function plot(){
- $.ajax({
- url: "index.pl",
- cache: false,
- async: true,
- dataType: "text",
- data: {
- action : "plot",
- tty : shared.tty,
- clientId : clientId
- },
- success: function(result) {
- $("#plotContainer").html(result);
- }
- });
-}
+
function set_clear_timer(){
- timer.set({time:1000,autostart: true});
+ timer.set({time:2000,autostart: true});
}
function stop_timer(){
}
+function get_scan_status(){
+ $.ajax({
+ url: "coral_scanner.pl",
+ cache: false,
+ async: true,
+ dataType: "text",
+ data: {
+ sub : "scan_status",
+ report : "true"
+ },
+ success: function(answer) {
+ $("#scan_status_container").html("<pre>"+answer+"</pre>");
+ }
+ });
+}
+function start_scan(){
+ $.ajax({
+ url: "coral_scanner.pl",
+ cache: false,
+ async: true,
+ dataType: "text",
+ data: {
+ sub : "start_scan"
+ },
+ success: function(answer) {
+ }
+ });
+}
+function stop_scan(){
+ $.ajax({
+ url: "coral_scanner.pl",
+ cache: false,
+ async: true,
+ dataType: "text",
+ data: {
+ sub : "stop_scan"
+ },
+ success: function(answer) {
+ }
+ });
+}
\ No newline at end of file
use SVG;
use CGI ':standard';
+use JSON;
# use settings_subs;
use has_settings;
use misc_subs;
+use shm_manager;
+
## methods
sub new {
$self->{table_control} = table_control->new();
$self->load_settings();
+
+ $self->{status_shm} = shm_manager->new( shmName => __PACKAGE__.".status" );
+ $self->{status_shm}->initShm();
+ $self->{scan_shm} = shm_manager->new( shmName => __PACKAGE__.".scan" );
+ $self->{scan_shm}->initShm();
+
return $self;
}
print "<p id='show_main_controls' class='quasibutton' >main controls</p>";
print "<div id='main_controls_container' class='stylishBox padded'>";
+
print '<div style="width: 600px; height: 270px; overflow-x: scroll;">';
$self->{table_control}->scan_pattern_to_svg(html_tag => 1);
print '</div>';
+ print '<div id="scan_container" style="width: 600px; height: 270px; overflow-x: scroll;">';
+ print '</div>';
+
+ print br;
+ print "estimated scan duration: ".hms_string($self->scan_ETA());
print br;
- print "some content!";
+
+ print "<div id='scan_status_container' class='padded'>";
+ print "<pre>";
+ $self->scan_status( report => 1 );
+ print "</pre>";
+ print "</div>";
+
+ print "<input type='button' id='button_start_scan' value='start scan'>";
+ print "<input type='button' id='button_stop_scan' value='stop scan'>";
print "</div>";
my $tc = $self->{table_control};
- $self->{current_scan} = {};
- $self->{current_scan}->{meta} = {points => 0};
- $self->{current_scan}->{data} = [];
+ my $ro = $self->{pmt_ro};
+
+
+
# $tc->home();
# $tc->scan( eval => 'print("test\n");' );
- $tc->scan( object => $self, method => 'scan_callback' );
+ my $scan_pattern = $tc->scan_pattern();
- $self->save_scan_ascii(filename => "./scan.dat");
+ my $ETA = $self->scan_ETA();
+ $self->{status_shm}->updateShm({
+ action => 'scanning',
+ abort => 0,
+ cols => $scan_pattern->{cols},
+ rows => $scan_pattern->{rows},
+ current_col => 0,
+ current_row => 0,
+ ETA => $ETA,
+ seconds_left => $ETA
+ });
-
-}
-
-sub scan_callback {
- my $self = shift;
- my $point = shift;
+ $self->{current_scan} = {};
+ $self->{current_scan}->{meta} = {
+ number_points => $scan_pattern->{number_points},
+ cols => $scan_pattern->{cols},
+ rows => $scan_pattern->{rows},
+ time_per_pixel => $self->{settings}->{time_per_pixel},
+ signal_thresh => $self->{pmt_ro}->{settings}->{signal_thresh},
+ step_size => $self->{table_control}->{settings}->{sample_step_size}
+
+ };
+ $self->{current_scan}->{data} = [];
- printf("Acquire PMT counts at point x,y = %3.3f,%3.3f i,j = %d,%d\n" ,$point->{x_rel},$point->{y_rel}, $point->{row},$point->{col});
- my $ro = $self->{pmt_ro};
+ for my $point (@{$scan_pattern->{points}}) {
+ $tc->go_xy( x => $point->{x}, y => $point->{y});
+
+ printf("Acquire PMT counts at point x,y = %3.3f,%3.3f i,j = %d,%d\n" ,$point->{x_rel},$point->{y_rel}, $point->{row},$point->{col});
+
+ my $delay = $self->{settings}->{time_per_pixel};
+ my $counts = $ro->count(delay => $delay, channel => "signal");
+ my $col = $point->{col};
+ my $row = $point->{row};
+
+ $self->{current_scan}->{data}->[$row]->[$col] = $counts;
+ print "counts: $counts\n";
+ print "\n\n";
+
+ my $status = $self->{status_shm}->lockAndReadShm();
+
+ if ($status->{abort}) {
+ $status = {
+ %$status,
+ action => "aborted",
+ abort => 0,
+ current_col => $col,
+ current_row => $row,
+ seconds_left => 0
+ };
+ $self->{status_shm}->writeShm($status);
+ $self->{scan_shm}->writeShm($self->{current_scan});
+ print "scan was aborted!\n";
+# last; # stop the acquisition loop!
+ exit;
+ } else {
+ my $seconds_left = floor($status->{ETA} * (1 - $row/$status->{rows}));
+ $status = {
+ %$status,
+ current_col => $col,
+ current_row => $row,
+ seconds_left => $seconds_left
+ };
+ $self->{status_shm}->writeShm($status);
+ }
+ }
- $self->{current_scan}->{meta}->{points}++;
- my $delay = $self->{settings}->{time_per_pixel};
- my $counts = $ro->count(delay => $delay, channel => "signal");
- my $col = $point->{col};
- my $row = $point->{row};
+ $self->{scan_shm}->writeShm($self->{current_scan});
+ $self->{status_shm}->updateShm({
+ action => 'idle',
+ seconds_left => 0
+ });
+
+ $self->save_scan_ascii(filename => "./scan.dat");
- $self->{current_scan}->{data}->[$row]->[$col] = $counts;
- print "counts: $counts\n";
-# push(@{$self->{current_scan}->{data}},{%$point,counts => $counts});
- print "\n\n";
-
}
+
sub save_scan_ascii {
my $self = shift;
my %options = @_;
my $pattern_length = 0;
my $last_point;
my $pattern = $tc->scan_pattern();
- for my $point (@$pattern){
+ for my $point (@{$pattern->{points}}){
unless(defined($last_point)){
$pattern_length += max($point->{x},$point->{y});
} else {
$last_point = $point;
}
- my $number_points = scalar(@$pattern);
+ my $number_points = $pattern->{number_points};
return $pattern_length/$speed + $number_points*$time_per_pixel;
+}
+
+sub scan_status {
+ my $self = shift;
+ my %options = @_;
+ my $json = $options{json};
+ my $report = $options{report};
+ my $status = $self->{status_shm}->readShm();
+
+ if($json){
+ print encode_json $status;
+ return " ";
+ }
+ if($report){
+ print "Machine is : ".$status->{action}."\n";
+ print "row ".$status->{current_row}."/".($status->{rows}-1)."\n";
+ print "col ".$status->{current_col}."/".($status->{cols}-1)."\n";
+ print "scan finished in ".hms_string($status->{seconds_left})."\n";
+ print "total duration ".hms_string($status->{ETA})."\n";
+ print "\n";
+ return " ";
+ } else {
+ return $status;
+ }
+
+}
+
+sub last_scan {
+ my $self = shift;
+ return $self->{scan_shm}->readShm();
}
+sub start_scan {
+ my $self= shift;
+ daemonize();
+ $self->scan_sample();
+}
+sub stop_scan {
+ my $self= shift;
+ $self->{status_shm}->updateShm({abort => 1});
+ print "sent stop signal\n";
+ return " ";
+}
+
+sub scan_to_svg {
+ my $self = shift;
+ my %options = @_;
+
+ my $tc = $self->{table_control};
+
+ my $scan = $self->{scan_shm}->readShm();
+
+ my $sample_rect_x1 = $tc->{settings}->{sample_rect_x1};
+ my $sample_rect_x2 = $tc->{settings}->{sample_rect_x2};
+ my $sample_rect_y1 = $tc->{settings}->{sample_rect_y1};
+ my $sample_rect_y2 = $tc->{settings}->{sample_rect_y2};
+
+ my $sample_rect_size_x = $sample_rect_x2 - $sample_rect_x1;
+ my $sample_rect_size_y = $sample_rect_y2 - $sample_rect_y1;
+
+ my $aperture_dia = $tc->{settings}->{sample_aperture_dia};
+
+ my $scale = 12; # pixel per mm
+
+ # create an SVG object with a size of 40x40 pixels
+
+ my $pic_width = ($sample_rect_size_x+5)*$scale;
+ my $pic_height = 250;
+
+ my $svg = SVG->new(
+ -printerror => 1,
+ -raiseerror => 0,
+ -indent => ' ',
+ -docroot => 'svg', #default document root element (SVG specification assumes svg). Defaults to 'svg' if undefined
+ -inline => 1,
+ id => 'document_element',
+ width => $pic_width,
+ height => $pic_height,
+ );
+
+
+
+
+}
package misc_subs;
-
+use POSIX;
BEGIN {
require Exporter;
# Inherit from Exporter to export functions and variables
our @ISA = qw(Exporter);
# Functions and variables which are exported by default
- our @EXPORT = qw(printHeader min max echo require_run test);
+ our @EXPORT = qw(printHeader min max echo require_run test hms_string daemonize);
# Functions and variables which can be optionally exported
#our @EXPORT_OK = qw($Var1 %Hashit func3);
}
}
}
+sub hms_string {
+ my $s = shift;
+
+ my $hours = floor($s/3600);
+ my $mins = floor($s/60)-$hours*60;
+ my $secs = floor($s)-$hours*3600-$mins*60;
+
+ my $string = "";
+ $string .= $hours." h, " if $hours;
+ $string .= $mins." m, " if $mins;
+ $string .= $secs." s";
+ return $string;
+}
+
+sub daemonize {
+ # chdir '/' or die "Can't chdir to /: $!";
+
+ defined(my $pid = fork) or die "Can't fork: $!";
+ if($pid){
+# printHeader('text/plain') if $isHttpReq;
+ print "this instance has terminated, the other one is a demon now\n";
+ exit;
+ }
+ open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
+ open STDOUT, '>>/dev/null' or die "Can't write to /dev/null: $!";
+ open STDERR, '>>/dev/null' or die "Can't write to /dev/null: $!";
+ POSIX::setsid or die "Can't start a new session: $!";
+ umask 0;
+}
1;
\ No newline at end of file
%options
};
bless($self, $class);
-
+ $self->load_settings();
return $self;
}
sub setup_regio {
my $self = shift;
- $self->require_run("load_settings");
+# $self->require_run("load_settings");
my $regio_options = {
tty => $self->{settings}->{tty},
my $self = shift;
my %options = @_;
- $self->require_run("load_settings");
+# $self->require_run("load_settings");
$self->require_run("setup_regio");
$self->signal_thresh(value => $self->{settings}->{signal_thresh});
my $self = shift;
my %options = @_;
- $self->require_run("load_settings");
+# $self->require_run("load_settings");
$self->require_run("setup_regio");
die "device zero offset calibration has to be performed first!\n
my $self = shift;
my %options = @_;
- $self->require_run("load_settings");
+# $self->require_run("load_settings");
$self->require_run("setup_regio");
die "device zero offset calibration has to be performed first!\n
my $self = shift;
my %options = @_;
- $self->require_run("load_settings");
+# $self->require_run("load_settings");
$self->require_run("setup_regio");
my $value = $options{value};
my $self = shift;
my %options = @_;
- $self->require_run("load_settings");
+# $self->require_run("load_settings");
$self->require_run("setup_regio");
my $value = $options{value};
my $self = shift;
my %options = @_;
- $self->require_run("load_settings");
+# $self->require_run("load_settings");
my $value = $options{value};
my $unit = $options{unit}||"cycles";
my $self = shift;
my %options = @_;
- $self->require_run("load_settings");
+# $self->require_run("load_settings");
$self->require_run("setup_regio");
my $iterations = $options{iterations} || 26;
my $self = shift;
my %options = @_;
- $self->require_run("load_settings");
+# $self->require_run("load_settings");
$self->require_run("setup_regio");
my $channel = $options{channel}; # can be "signal" or "veto" or "net"
my $self = shift;
my %options = @_;
- $self->require_run("load_settings");
+# $self->require_run("load_settings");
$self->require_run("setup_regio");
my $use_zero_calib = 1;
my $self = shift;
my %options = @_;
- $self->require_run("load_settings");
+# $self->require_run("load_settings");
$self->require_run("setup_regio");
my $counter_addr = $options{counter_addr};
my $self = shift;
my %options = @_;
- $self->require_run("load_settings");
+# $self->require_run("load_settings");
$self->require_run("setup_regio");
my $addr = $options{addr};
my $self = shift;
my %options = @_;
- $self->require_run("load_settings");
+# $self->require_run("load_settings");
$self->require_run("setup_regio");
my $addr = $options{addr};
--- /dev/null
+package shm_manager;
+
+
+use strict;
+use warnings;
+use POSIX;
+
+use Storable qw(lock_store lock_retrieve fd_retrieve nstore_fd);
+use Fcntl qw(:DEFAULT :flock);
+
+sub new {
+ my $class = shift;
+ my %options = @_;
+ my $self = {
+ %options
+ };
+
+ die "shm_manager must get an shmName" unless defined($self->{shmName});
+
+ $self->{shmFile} = "/dev/shm/".$self->{shmName};
+# $self->{dataDir} = $self->{shmFile}."_data";
+# $self->{dataFile} = $self->{dataDir}."/data";
+
+ $self->{shmFhLocked} = 0;
+ bless($self, $class);
+}
+
+
+sub initShm {
+ my $self = shift;
+ unless($self->existShm()){
+ $self->createShm();
+ }
+
+}
+
+sub existShm {
+ my $self = shift;
+ return 1 if( -e $self->{shmFile} );
+ return 0;
+}
+
+sub createShm {
+ my $self = shift;
+ die "shm ".$self->{shmFile}." already exists!\n" if( -e $self->{shmFile} );
+
+ lock_store({},$self->{shmFile});
+# die "data directory ".$self->{dataDir}." already exists!\n" if( -e $self->{dataDir} );
+# mkdir $self->{dataDir};
+};
+
+
+sub deleteShm {
+ my $self = shift;
+ unlink $self->{shmFile};
+ system("rm -rf ".$self->{dataDir});
+}
+
+sub readShm {
+ my $self = shift;
+
+ if ( -e $self->{shmFile} ){
+ return lock_retrieve($self->{shmFile});
+ } else {
+ die "shm does not exist!";
+ }
+}
+
+sub lockAndReadShm {
+ my $self = shift;
+
+ if ( -e $self->{shmFile} ){
+ die "Shm file handle already open and locked!\n" if $self->{shmFhLocked};
+ sysopen(my $fh, $self->{shmFile}, O_RDWR|O_CREAT, 0666)
+ or die "can't open shm file: $!";
+ flock($fh, LOCK_EX) or die "can't lock shm file: $!";
+ $self->{shmFhLocked} = 1;
+ $self->{shmFh} = $fh; # store file handle in object
+ # attention! file handle is now still open!
+ return fd_retrieve(*$fh);
+ } else {
+ die "shm does not exist!";
+ }
+}
+
+## deprecated
+
+# sub writeShm {
+# my $self = shift;
+# my $shmHash = shift;
+# if ( -e $self->{shmFile} ){
+# lock_store($shmHash,$self->{shmFile});
+# } else {
+# die "shm does not exist!\n";
+# }
+# }
+
+sub writeShm { # closes and unlocks shm file if already open
+ my $self = shift;
+ my $shmHash = shift;
+
+ if ( -e $self->{shmFile} ){
+ my $fh=$self->{shmFh};
+ #check if file handle still open and locked
+ unless($self->{shmFhLocked}){
+ print "found locked shm from previous lock-and-read\n";
+ sysopen($fh, $self->{shmFile}, O_RDWR|O_CREAT, 0666)
+ or die "can't open shm file: $!";
+ flock($fh, LOCK_EX) or die "can't lock shm file: $!";
+ }
+ #in any case, store your hash in shm file
+ seek($fh,0,0);
+ nstore_fd($shmHash, *$fh)
+ or die "can't store hash\n";
+ truncate($fh, tell($fh));
+ close($fh);
+ $self->{shmFhLocked} = 0;# mark file handle as unlocked
+ return $shmHash;
+ } else {
+ die "shm does not exist!";
+ }
+}
+
+
+
+sub updateShm {
+ my $self = shift;
+ my $shmHash = shift;
+
+ my $oldShmHash = $self->lockAndReadShm();
+ my $compositeShmHash = {%$oldShmHash,%$shmHash};
+ $self->writeShm($compositeShmHash);
+ return $compositeShmHash;
+}
+
+
+1;
\ No newline at end of file
my $sample_rect_size_y = $sample_rect_y2 - $sample_rect_y1;
- my $steps_in_x = floor($sample_rect_size_x / $sample_step_size) +1;
+ my $steps_in_x = floor(min($sample_rect_size_x,$self->{settings}->{mm_to_scan}) / $sample_step_size) +1;
+ $steps_in_x = min($steps_in_x, $self->{settings}->{rows_to_scan} );
my $steps_in_y = floor($sample_rect_size_y / $sample_step_size) +1;
my $coordinate_array = [];
for( my $i = 0; $i < $steps_in_x; $i++ ) {
- last if ($i >= $self->{settings}->{rows_to_scan});
- last if ($i*$sample_step_size > $self->{settings}->{mm_to_scan});
-
-
for( my $j = 0; $j < $steps_in_y; $j++ ) {
if( $style eq "linebyline" ) {
}
- return $coordinate_array;
+ return { points => $coordinate_array, cols => $steps_in_y, rows => $steps_in_x, number_points => scalar(@$coordinate_array) };
}
sub scan_pattern_to_svg {
my $self = shift;
my %options = @_;
- my $style = $options{style};
my $html_tag = $options{html_tag};
#$self->require_run("load_settings");
my $svg_file = $options{svg_file};
- my $scan_pattern = $self->scan_pattern(style => $style);
+ my $scan_pattern = $self->scan_pattern();
my $sample_rect_x1 = $self->{settings}->{sample_rect_x1};
my $lastpoint;
my $counter=0;
- for my $point (@$scan_pattern) {
+ for my $point (@{$scan_pattern->{points}}) {
last if (
($point->{x_rel})*$scale > $pic_width
}
-sub scan {
- my $self = shift;
- my %options = @_;
-
- my $eval = $options{eval};
- my $subref = $options{subref};
-
- my $method = $options{method};
- my $object = $options{object};
-
- #$self->require_run("load_settings");
-
- for my $point (@{$self->scan_pattern()}) {
-
-# last if ($point->{row} >= $self->{settings}->{rows_to_scan});
-
- $self->go_xy( x => $point->{x}, y => $point->{y});
- eval $eval if defined($eval);
- $subref->($point) if defined($subref);
- if(defined($object) && defined($method)){
- $object->$method($point);
- }
- }
-
-}
+# sub scan {
+# my $self = shift;
+# my %options = @_;
+#
+# my $scan_pattern = $options{scan_pattern};
+# unless(defined($scan_pattern)) {
+# $scan_pattern = $self->scan_pattern();
+# }
+#
+# my $eval = $options{eval};
+# my $subref = $options{subref};
+#
+# my $method = $options{method};
+# my $object = $options{object};
+#
+#
+# for my $point (@{$scan_pattern->{points}}) {
+#
+#
+# $self->go_xy( x => $point->{x}, y => $point->{y});
+# eval $eval if defined($eval);
+# $subref->($point) if defined($subref);
+# if(defined($object) && defined($method)){
+# $object->$method($point);
+# }
+# }
+#
+# }
sub set_zero {