Uživatel:Kychot/emgdb-proto.pl
Vzhled
#! /usr/bin/perl -w
# emgdb-proto - příprava protokolů
# v. 0.33
## %breath46
## oprava inkrementů (sekundy, ne minuty)
use 5.010;
@stim = (
[],
[ qw(sole calf HMS paracocc ang_costae m_trapesius)],
[ qw(sole calf HMS paracocc ang_costae)],
);
sub sec2timestr { # převede sekundy na string mm:ss
my($sec) = @_;
my $min = int($sec/60); $sec -= 60*$min;
sprintf ("%2d:%02d", $min, $sec);
}
sub timestr2sec { # převede mm:ss na sekundy
my($min,$sec) = split /:/,@_;
60*$min+$sec;
}
print "investigation:\t", scalar <>;
print "date:\t\t", scalar <>;
print "person:\t\t", scalar <>;
my $currtime = '~'; # current timepoint; tilde ~ means NULL, i.e. no matter
my $ang_costae = undef;
while (<>) {
if(/^[A-M0-9]$/){print "letter:\t\t$&\n"; $currtime = '~'; next;}
if(/.*EXP/) {print "expfile:\t$&\n"; $currtime = '~'; next;}
if(/^%(\S+)(\s+(.*))?/) { # macro
my($macro, $value) = ($1, $3);
print ";$_"; # print original macro as comment line
given ($macro) {
when ('ang_costae') {$ang_costae = $value; print ";ang_costae$value\n";}
when ('simons') {print "~\t #all amplifier: filter,low =100 [Hz]\n".
"~\t #all amplifier: filter,high =1 [kHz]\n";}
when ('4chLRsc') { # Left surface, Left coaxial, Right surface, Right coaxial
print "~\t #1 electrode: surface sin\n".
"~\t #2 electrode: coaxial sin\n".
"~\t #3 electrode: surface dx\n".
"~\t #4 electrode: coaxial dx\n";}
when ('4chLRcs') { # Left coaxial, Left surface, Right coaxial, Right surface
print "~\t #1 electrode: coaxial sin\n".
"~\t #2 electrode: surface sin\n".
"~\t #3 electrode: coaxial dx\n".
"~\t #4 electrode: surface dx\n";}
when ('4chRLcs') { # Right coaxial, Right surface, Left coaxial, Left surface
print "~\t #1 electrode: coaxial dx\n".
"~\t #2 electrode: surface dx\n".
"~\t #3 electrode: coaxial sin\n".
"~\t #4 electrode: surface sin\n";}
when ('4chcsLR') { # Left coaxial, Right coaxial, Left surface, Right surface
print "~\t #1 electrode: coaxial sin\n".
"~\t #2 electrode: coaxial sin\n".
"~\t #3 electrode: surface dx\n".
"~\t #4 electrode: surface dx\n";}
default {die 'Neznámé makro %'.$macro;}
}
next;
}
if(/^(\d+\:\d+)/) { $currtime = $1; }
if(/^~/) { $currtime = '~'; } # undef
if(/^(\d+)\s+(%.*)/){ # údaj začátku stimulace v celých minutách – časové makro
my($time, $what) = ($1, $2);
print ";$_"; # print original macro as comment line
if($what =~ /stim(\d+)/){ # začátek stimulace
my $ps = $1; # protocol of stimulation
my $i = 0;
foreach my $point(@{$stim[$ps]}) {
if($ang_costae) {$point =~ s/ang_costae/ang_costae$ang_costae/;}
printf "%02d:00+00:10\tpress: %s sin\n", $time++, $point;
printf "%02d:00+00:10\tpress: %s dx\n", $time++, $point;
$currtime = sprintf "%02d:10", $time;
}
}
# u všech cyklů: 0. sekunda nádech
elsif ($what =~ /breath1\s+(\d+)/) { # 10s cyklus: 5. sek. výdech
my $sec = 60*$time;
for(my $i=$1; $i--;) {
print sec2timestr($sec) ."+00:05\tbreath: inspir\n";
print sec2timestr($sec+=5)."+00:05\tbreath: expir\n";
$sec+=5;
}
}
elsif ($what =~ /breath8\s+(\d+)/) { # 15s cyklus: 8. sekunda výdech
my $sec = 60*$time;
for(my $i=$1; $i--;) {
print sec2timestr($sec) ."+00:08\tbreath: inspir\n";
print sec2timestr($sec+=8)."+00:07\tbreath: expir\n";
$sec+=7;
}
}
elsif ($what =~ /breath2\s+(\d+)/) { # 15s cyklus: 5. sekunda zadržení, 10. sek. výdech
my $sec = 60*$time;
for(my $i=$1; $i--;) {
print sec2timestr($sec) ."+00:05\tbreath: inspir\n";
print sec2timestr($sec+=5)."+00:05\tbreath: hold\n";
print sec2timestr($sec+=5)."+00:05\tbreath: expir\n";
$sec+=5;
}
}
elsif ($what =~ /breath46\s+(\d+)/) { # 10s cyklus: 4.sekunda zadržení, 6. sek. výdech
my $sec = 60*$time;
for(my $i=$1; $i--;) {
print sec2timestr($sec) ."+00:04\tbreath: inspir\n";
print sec2timestr($sec+=4)."+00:02\tbreath: hold\n";
print sec2timestr($sec+=2)."+00:04\tbreath: expir\n";
$sec+=4;
}
}
else {print ";^^^^^^^^DIVNÝ ŘÁDEK($what)^^^^^^^^:\n";}
next;
}
if(/^(\S+)\s+%gain\s+(.*)/) {
($time, $value) = ($1, $2);
print "$time\t ";
print ( ($value =~ s/(\#\S+) //) ? "$1 " : '#all ');
print "amplifier: gain =$value [uV/DIV]\n";
next;
}
if (s/^:\s//) {print "$currtime\t";}
s/ (MB|kHz|Hz|mm|CET|CEST|alg|uV\/DIV)/ [$1]/g; # jednotky do hranatých závorek
s/(\d+(.\d+)?) \[MB\]/~$1 [MB]/; # tildu před hodnotu v MB
s/ (\d+(:\d+)?) / =$1 /; # rovnítko před hodnotu
print;
}
print @{$stim[0]};