summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ROM.lpr138
-rw-r--r--ROM.lps120
-rw-r--r--romunit.pas271
3 files changed, 283 insertions, 246 deletions
diff --git a/ROM.lpr b/ROM.lpr
index 034fb35..0dc1eba 100644
--- a/ROM.lpr
+++ b/ROM.lpr
@@ -10,7 +10,7 @@ uses
{$ENDIF}{$ENDIF}
Classes
{ you can add units after this },
- SysUtils,ROMunit, matheunit, Math, systemunit, lowlevelunit;
+ SysUtils,ROMunit, matheunit, Math, systemunit, lowlevelunit, mystringlistunit;
var
inPulsO,inPuls,refPulsO,refPuls,surTraj,cRefPuls,
@@ -18,16 +18,17 @@ var
smooth,betaSmooth,veloSmooth: longint;
tmax,wmax,absShift,betaBound,veloBound,fftBreite: extended;
force,fourier,mitAmplMod: boolean;
- f: textfile;
- s,t,u,lpicIn,rohIn,rohRef,outIn,
+ f,bekannteBefehle: tMyStringList;
+ s,lpicIn,rohIn,rohRef,outIn,
outRef,outRefC,outSur,outVel: string;
-//const Verwendung='Verwendung: ROM ($Einfallspuls_Datei $Ausfallspuls_Datei)/(- $trace-Datei-Prefix) $output_inPuls $output_refPuls $output_Trajektorie $output_cRefPuls '+
-// '[-s/--smooth $n] [-f/--force] [-t/--tmax $t] [-w/--wmax $w] [-F/--FFT] [-d/--dt $dt]';
-const Verwendung='Verwendung: ROM $Parameterdatei';
+const
+ Verwendung='Verwendung: ROM $Parameterdatei';
begin
- if (paramcount<>1) or not fileexists(paramstr(1)) then Fehler(Verwendung);
+ if (paramcount<>1) or
+ not fileexists(paramstr(1)) then
+ Fehler(Verwendung);
force:=false;
smooth:=1;
@@ -51,88 +52,59 @@ begin
outSur:='';
outVel:='';
- assignfile(f,paramstr(1));
- reset(f);
- while not eof(f) do begin
- readln(f,s);
- s:=shellSubst(s);
- if pos('#',s)>0 then
- delete(s,pos('#',s),length(s));
- s:=trim(s);
- if s='' then continue;
- if pos('?',s)=1 then begin
- delete(s,1,1);
- t:=trim(leftStr(s,pos('=',s)-1));
- delete(s,1,pos('=',s));
- u:=trim(leftStr(s,pos(':',s)-1));
- delete(s,1,pos(':',s));
- s:=trim(s);
- if t<>u then
- continue;
- end;
-
- if s='mit Gewalt' then begin
+ f:=tMyStringList.create;
+ f.loadFromFile(paramstr(1));
+ f.unfoldMacros;
+ bekannteBefehle:=tMyStringList.create;
+ while f.readln(s) do begin
+ bekannteBefehle.clear;
+ if istDasBefehl('mit Gewalt',s,bekannteBefehle,false) then begin
force:=true;
continue;
end;
- if s='ohne Gewalt' then begin
+ if istDasBefehl('ohne Gewalt',s,bekannteBefehle,false) then begin
force:=false;
continue;
end;
- if s='mit Amplitudenmodulation' then begin
+ if istDasBefehl('mit Amplitudenmodulation',s,bekannteBefehle,false) then begin
mitAmplMod:=true;
continue;
end;
- if (s='ohne Amplitudenmodulation') or
- (s='nur Phasenmodulation') then begin
+ if istDasBefehl('ohne Amplitudenmodulation',s,bekannteBefehle,false) or
+ istDasBefehl('nur Phasenmodulation',s,bekannteBefehle,false) then begin
mitAmplMod:=false;
continue;
end;
- if pos('Glätte:',s)=1 then begin
- delete(s,1,pos(':',s));
- s:=trim(s);
+ if istDasBefehl('Glätte:',s,bekannteBefehle,true) then begin
smooth:=strtoint(s);
continue;
end;
- if pos('Trajektoriengeschwindigkeitsglätte:',s)=1 then begin
- delete(s,1,pos(':',s));
- s:=trim(s);
+ if istDasBefehl('Trajektoriengeschwindigkeitsglätte:',s,bekannteBefehle,true) then begin
veloSmooth:=strtoint(s);
continue;
end;
- if pos('Trajektorien-Maximalgeschwindigkeit:',s)=1 then begin
- delete(s,1,pos(':',s));
- s:=trim(s);
+ if istDasBefehl('Trajektorien-Maximalgeschwindigkeit:',s,bekannteBefehle,true) then begin
veloBound:=strtofloat(s);
continue;
end;
- if pos('Betaglätte:',s)=1 then begin
- delete(s,1,pos(':',s));
- s:=trim(s);
+ if istDasBefehl('Betaglätte:',s,bekannteBefehle,true) then begin
betaSmooth:=strtoint(s);
continue;
end;
- if pos('AM-Maximalgeschwindigkeit:',s)=1 then begin
- delete(s,1,pos(':',s));
- s:=trim(s);
+ if istDasBefehl('AM-Maximalgeschwindigkeit:',s,bekannteBefehle,true) then begin
betaBound:=strtofloat(s);
continue;
end;
- if pos('tmax:',s)=1 then begin
- delete(s,1,pos(':',s));
- s:=trim(s);
+ if istDasBefehl('tmax:',s,bekannteBefehle,true) then begin
tmax:=strtofloat(s);
continue;
end;
- if (pos('wmax:',s)=1) or (pos('ωmax:',s)=1) then begin
- delete(s,1,pos(':',s));
- s:=trim(s);
+ if istDasBefehl('wmax:',s,bekannteBefehle,true) or
+ istDasBefehl('ωmax:',s,bekannteBefehle,true) then begin
wmax:=strtofloat(s);
continue;
end;
- if (pos('Absolutverschiebung:',s)=1) then begin
- delete(s,1,pos(':',s));
- s:=trim(s);
+ if istDasBefehl('Absolutverschiebung:',s,bekannteBefehle,true) then begin
if s='auto' then begin
absShift:=-1e9;
continue;
@@ -148,58 +120,51 @@ begin
fourier:=true;
continue;
end;
- if pos('FFT-Breite:',s)=1 then begin
- delete(s,1,pos(':',s));
- fftBreite:=strToFloat(trim(s));
+ if istDasBefehl('FFT-Breite:',s,bekannteBefehle,true) then begin
+ fftBreite:=strToFloat(s);
continue;
end;
if s='ohne FFT' then begin
fourier:=false;
continue;
end;
- if pos('lpic-Quelle:',s)=1 then begin
- delete(s,1,pos(':',s));
- lpicIn:=trim(s);
+ if istDasBefehl('lpic-Quelle:',s,bekannteBefehle,true) then begin
+ lpicIn:=s;
continue;
end;
- if pos('in-Quelle:',s)=1 then begin
- delete(s,1,pos(':',s));
- rohIn:=trim(s);
+ if istDasBefehl('in-Quelle:',s,bekannteBefehle,true) then begin
+ rohIn:=s;
continue;
end;
- if pos('reflex-Quelle:',s)=1 then begin
- delete(s,1,pos(':',s));
- rohRef:=trim(s);
+ if istDasBefehl('reflex-Quelle:',s,bekannteBefehle,true) then begin
+ rohRef:=s;
continue;
end;
- if pos('in-Ziel:',s)=1 then begin
- delete(s,1,pos(':',s));
- outIn:=trim(s);
+ if istDasBefehl('in-Ziel:',s,bekannteBefehle,true) then begin
+ outIn:=s;
continue;
end;
- if pos('reflex-Ziel:',s)=1 then begin
- delete(s,1,pos(':',s));
- outRef:=trim(s);
+ if istDasBefehl('reflex-Ziel:',s,bekannteBefehle,true) then begin
+ outRef:=s;
continue;
end;
- if pos('reflex-Approx-Ziel:',s)=1 then begin
- delete(s,1,pos(':',s));
- outRefC:=trim(s);
+ if istDasBefehl('reflex-Approx-Ziel:',s,bekannteBefehle,true) then begin
+ outRefC:=s;
continue;
end;
- if pos('trajektorie-Ziel:',s)=1 then begin
- delete(s,1,pos(':',s));
- outSur:=trim(s);
+ if istDasBefehl('trajektorie-Ziel:',s,bekannteBefehle,true) then begin
+ outSur:=s;
continue;
end;
- if pos('geschwindigkeit-Ziel:',s)=1 then begin
- delete(s,1,pos(':',s));
- outVel:=trim(s);
+ if istDasBefehl('geschwindigkeit-Ziel:',s,bekannteBefehle,true) then begin
+ outVel:=s;
continue;
end;
- Fehler('Unbekannter Parameter '''+s+''' in Inputdatei '''+paramstr(1)+'''!');
+ bekannteBefehle.sort;
+ Fehler('Unbekannter Parameter '''+s+''' in Inputdatei '''+paramstr(1)+'''!'#10'Ich kenne nur:'#10+bekannteBefehle.text);
end;
- closefile(f);
+ bekannteBefehle.free;
+ f.free;
if (absShift<-1.5e9) and (lpicIn='') then
Fehler('Ich brauche zur Bestimmung der Gesamtverschiebung die Inputdatei vom LPIC!');
@@ -350,6 +315,7 @@ begin
else
writeOutput(outVel,surVel);
end;
- if outRefC<>'' then writeOutput(outRefC,cRefPuls);
+ if outRefC<>'' then
+ writeOutput(outRefC,cRefPuls);
end.
diff --git a/ROM.lps b/ROM.lps
index 90b1a22..6572224 100644
--- a/ROM.lps
+++ b/ROM.lps
@@ -3,13 +3,12 @@
<ProjectSession>
<Version Value="10"/>
<BuildModes Active="Default"/>
- <Units Count="6">
+ <Units Count="7">
<Unit0>
<Filename Value="ROM.lpr"/>
<IsPartOfProject Value="True"/>
- <TopLine Value="287"/>
- <CursorPos X="11" Y="319"/>
- <UsageCount Value="106"/>
+ <CursorPos X="5" Y="31"/>
+ <UsageCount Value="107"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
@@ -17,10 +16,10 @@
<IsPartOfProject Value="True"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="1"/>
- <TopLine Value="1066"/>
- <CursorPos X="3" Y="1095"/>
- <FoldState Value=" T3iF04052F"/>
- <UsageCount Value="106"/>
+ <TopLine Value="179"/>
+ <CursorPos X="11" Y="202"/>
+ <FoldState Value=" T3iF04053 pidrN0A1="/>
+ <UsageCount Value="107"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
@@ -28,7 +27,7 @@
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<CursorPos Y="10"/>
- <UsageCount Value="105"/>
+ <UsageCount Value="106"/>
</Unit2>
<Unit3>
<Filename Value="../units/matheunit.pas"/>
@@ -44,130 +43,137 @@
</Unit4>
<Unit5>
<Filename Value="../units/systemunit.pas"/>
- <EditorIndex Value="2"/>
+ <EditorIndex Value="-1"/>
<CursorPos Y="16"/>
<UsageCount Value="15"/>
- <Loaded Value="True"/>
</Unit5>
+ <Unit6>
+ <Filename Value="../units/lowlevelunit.pas"/>
+ <EditorIndex Value="-1"/>
+ <TopLine Value="10"/>
+ <CursorPos X="10" Y="121"/>
+ <UsageCount Value="10"/>
+ </Unit6>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
- <Filename Value="romunit.pas"/>
- <Caret Line="966" Column="30" TopLine="953"/>
+ <Filename Value="ROM.lpr"/>
</Position1>
<Position2>
- <Filename Value="romunit.pas"/>
- <Caret Line="1045" Column="48" TopLine="988"/>
+ <Filename Value="ROM.lpr"/>
+ <Caret Line="18" Column="9"/>
</Position2>
<Position3>
- <Filename Value="romunit.pas"/>
+ <Filename Value="ROM.lpr"/>
+ <Caret Line="26" Column="19"/>
</Position3>
<Position4>
- <Filename Value="romunit.pas"/>
- <Caret Line="45" Column="20" TopLine="31"/>
+ <Filename Value="ROM.lpr"/>
+ <Caret Line="33" Column="9" TopLine="4"/>
</Position4>
<Position5>
- <Filename Value="romunit.pas"/>
- <Caret Line="316" Column="42" TopLine="329"/>
+ <Filename Value="ROM.lpr"/>
+ <Caret Line="93" Column="13" TopLine="64"/>
</Position5>
<Position6>
<Filename Value="ROM.lpr"/>
- <Caret Line="183" Column="98" TopLine="168"/>
+ <Caret Line="256" Column="21" TopLine="234"/>
</Position6>
<Position7>
- <Filename Value="ROM.lpr"/>
+ <Filename Value="romunit.pas"/>
+ <Caret Line="23" Column="29" TopLine="5"/>
</Position7>
<Position8>
<Filename Value="ROM.lpr"/>
- <Caret Line="18" Column="9"/>
+ <Caret Line="258" Column="14" TopLine="234"/>
</Position8>
<Position9>
- <Filename Value="ROM.lpr"/>
- <Caret Line="26" Column="19"/>
+ <Filename Value="romunit.pas"/>
+ <Caret Line="15" Column="30"/>
</Position9>
<Position10>
- <Filename Value="ROM.lpr"/>
- <Caret Line="33" Column="9" TopLine="4"/>
+ <Filename Value="romunit.pas"/>
+ <Caret Line="32" Column="23" TopLine="14"/>
</Position10>
<Position11>
- <Filename Value="ROM.lpr"/>
- <Caret Line="93" Column="13" TopLine="64"/>
+ <Filename Value="romunit.pas"/>
+ <Caret Line="876" Column="31"/>
</Position11>
<Position12>
- <Filename Value="ROM.lpr"/>
- <Caret Line="256" Column="21" TopLine="234"/>
+ <Filename Value="romunit.pas"/>
+ <Caret Line="888" TopLine="865"/>
</Position12>
<Position13>
<Filename Value="romunit.pas"/>
- <Caret Line="23" Column="29" TopLine="5"/>
+ <Caret Line="36"/>
</Position13>
<Position14>
- <Filename Value="ROM.lpr"/>
- <Caret Line="258" Column="14" TopLine="234"/>
+ <Filename Value="romunit.pas"/>
+ <Caret Line="1063" Column="40" TopLine="1041"/>
</Position14>
<Position15>
<Filename Value="romunit.pas"/>
- <Caret Line="15" Column="30"/>
+ <Caret Line="1062" Column="26" TopLine="1041"/>
</Position15>
<Position16>
- <Filename Value="ROM.lpr"/>
- <Caret Line="258" Column="14" TopLine="264"/>
+ <Filename Value="romunit.pas"/>
+ <Caret Line="1068" Column="72" TopLine="1042"/>
</Position16>
<Position17>
- <Filename Value="romunit.pas"/>
- <Caret Line="32" Column="23" TopLine="14"/>
+ <Filename Value="ROM.lpr"/>
+ <Caret Line="286" Column="22" TopLine="139"/>
</Position17>
<Position18>
- <Filename Value="romunit.pas"/>
- <Caret Line="876" Column="31"/>
+ <Filename Value="ROM.lpr"/>
+ <Caret Line="280" Column="25" TopLine="254"/>
</Position18>
<Position19>
- <Filename Value="romunit.pas"/>
- <Caret Line="888" TopLine="865"/>
+ <Filename Value="ROM.lpr"/>
+ <Caret Line="17" Column="11"/>
</Position19>
<Position20>
- <Filename Value="romunit.pas"/>
- <Caret Line="36"/>
+ <Filename Value="ROM.lpr"/>
+ <Caret Line="271" Column="26" TopLine="257"/>
</Position20>
<Position21>
<Filename Value="romunit.pas"/>
- <Caret Line="1063" Column="40" TopLine="1041"/>
+ <Caret Line="26" Column="19" TopLine="8"/>
</Position21>
<Position22>
- <Filename Value="romunit.pas"/>
- <Caret Line="1062" Column="26" TopLine="1041"/>
+ <Filename Value="ROM.lpr"/>
+ <Caret Line="286" Column="37" TopLine="257"/>
</Position22>
<Position23>
<Filename Value="romunit.pas"/>
- <Caret Line="1068" Column="72" TopLine="1042"/>
+ <Caret Line="35" Column="61" TopLine="17"/>
</Position23>
<Position24>
<Filename Value="ROM.lpr"/>
- <Caret Line="286" Column="22" TopLine="139"/>
+ <Caret Line="151" Column="15" TopLine="122"/>
</Position24>
<Position25>
<Filename Value="ROM.lpr"/>
- <Caret Line="280" Column="25" TopLine="254"/>
+ <Caret Line="21" Column="58" TopLine="16"/>
</Position25>
<Position26>
<Filename Value="ROM.lpr"/>
- <Caret Line="17" Column="11"/>
+ <Caret Line="183" Column="25" TopLine="154"/>
</Position26>
<Position27>
<Filename Value="ROM.lpr"/>
- <Caret Line="271" Column="26" TopLine="257"/>
+ <Caret Line="165" Column="6" TopLine="152"/>
</Position27>
<Position28>
- <Filename Value="romunit.pas"/>
- <Caret Line="26" Column="19" TopLine="8"/>
+ <Filename Value="ROM.lpr"/>
+ <Caret Line="59" Column="29" TopLine="35"/>
</Position28>
<Position29>
<Filename Value="ROM.lpr"/>
- <Caret Line="286" Column="37" TopLine="257"/>
+ <Caret Line="166" Column="9" TopLine="147"/>
</Position29>
<Position30>
<Filename Value="romunit.pas"/>
- <Caret Line="35" Column="61" TopLine="17"/>
+ <Caret Line="1036" Column="116" TopLine="1015"/>
</Position30>
</JumpHistory>
</ProjectSession>
diff --git a/romunit.pas b/romunit.pas
index bfd4ca9..f62b8fe 100644
--- a/romunit.pas
+++ b/romunit.pas
@@ -63,17 +63,19 @@ begin
end;
procedure readRawInputs(nam: string; out d1,d2: tExtPointArray; var absShift: extended);
-var f: file;
- tf: textfile;
- s: string;
- i,j,k,start,stop,traces,steps: longint;
- i32: int32;
- sr: tSearchRec;
- fl: single;
- buff: array of single;
- factor,dx,cells_left,maxAmp: extended;
+var
+ f: file;
+ tf: textfile;
+ s: string;
+ i,j,k,start,stop,traces,steps: longint;
+ i32: int32;
+ sr: tSearchRec;
+ fl: single;
+ buff: array of single;
+ factor,dx,cells_left,maxAmp: extended;
begin
- if not fileexists(nam) then Fehler('Die Datei '''+nam+''' existiert nicht!');
+ if not fileexists(nam) then
+ Fehler('Die Datei '''+nam+''' existiert nicht!');
assignfile(tf,nam);
i:=0;
reset(tf);
@@ -143,7 +145,11 @@ begin
end{of case};
end;
closefile(tf);
- if (not odd(i)) or ((absShift<-1.5e9) and ((dx=0) or (cells_left=0))) then Fehler('Unerwartetes Dateiende in '''+nam+'''!');
+ if (not odd(i)) or
+ ((absShift<-1.5e9) and
+ ((dx=0) or
+ (cells_left=0))) then
+ Fehler('Unerwartetes Dateiende in '''+nam+'''!');
setlength(d1,0);
setlength(d2,0);
@@ -192,7 +198,8 @@ begin
for j:=0 to traces-1 do begin
blockread(f,fl,sizeof(single)); // x-Position
if j=0 then begin
- if i=start then cells_left:=cells_left-fl;
+ if i=start then
+ cells_left:=cells_left-fl;
blockread(f,buff[0],sizeof(single)*steps); // fp
for k:=0 to steps-1 do begin
d1[k+length(d1)-steps]['x']:=(i-1+k/steps)*factor;
@@ -221,9 +228,10 @@ begin
end;
procedure readTextInput(nam: string; out dat: tExtPointArray);
-var f: textfile;
- i: longint;
- s: string;
+var
+ f: textfile;
+ i: longint;
+ s: string;
begin
if not fileexists(nam) then
Fehler('Datei '''+nam+''' existiert nicht!');
@@ -233,9 +241,12 @@ begin
i:=0;
while not eof(f) do begin
readln(f,s);
- if pos('#',s)>0 then delete(s,pos('#',s),length(s));
- while (length(s)>0) and (s[1]=' ') do delete(s,1,1);
- if s='' then continue;
+ if pos('#',s)>0 then
+ delete(s,pos('#',s),length(s));
+ while (length(s)>0) and (s[1]=' ') do
+ delete(s,1,1);
+ if s='' then
+ continue;
inc(i);
end;
closefile(f);
@@ -243,26 +254,33 @@ begin
setlength(dat,i);
for i:=0 to length(dat)-1 do begin
readln(f,s);
- if pos('#',s)>0 then delete(s,pos('#',s),length(s));
- while (length(s)>0) and (s[1]=' ') do delete(s,1,1);
- if s='' then continue;
+ if pos('#',s)>0 then
+ delete(s,pos('#',s),length(s));
+ while (length(s)>0) and (s[1]=' ') do
+ delete(s,1,1);
+ if s='' then
+ continue;
dat[i]['x']:=strtofloat(copy(s,1,pos(' ',s)-1));
delete(s,1,pos(' ',s));
- while (length(s)>0) and (s[1]=' ') do delete(s,1,1);
+ while (length(s)>0) and (s[1]=' ') do
+ delete(s,1,1);
dat[i]['y']:=strtofloat(copy(s,1,pos(' ',s+' ')-1));
- if i and 1023 = 0 then write(stderr,'.');
+ if i and 1023 = 0 then
+ write(stderr,'.');
end;
closefile(f);
writeln(stderr,'fertig');
end;
procedure writeOutput(nam: string; const dat: tExtPointArray);
-var f: textfile;
- i,ml,mr: longint;
- leer: string;
- strings: array of array[boolean] of string;
+var
+ f: textfile;
+ i,ml,mr: longint;
+ leer: string;
+ strings: array of array[boolean] of string;
begin
- if length(dat)=0 then exit;
+ if length(dat)=0 then
+ exit;
write(stderr,'Datei '''+nam+''' schreiben ');
assignfile(f,nam);
rewrite(f);
@@ -274,23 +292,27 @@ begin
strings[i,true]:=floattostr(dat[i]['y']);
ml:=max(ml,length(strings[i,false]));
mr:=max(mr,pos('.',strings[i,true]+'.'));
- if i and 65535 = 0 then write(stderr,'.');
+ if i and 65535 = 0 then
+ write(stderr,'.');
end;
setlength(leer,ml+mr);
fillchar(leer[1],length(leer),' ');
for i:=0 to length(dat)-1 do begin
writeln(f,strings[i,false]+copy(leer,1,1+ml+mr-length(strings[i,false])-pos('.',strings[i,true]+'.'))+strings[i,true]);
- if i and 65535 = 0 then write(stderr,'.');
+ if i and 65535 = 0 then
+ write(stderr,'.');
end;
closefile(f);
writeln(stderr,' fertig');
end;
procedure writeOutput(nam: string; const dat,datArg: tExtPointArray); overload;
-var f: textfile;
- i: longint;
+var
+ f: textfile;
+ i: longint;
begin
- if length(dat)=0 then exit;
+ if length(dat)=0 then
+ exit;
if length(dat)<>length(datArg) then
Fehler('dat und datArg haben unterschiedlich viele Werte!');
write(stderr,'Datei '''+nam+''' schreiben ');
@@ -305,19 +327,21 @@ begin
floattostr(dat[i]['y'])+#9+
floattostr(datArg[i]['y'])
);
- if i and 65535 = 0 then write(stderr,'.');
+ if i and 65535 = 0 then
+ write(stderr,'.');
end;
closefile(f);
writeln(stderr,' fertig');
end;
procedure berechneTrajektorie(const inPuls,outPuls: tExtPointArray; out surTraj: tExtPointArray; absShift: extended);
-var i,j: longint;
- exList: array[0..3] of tLongintArray;
- psThreads: array of tPhaseShiftThread;
- stuecke: array of array[boolean,boolean] of longint;
- erledigt: array of boolean;
- b1,b2: boolean;
+var
+ i,j: longint;
+ exList: array[0..3] of tLongintArray;
+ psThreads: array of tPhaseShiftThread;
+ stuecke: array of array[boolean,boolean] of longint;
+ erledigt: array of boolean;
+ b1,b2: boolean;
begin
for i:=0 to length(inPuls)-2 do
if inPuls[i+1]['x']<=inPuls[i]['x'] then
@@ -374,7 +398,8 @@ begin
j:=0;
while (j<length(erledigt)) and erledigt[j] do
inc(j);
- if j>=length(erledigt) then continue;
+ if j>=length(erledigt) then
+ continue;
psThreads[i]:=
tPhaseShiftThread.create(
@inPuls,
@@ -389,14 +414,16 @@ begin
end;
b1:=false;
end;
- if not b1 then sleep(100);
+ if not b1 then
+ sleep(100);
for i:=0 to length(erledigt)-1 do
b1:=b1 and erledigt[i];
until b1;
end;
procedure smoothen(var dat: tExtPointArray; width: longint);
-var i,j: longint;
+var
+ i,j: longint;
begin
for i:=0 to length(dat)-width do begin
for j:=1 to width-1 do
@@ -412,13 +439,15 @@ begin
end;
procedure sort(var dat: tExtPointArray; start, stop, threads: longint);
-var sortThreads: array of tSortThread;
- i,j,k: longint;
- fertig: boolean;
- apos,epos: array of longint;
- tmp: tExtPointArray;
+var
+ sortThreads: array of tSortThread;
+ i,j,k: longint;
+ fertig: boolean;
+ apos,epos: array of longint;
+ tmp: tExtPointArray;
begin
- if start>=stop then exit;
+ if start>=stop then
+ exit;
if threads=1 then begin
sort(dat,start,(start+stop) div 2,threads);
sort(dat,(start+stop) div 2 + 1,stop,threads);
@@ -463,9 +492,11 @@ begin
fertig:=true;
j:=-1;
for i:=0 to length(apos)-1 do begin
- if apos[i]>epos[i] then continue;
+ if apos[i]>epos[i] then
+ continue;
fertig:=false;
- if (j=-1) or (dat[apos[i]]['x']<dat[apos[j]]['x']) then j:=i;
+ if (j=-1) or (dat[apos[i]]['x']<dat[apos[j]]['x']) then
+ j:=i;
end;
if not fertig then begin
tmp[k]:=dat[apos[j]];
@@ -479,9 +510,11 @@ begin
end;
procedure cut(var dat: tExtPointArray; tmax: extended);
-var i: longint;
+var
+ i: longint;
begin
- if tmax<0 then exit;
+ if tmax<0 then
+ exit;
i:=0;
while (i<length(dat)) and (dat[i]['x']<tmax) do
inc(i);
@@ -507,9 +540,10 @@ begin
end;
procedure filtereExtrema(const dat: tExtPointArray; var extrema: tLongintArray; sollAbst, toleranz: extended);
-var mitte,i,j,k: longint;
- mx,dist: extended;
- behalten: array of boolean;
+var
+ mitte,i,j,k: longint;
+ mx,dist: extended;
+ behalten: array of boolean;
begin
setlength(behalten,length(extrema));
for i:=0 to length(behalten)-1 do
@@ -547,9 +581,10 @@ begin
end;
procedure monotonieHerstellen(const dat: tExtPointArray; var minima,maxima: tLongintArray);
-var i,j,k: longint;
- b: boolean;
- behalten: array[boolean] of array of Boolean;
+var
+ i,j,k: longint;
+ b: boolean;
+ behalten: array[boolean] of array of Boolean;
begin
setlength(behalten[false],length(maxima));
setlength(behalten[true],length(minima));
@@ -607,16 +642,21 @@ begin
end;
procedure gesamtverschiebung(var inPuls,outPuls: tExtPointArray; var absShift: extended);
-var iMax,oMax,i: longint;
+var
+ iMax,oMax,i: longint;
begin
iMax:=0;
for i:=1 to length(inPuls)-1 do
- if inPuls[i]['y']>inPuls[iMax]['y'] then iMax:=i;
+ if inPuls[i]['y']>inPuls[iMax]['y'] then
+ iMax:=i;
oMax:=0;
for i:=1 to length(outPuls)-1 do
- if outPuls[i]['y']>outPuls[oMax]['y'] then oMax:=i;
- if absShift<-0.9e9 then absShift:=outPuls[oMax]['x']-inPuls[iMax]['x']
- else absShift:=(outPuls[oMax]['x']-inPuls[iMax]['x'])-round((outPuls[oMax]['x']-inPuls[iMax]['x'])-absShift);
+ if outPuls[i]['y']>outPuls[oMax]['y'] then
+ oMax:=i;
+ if absShift<-0.9e9 then
+ absShift:=outPuls[oMax]['x']-inPuls[iMax]['x']
+ else
+ absShift:=(outPuls[oMax]['x']-inPuls[iMax]['x'])-round((outPuls[oMax]['x']-inPuls[iMax]['x'])-absShift);
for i:=0 to length(outPuls)-1 do
outPuls[i]['x']:=outPuls[i]['x']-absShift;
@@ -655,7 +695,8 @@ var
i: longint;
begin
bound:=abs(bound);
- if dist<1 then dist:=1;
+ if dist<1 then
+ dist:=1;
setlength(outdat,length(indat)-dist);
for i:=0 to length(outdat)-1 do begin
outdat[i]['x']:=(indat[i+dist]['x']+indat[i]['x'])/2;
@@ -669,8 +710,9 @@ begin
end;
procedure removeLinearOffset(var dat: tExtPointArray);
-var i: longint;
- d: tExtPoint;
+var
+ i: longint;
+ d: tExtPoint;
begin
d:=extPoint(0,0);
for i:=0 to 99 do
@@ -686,16 +728,18 @@ begin
end;
procedure flip(var dat: tExtPointArray);
-var i: longint;
+var
+ i: longint;
begin
for i:=0 to length(dat)-1 do
dat[i]['y']:=-dat[i]['y'];
end;
procedure vereineExtrema(const dat1,dat2: tExtPointArray; var el1,el2: tLongintArray; toleranz: extended);
-var i,j,k: longint;
- b: boolean;
- behalten: array[boolean] of array of boolean;
+var
+ i,j,k: longint;
+ b: boolean;
+ behalten: array[boolean] of array of boolean;
begin
setlength(behalten[false],length(el1));
setlength(behalten[true],length(el2));
@@ -732,16 +776,20 @@ begin
end;
procedure uniq(var dat: tExtPointArray; streng: boolean);
-var i,j,k: longint;
- tmp: extended;
- s: string;
+var
+ i,j,k: longint;
+ tmp: extended;
+ s: string;
begin
write(stderr,'Dopplungen entfernen ...');
j:=0;
k:=0;
tmp:=0;
for i:=0 to length(dat)-1 do begin
- if (i<length(dat)-1) and (dat[i]['x']=dat[i+1]['x']) and ((dat[i]['y']=dat[i+1]['y']) or not streng) then begin
+ if (i<length(dat)-1) and
+ (dat[i]['x']=dat[i+1]['x']) and
+ ((dat[i]['y']=dat[i+1]['y']) or
+ not streng) then begin
inc(k);
tmp:=tmp+dat[i]['y'];
continue;
@@ -752,21 +800,24 @@ begin
k:=0;
tmp:=0;
end
- else dat[j]:=dat[i];
+ else
+ dat[j]:=dat[i];
inc(j);
end;
s:=floattostr(round(100*(length(dat)-j)/length(dat)*10)/10);
- if pos('.',s)>0 then delete(s,pos('.',s)+2,length(s));
+ if pos('.',s)>0 then
+ delete(s,pos('.',s)+2,length(s));
writeln(stderr,' fertig (es gab '+inttostr(length(dat)-j)+' Dopplungen - etwa '+s+'%)');
setlength(dat,j);
end;
procedure fft(var dat: tExtPointArray; out datArg: tExtPointArray);
-var i,j,k,n,dist,absch,wnum,wstep,haL: longint;
- in0,out0: boolean;
- wRe,wIm: tExtendedArray;
- t1,t2,vorher,nachher,fstep,pvFehler: extended;
- umsortierung: tLongintArray;
+var
+ i,j,k,n,dist,absch,wnum,wstep,haL: longint;
+ in0,out0: boolean;
+ wRe,wIm: tExtendedArray;
+ t1,t2,vorher,nachher,fstep,pvFehler: extended;
+ umsortierung: tLongintArray;
begin
write(stderr,'FFT ('+inttostr(length(dat))+') ... ');
fstep:=dat[1]['x']-dat[0]['x'];
@@ -861,18 +912,23 @@ begin
for i:=0 to 2*haL-1 do
nachher:=nachher + dat[i]['y'];
- if (nachher=0) and (vorher=0) then pvFehler:=0
- else pvFehler:=abs(nachher-vorher)/(nachher+vorher);
+ if (nachher=0) and (vorher=0) then
+ pvFehler:=0
+ else
+ pvFehler:=abs(nachher-vorher)/(nachher+vorher);
writeln(stderr,' fertig (Parseval-Fehler = '+floattostr(pvFehler)+' ... nämlich von '+floattostr(vorher)+' zu '+floattostr(nachher)+')');
- if in0 then writeln(stderr,'Nur Nullen im Input der FFT!');
- if out0 then writeln(stderr,'Nur Nullen im Output der FFT!');
+ if in0 then
+ writeln(stderr,'Nur Nullen im Input der FFT!');
+ if out0 then
+ writeln(stderr,'Nur Nullen im Output der FFT!');
end;
procedure interpoliere(var dat: tExtPointArray);
-var i,j: longint;
- tmp,xLen: extended;
- tdat: tExtPointArray;
+var
+ i,j: longint;
+ tmp,xLen: extended;
+ tdat: tExtPointArray;
begin
tmp:=0;
xLen:=dat[length(dat)-1]['x']-dat[0]['x'];
@@ -902,23 +958,28 @@ begin
end;
procedure normiere(var dat: tExtPointArray);
-var i: longint;
- m: extended;
+var
+ i: longint;
+ m: extended;
begin
- if length(dat)=0 then exit;
+ if length(dat)=0 then
+ exit;
m:=dat[0]['y'];
for i:=1 to length(dat)-1 do
m:=max(m,dat[i]['y']);
- if m=0 then exit;
+ if m=0 then
+ exit;
for i:=0 to length(dat)-1 do
dat[i]['y']:=dat[i]['y']/m;
end;
procedure berechneRefPuls(inPuls,surTraj: tExtPointArray; betaGlaette: longint; betaBound: extended; out cRefPuls: tExtPointArray);
-var iSur,iIn,anz: longint;
- beta,frac: extended;
+var
+ iSur,iIn,anz: longint;
+ beta,frac: extended;
begin
- if betaGlaette<1 then betaGlaette:=1;
+ if betaGlaette<1 then
+ betaGlaette:=1;
setlength(cRefPuls,0);
anz:=0;
iIn:=0;
@@ -928,7 +989,8 @@ begin
continue;
while (iIn<length(inPuls)-1) and (inPuls[iIn+1]['x']<=surTraj[iSur]['x']-surTraj[iSur]['y']) do
inc(iIn);
- if iIn>=length(inPuls)-1 then break;
+ if iIn>=length(inPuls)-1 then
+ break;
if anz>=length(cRefPuls) then
setlength(cRefPuls,anz+32768);
@@ -970,8 +1032,9 @@ end;
// tPhaseShiftThread ***********************************************************
constructor tPhaseShiftThread.create(p1d,p2d: pTExtPointArray; sta1, sto1, sta2, sto2: longint; absShift: extended);
-var i: longint;
- b: boolean;
+var
+ i: longint;
+ b: boolean;
begin
inherited create(true);
_starts[false]:=sta1;
@@ -996,9 +1059,10 @@ begin
end;
procedure tPhaseShiftThread.execute;
-var i,j,offset: longint;
- b: boolean;
- t1,t2,t3,bestErr,bestPos: extended;
+var
+ i,j,offset: longint;
+ b: boolean;
+ t1,t2,t3,bestErr,bestPos: extended;
begin
for b:=false to true do begin // normieren (auf 0..1)
t1:=0;
@@ -1015,7 +1079,8 @@ begin
offset:=byte(b)*(_stops[false]-_starts[false]+1);
for i:=0 to _stops[b]-_starts[b] do begin
_ergebnis[offset + i]['x']:=_dats[b,i]['x'];
- if (i=0) then bestPos:=_dats[not b,0]['x']
+ if (i=0) then
+ bestPos:=_dats[not b,0]['x']
else begin
t1:=_dats[b,i]['y'];
j:=0; // floor(_ergebnis[offset + i - 1]['y']); <- das war Murks
generated by cgit v1.2.3-70-g09d2 (git 2.47.0) at 2024-12-03 17:54:08 +0000