unit epostunit; {$mode objfpc}{$H+} interface uses Classes, SysUtils, mystringlistunit, werteunit, typenunit, process, lowlevelunit, matheunit, fftunit; type TBmpHeader = packed record bfType1 : byte; bfType2 : byte; bfSize : longint; bfReserved1 : word; bfReserved2 : word; bfOffBits : longint; biSize : longint; biWidth : longint; biHeight : longint; biPlanes : word; biBitCount : word; biCompression : longint; biSizeImage : longint; biXPelsPerMeter : longint; biYPelsPerMeter : longint; biClrUsed : longint; biClrImportant : longint; end ; tPalette = record name: string; farben: tRGBArray; end; tRGBArrayArray = array of tRGBArray; pTPalette = ^tPalette; pTPalettenArray = array of pTPalette; tWerte = class; tLiKo = array of record alpha: extended; werte: tWerte; end; pTLiKo = ^tLiKo; pTWerteArray = ^tWerteArray; tWerteArray = array of tWerte; tKontur = class; tKonturenArray = array of tKontur; pTKonturenArray = ^tKonturenArray; tDatenVorfahr = class(tObject) bezeichner: string; Konturen: pTKonturenArray; wertes: pTWerteArray; constructor create(Kont: pTKonturenArray; wert: pTWerteArray); function callBackGetValue(s: string): extended; end; tKontur = class(tDatenVorfahr) private function rxmin: extended; function rxmax: extended; function rtmin: extended; function rtmax: extended; function sortiere_nach_y(mt: longint): boolean; overload; function sortiere_nach_y(mt,von,bis: longint): boolean; overload; function exprtofloat(st: boolean; s: string; kvs: tKnownValues): extended; public orte: tExtPointArray; function init(st: boolean; var f: tMyStringlist; w: pTWerteArray; mt: longint): boolean; function liesVonDatei(st: boolean; s: string; xmi,xma,tmi,tma: extended): boolean; function erzeugeAusWerten(st: boolean; s: string; w: pTWerteArray; mt: longint; _xmin,_xmax,_tmin,_tmax: string): boolean; function erzeugeAusFunktion(st: boolean; s: string; xmi,xma,tmi,tma,dx,dt: extended; mt: longint): boolean; property xmin: extended read rxmin; property xmax: extended read rxmax; property tmin: extended read rtmin; property tmax: extended read rtmax; constructor create(Kont: pTKonturenArray; wert: pTWerteArray); destructor destroy; override; end; tLeseThread = class; tWerte = class(tDatenVorfahr) { Diese Klasse ist die benutzerseitige Variante von tLLWerte und benutzt letztere. Sie übernimmt auch die Parallelisierung. } private leseThread: tLeseThread; function findeAlleDateien(nam: string; var dat: tGenerischeInputDateiInfoArray; Vorlage: tGenerischeInputDateiInfo): boolean; function ermittleExterneInputParameter(var f: tMyStringlist; out dateien: tGenerischeInputDateiInfoArray): boolean; function ermittleInterneInputParameter(var dateien: tGenerischeInputDateiInfoArray): boolean; procedure initVerzerrung(quelle: tWerte; xMin,xMax,tMin,tMax,x0Abs,t0Abs,mt: longint; oberst: boolean; epsilon: extended; verzerrung: tTransformation; verzerrAnzahl: longint; ZPs: tIntPointArray; ZGs: tExtPointArray; ZAs: tExtendedArray; Warn: tWarnstufe); function rTransformationen: tTransformation; procedure wTransformationen(tr: tTransformation); function rXsteps: longint; procedure wXsteps(xs: longint); function rTsiz: longint; procedure wTsiz(ts: longint); function rXstart: extended; procedure wXstart(xs: extended); function rXstop: extended; procedure wXstop(xs: extended); function rTstart: extended; procedure wTstart(ts: extended); function rTstop: extended; procedure wTstop(ts: extended); function rNp: extended; procedure wNp(np: extended); function rBeta: extended; procedure wBeta(beta: extended); function rMinw: extended; procedure wMinw(miw: extended); function rMaxw: extended; procedure wMaxw(maw: extended); function xscale: extended; function tscale: extended; function dichtenParameterErkannt(st: boolean; s: string; threads,xmin,xmax,tmin,tmax: longint): boolean; function kont2disk(dir: char; x: extended): longint; function kont2diskFak(dir: char; x: extended): extended; function disk2kont(dir: char; x: longint): extended; function disk2kontFak(dir: char; x: longint): extended; procedure schreibeWertIntegriert(var f: textfile; i: longint; hor: boolean); public eWerte: tLLWerteExtended; dWerte: tLLWerteDouble; sWerte: tLLWerteSingle; Genauigkeit: tGenauigkeit; constructor create(Kont: pTKonturenArray; wert: pTWerteArray); overload; constructor create(original: tWerte; xmin,xmax: longint); overload; destructor destroy; override; procedure warteAufBeendigungDesLeseThreads; procedure kopiereVon(st: boolean; original: tWerte); overload; procedure kopiereVon(st: boolean; original: tWerte; xmin,xmax: longint); overload; function ladeDateien(st: boolean; var f: tMyStringlist; pl,sa: boolean): boolean; function ladeAscii(st: boolean; datei: string): boolean; function berechneLiKo(st: boolean; var f: tMyStringlist; threads: longint): boolean; function berechneAgglomeration(st: boolean; var f: tMyStringlist): boolean; function berechneQuotient(st: boolean; var f: tMyStringlist; threads, dividend, divisor: longint): boolean; function berechneProdukt(st: boolean; var f: tMyStringlist; threads, faktor1, faktor2: longint): boolean; function berechneKorrelation(st: boolean; var f: tMyStringlist; threads: longint; const quelle: tWerte): boolean; procedure ermittleMinMaxDichten(st: boolean; threads: longint; symmetrisch: boolean); overload; procedure ermittleMinMaxDichten(st: boolean; threads,xmin,xmax,tmin,tmax: longint; symmetrisch: boolean); overload; procedure gleicheMinMaxDichtenAn(st: boolean; var f: tMyStringlist; symmetrisch: boolean); function fft(threads: longint; senkrecht,invers: boolean; const vor,nach: tFFTDatenordnung; const fen: tFenster; out pvFehler: extended; Warn: tWarnstufe): boolean; overload; function berechneZeitfrequenzanalyse(st: boolean; var f: tMyStringlist; threads: longint; const quelle: tWerte; Warn: tWarnstufe): boolean; function berechneVerzerrung(st: boolean; var f: tMyStringlist; threads: longint; const quelle: tWerte; Warn: tWarnstufe): boolean; function berechneIntegral(st: boolean; var f: tMyStringlist; threads: longint; const quelle: tWerte): boolean; function berechneFFT(st: boolean; var f: tMyStringlist; threads: longint; Warn: tWarnstufe): boolean; function berechneFFT2d(st: boolean; var f: tMyStringlist; threads: longint; Warn: tWarnstufe): boolean; function erzeugeLinearesBild(st: boolean; var f: tMyStringlist; maxThreads: longint): boolean; function erzeugeAscii(st: boolean; var f: tMyStringlist): boolean; function erzeugeLineout(st: boolean; params: string): boolean; function erzeugeBinning(st: boolean; params: string): boolean; procedure spiegle(threads: longint); overload; procedure spiegle(threads,tmin,tmax: longint); overload; procedure fft2dNachbearbeitung(threads: longint; nb: tFFTDatenordnung); procedure schreibeWert(var f: textfile; x,y: longint); function exprtofloat(st: boolean; s: string): extended; function paramsdump: string; procedure beendeLeseThreadWennFertig; property Transformationen: tTransformation read rTransformationen write wTransformationen; property _xsteps: longint read rXsteps write wXsteps; property _tsiz: longint read rTsiz write wTsiz; // property _xstart: extended read rXstart write wXstart; // property _xstop: extended read rXstop write wXstop; // property _tstart: extended read rTstart write wTstart; // property _tstop: extended read rTstop write wTstop; property _np: extended read rNp write wNp; property _beta: extended read rBeta write wBeta; property _minw: extended read rMinw write wMinw; property _maxw: extended read rMaxw write wMaxw; end; tAchse = record Lage: TLage; Striche: Longint; Faktor: extended; end; tBeschriftungsschritt = record bis,faktor: extended; schritte: longint; linear: boolean; end; tZuZeichnendeKontur = class farbe: tRGB; deckKraft,dicke: extended; kontur: tKontur; constructor create; overload; constructor create(original: tZuZeichnendeKontur; kont: tKontur); overload; destructor destroy; override; end; tLogThread = class(tThread) private _fertig: boolean; raisedException: exception; function rFertig: boolean; public property fertig: boolean read rFertig write _fertig; constructor create; destructor destroy; override; procedure execute; override; procedure stExecute; virtual; abstract; end; tLiKoThread = class(tLogThread) liKo: pTLiKo; xMi,xMa,tMi,tMa,tOf,xOf: longint; pW: tWerte; constructor create(lk: pTLiKo; pWerte: tWerte; xMin,xMax,tMin,tMax,xOff,tOff: longint); destructor destroy; override; procedure stExecute; override; end; tQuotientThread = class(tLogThread) eps: extended; xMi,xMa,tMi,tMa,tOf,xOf: longint; dend,sor,quot: tWerte; constructor create(dividend, divisor, quotient: tWerte; epsilon: extended; xMin,xMax,tMin,tMax,xOff,tOff: longint); destructor destroy; override; procedure stExecute; override; end; tProduktThread = class(tLogThread) xMi,xMa,tMi,tMa,tOf,xOf: longint; f1,f2,pro: tWerte; constructor create(faktor1, faktor2, produkt: tWerte; xMin,xMax,tMin,tMax,xOff,tOff: longint); destructor destroy; override; procedure stExecute; override; end; tBilderthread = class(tLogThread) nummer,mt,breite,wbreite,hoehe, whoehe,gesbreite,lof,oof,rof,uof: longint; ws: tWerteArray; xmi,xma,tmi,tma,xpmi,xpma: Longint; xz,yz: extended; nbs: tTransformationArray; farben: trgbArray; wertes: array of tExtendedArray; anzahlens: array of tLongintArray; pals: tRGBArrayArray; rahmen: boolean; beschr: pTBeschriftungen; constructor create(i,maxthreads,ibreite,ihoehe,lo,oo,ro,uo: longint; const wes: tWerteArray; xmin,xmax,tmin,tmax: Longint; xzoom,yzoom: extended; Nachbearbeitungen: tTransformationArray; paletten: pTPalettenArray; beschri: pTBeschriftungen; rm: boolean); destructor destroy; override; procedure stExecute; override; procedure initAnzahlensFuerKontur; end; tDichteThread = class(tLogThread) maxDichte,minDichte: extended; xmin,xmax,tmin,tmax: longint; w: tWerte; constructor create(xmi,xma,tmi,tma: longint; const werte: tWerte); destructor destroy; override; procedure stExecute; override; end; tSpiegelThread = class(tLogThread) tmin,tmax: longint; pW: tWerte; constructor create(tmi,tma: longint; pWerte: tWerte); destructor destroy; override; procedure stExecute; override; end; tFFT2dNBThread = class(tLogThread) xmin,xmax: longint; pW: tWerte; nb: tFFTDatenordnung; constructor create(xmi,xma: longint; pWerte: tWerte; endordnung: tFFTDatenordnung); destructor destroy; override; procedure stExecute; override; end; tFFTThread = class(tLogThread) smi,sma: longint; fen: tFenster; erfolg,sen,inv: boolean; algo: tFFTAlgorithmus; pW: tWerte; pvFehler: extended; constructor create(werte: tWerte; smin,smax: longint; senkrecht,invers: boolean; const vor,nach: tFFTDatenordnung; const fenster: tFenster); overload; constructor create(werte: tWerte; smin,smax: longint; senkrecht,invers: boolean; algorithmus: tFFTAlgorithmus; const fenster: tFenster); overload; destructor destroy; override; procedure stExecute; override; end; tKorrelThread = class(tLogThread) wl: tWavelet; xMi,xMa: longint; qu,zi: tWerte; pvFehler: extended; algo: tFFTAlgorithmus; constructor create(quelle,ziel: tWerte; xMin,xMax: longint; wavelet: tWavelet); destructor destroy; override; procedure stExecute; override; end; tKonturAusWertenThread = class(tLogThread) w: tWerte; s: extended; xmi,xma,tmi,tma: longint; punkte: tExtPointArray; constructor create(werte: tWerte; schwelle: extended; xmin, xmax, tmin, tmax: longint); destructor destroy; override; procedure stExecute; override; end; tIntegralThread = class(tLogThread) qu,zi: tWerte; xmi,xma,tmi,tma,xof,tof: longint; rtg: tIntegrationsRichtung; constructor create(quelle, ziel: tWerte; xmin, xmax, tmin, tmax, xoff, toff: longint; richtung: tIntegrationsRichtung); destructor destroy; override; procedure stExecute; override; end; tSortiereNachYThread = class(tLogThread) Kont: tKontur; vo,bi,mt: longint; erfolg: boolean; constructor create(K: tKontur; threads,von,bis: longint); destructor destroy; override; procedure stExecute; override; end; tBefehlThread = class(tLogThread) bg: boolean; p: tProcess; constructor create(st: boolean; cmd: string; out erfolg: boolean); destructor destroy; override; procedure stExecute; override; end; tLeseThread = class(tLogThread) w: tWerte; inputs: tGenerischeInputDateiInfoArray; constructor create(we: tWerte; inps: tGenerischeInputDateiInfoArray); destructor destroy; override; procedure stExecute; override; end; tVerzerrInitThread = class(tLogThread) qu,zi: tWerte; ZPs: tIntPointArray; ZGs: tExtPointArray; ZAs: tExtendedArray; xMi,xMa,tMi,tMa,x0,t0,mt,va: longint; // bzgl. Ziel eps: extended; verz: tTransformation; Warnstufe: tWarnstufe; constructor create(quelle,ziel: tWerte; xMin,xMax,tMin,tMax,x0Abs,t0Abs,threads: longint; epsilon: extended; verzerrung: tTransformation; verzerrAnz: longint; zielpositionen: tIntPointArray; zielgewichte: tExtPointArray; Warn: tWarnstufe); destructor destroy; override; procedure stExecute; override; end; tVerzerrThread = class(tLogThread) qu,zi: tWerte; ZPs: tIntPointArray; ZGs: tExtPointArray; ZAs: tExtendedArray; xMi,xMa,tMi,tMa: longint; // bzgl. Ziel vb,nb: tTransformation; va,na: longint; constructor create(quelle,ziel: tWerte; xMin,xMax,tMin,tMax: longint; zielpositionen: tIntPointArray; zielgewichte: tExtPointArray; zielanzahlen: tExtendedArray; Vorbearbeitungen,Nachbearbeitungen: tTransformation; vorAnz,nachAnz: longint); destructor destroy; override; procedure stExecute; override; end; function neuePalette(var f: tMyStringlist): boolean; function initBmpHeader(w,h: longint): tBmpHeader; procedure schreibeBmpHeader(var f: file; w,h: longint); function findePalette(out Palette: pTPalette; name: string): boolean; function erzeugeLegende(st: boolean; var f: tMyStringlist; datei: string; Qu: tWerte; minDichte,maxDichte: extended; nb: tTransformation; pal: pTPalette): boolean; function strToFftDo(out fftDo: tFFTDatenordnung; s: string): boolean; function findeWerte(s: String; f: tMyStringlist; pws: pTWerteArray; Kont: pTKonturenArray; darfErstellen: boolean): integer; function findeKontur(s: String; f: tMyStringlist; pws: pTWerteArray; pks: pTKonturenArray; darfErstellen: boolean): integer; function externerBefehl(st: boolean; s: string): boolean; procedure warte_auf_externeBefehle; procedure beendeExterneBefehleWennFertig; var Paletten: array of tPalette; behalteLogs: boolean; externeBefehle: array of tBefehlThread; implementation uses math, systemunit; // tDatenVorfahr *************************************************************** constructor tDatenVorfahr.create(Kont: pTKonturenArray; wert: pTWerteArray); begin inherited create; Konturen:=Kont; wertes:=wert; bezeichner:=''; end; function tDatenVorfahr.callBackGetValue(s: string): extended; var i: longint; begin result:=nan; if startetMit('Kontur[',s) or startetMit('Konturen[',s) then begin if pos('].',s)=0 then fehler('Syntaxfehler, '']'' fehlt!'); i:=findeKontur(erstesArgument(s,'].'),nil,Wertes,Konturen,false); if i<0 then fehler('Finde Kontur nicht!'); if s='xmin' then result:=Konturen^[i].xmin else if s='xmax' then result:=Konturen^[i].xmax else if s='tmin' then result:=Konturen^[i].tmin else if s='tmax' then result:=Konturen^[i].tmax else if s='Breite' then result:=Konturen^[i].xmax-Konturen^[i].xmin else if s='Hoehe' then result:=Konturen^[i].tmax-Konturen^[i].tmin else fehler('Kenne Bezeichner '''+s+''' nicht als Eigenschaft einer Kontur!'); exit; end; if startetMit('Wert[',s) or startetMit('Werte[',s) or startetMit('Wertes[',s) then begin if pos('].',s)=0 then fehler('Syntaxfehler, '']'' fehlt!'); i:=findeWerte(erstesArgument(s,'].'),nil,wertes,Konturen,false); if i<0 then fehler('Finde Werte nicht!'); if (s='xmin') or (s='xstart') then result:=wertes^[i].Transformationen.xstart else if (s='xmax') or (s='xstop') then result:=wertes^[i].Transformationen.xstop else if (s='tmin') or (s='tstart') then result:=wertes^[i].Transformationen.tstart else if (s='tmax') or (s='tstop') then result:=wertes^[i].Transformationen.tstop else if (s='wmin') or (s='minw') then result:=wertes^[i]._minw else if (s='wmax') or (s='maxw') then result:=wertes^[i]._maxw else if s='np' then result:=wertes^[i]._np else if (s='beta') or (s='β') then result:=wertes^[i]._beta else if s='Breite' then result:=wertes^[i].Transformationen.xstart-wertes^[i].Transformationen.xstop else if s='Hoehe' then result:=wertes^[i].Transformationen.tstart-wertes^[i].Transformationen.tstop else fehler('Kenne Bezeichner '''+s+''' nicht als Eigenschaft von Werten!'); exit; end; fehler('Ich kenne den Bezeichner '''+s+''' nicht!'); end; // tWerte ********************************************************************** constructor tWerte.create(Kont: pTKonturenArray; wert: pTWerteArray); var ps: tExtrainfos; begin inherited create(Kont,wert); ps:=tExtrainfos.create; Genauigkeit:=gSingle; leseThread:=nil; sWerte:=tLLWerteSingle.create(ps); dWerte:=tLLWerteDouble.create(ps); eWerte:=tLLWerteExtended.create(ps); end; constructor tWerte.create(original: tWerte; xmin,xmax: longint); var ps: tExtrainfos; begin inherited create(original.Konturen,original.wertes); original.warteAufBeendigungDesLeseThreads; ps:=tExtrainfos.create; leseThread:=nil; Genauigkeit:=original.Genauigkeit; case Genauigkeit of gSingle: begin sWerte:=tLLWerteSingle.create(pTLLWerteSingle(@original.sWerte),ps,xmin,xmax); dWerte:=tLLWerteDouble.create(ps); eWerte:=tLLWerteExtended.create(ps); end; gDouble: begin sWerte:=tLLWerteSingle.create(ps); dWerte:=tLLWerteDouble.create(pTLLWerteDouble(@original.dWerte),ps,xmin,xmax); eWerte:=tLLWerteExtended.create(ps); end; gExtended: begin sWerte:=tLLWerteSingle.create(ps); dWerte:=tLLWerteDouble.create(ps); eWerte:=tLLWerteExtended.create(pTLLWerteExtended(@original.eWerte),ps,xmin,xmax); end; end{of case}; if original.bezeichner='' then bezeichner:='' else bezeichner:=original.bezeichner+''''; Transformationen:=original.Transformationen; end; destructor tWerte.destroy; begin warteAufBeendigungDesLeseThreads; if eWerte.params<>sWerte.params then begin eWerte.params.free; gibAus('Die Werteparameter sind verschieden instaziiert!!!',3); end; if dWerte.params<>sWerte.params then begin dWerte.params.free; gibAus('Die Werteparameter sind verschieden instaziiert!!!',3); end; sWerte.params.free; eWerte.free; dWerte.free; sWerte.free; inherited destroy; end; procedure tWerte.warteAufBeendigungDesLeseThreads; begin if assigned(leseThread) then begin gibAus('Warte auf Beendigung des Lesethreads von '''+bezeichner+''' ...',3); while not leseThread.fertig do sleep(10); leseThread.free; leseThread:=nil; gibAus('... ist fertig',3); end; end; procedure tWerte.kopiereVon(st: boolean; original: tWerte); overload; begin kopiereVon(st,original,0,original._xsteps-1); end; procedure tWerte.kopiereVon(st: boolean; original: tWerte; xmin,xmax: longint); overload; begin original.warteAufBeendigungDesLeseThreads; Transformationen:=tIdentitaet.create(original.Transformationen); Genauigkeit:=original.Genauigkeit; case Genauigkeit of gSingle: sWerte.kopiereVon(st,pTLLWerteSingle(@original.sWerte),xmin,xmax); gDouble: dWerte.kopiereVon(st,pTLLWerteDouble(@original.dWerte),xmin,xmax); gExtended: eWerte.kopiereVon(st,pTLLWerteExtended(@original.eWerte),xmin,xmax); end{of case}; end; function tWerte.rTransformationen: tTransformation; begin case genauigkeit of gSingle: result:=sWerte.params.transformationen; gDouble: result:=dWerte.params.transformationen; gExtended: result:=eWerte.params.transformationen; end{of case}; end; procedure tWerte.wTransformationen(tr: tTransformation); begin case genauigkeit of gSingle: sWerte.params.transformationen:=tr; gDouble: dWerte.params.transformationen:=tr; gExtended: eWerte.params.transformationen:=tr; end{of case}; end; function tWerte.rXsteps: longint; begin case genauigkeit of gSingle: result:=sWerte.params.xsteps; gDouble: result:=dWerte.params.xsteps; gExtended: result:=eWerte.params.xsteps; end{of case}; end; procedure tWerte.wXsteps(xs: longint); begin sWerte.params.xsteps:=xs; sWerte.params.refreshKnownValues; dWerte.params.xsteps:=xs; dWerte.params.refreshKnownValues; eWerte.params.xsteps:=xs; eWerte.params.refreshKnownValues; end; function tWerte.rTsiz: longint; begin case genauigkeit of gSingle: result:=sWerte.params.tsiz; gDouble: result:=dWerte.params.tsiz; gExtended: result:=eWerte.params.tsiz; end{of case}; end; procedure tWerte.wTsiz(ts: longint); begin sWerte.params.tsiz:=ts; sWerte.params.refreshKnownValues; dWerte.params.tsiz:=ts; dWerte.params.refreshKnownValues; eWerte.params.tsiz:=ts; eWerte.params.refreshKnownValues; end; function tWerte.rXstart: extended; begin case genauigkeit of gSingle: result:=sWerte.params.xstart; gDouble: result:=dWerte.params.xstart; gExtended: result:=eWerte.params.xstart; end{of case}; end; procedure tWerte.wXstart(xs: extended); begin case genauigkeit of gSingle: begin sWerte.params.transformationen.xstart:=xs; sWerte.params.refreshKnownValues; end; gDouble: begin dWerte.params.transformationen.xstart:=xs; dWerte.params.refreshKnownValues; end; gExtended: begin eWerte.params.transformationen.xstart:=xs; eWerte.params.refreshKnownValues; end; end{of case}; end; function tWerte.rXstop: extended; begin case genauigkeit of gSingle: result:=sWerte.params.xstop; gDouble: result:=dWerte.params.xstop; gExtended: result:=eWerte.params.xstop; end{of case}; end; procedure tWerte.wXstop(xs: extended); begin case genauigkeit of gSingle: begin sWerte.params.transformationen.xstop:=xs; sWerte.params.refreshKnownValues; end; gDouble: begin dWerte.params.transformationen.xstop:=xs; dWerte.params.refreshKnownValues; end; gExtended: begin eWerte.params.transformationen.xstop:=xs; eWerte.params.refreshKnownValues; end; end{of case}; end; function tWerte.rTstart: extended; begin case genauigkeit of gSingle: result:=sWerte.params.tstart; gDouble: result:=dWerte.params.tstart; gExtended: result:=eWerte.params.tstart; end{of case}; end; procedure tWerte.wTstart(ts: extended); begin case genauigkeit of gSingle: begin sWerte.params.transformationen.tstart:=ts; sWerte.params.refreshKnownValues; end; gDouble: begin dWerte.params.transformationen.tstart:=ts; dWerte.params.refreshKnownValues; end; gExtended: begin eWerte.params.transformationen.tstart:=ts; eWerte.params.refreshKnownValues; end; end{of case}; end; function tWerte.rTstop: extended; begin case genauigkeit of gSingle: result:=sWerte.params.tstop; gDouble: result:=dWerte.params.tstop; gExtended: result:=eWerte.params.tstop; end{of case}; end; procedure tWerte.wTstop(ts: extended); begin case genauigkeit of gSingle: begin sWerte.params.transformationen.tstop:=ts; sWerte.params.refreshKnownValues; end; gDouble: begin dWerte.params.transformationen.tstop:=ts; dWerte.params.refreshKnownValues; end; gExtended: begin eWerte.params.transformationen.tstop:=ts; eWerte.params.refreshKnownValues; end; end{of case}; end; function tWerte.rNp: extended; begin case genauigkeit of gSingle: result:=sWerte.params.np; gDouble: result:=dWerte.params.np; gExtended: result:=eWerte.params.np; end{of case}; end; procedure tWerte.wNp(np: extended); begin case genauigkeit of gSingle: begin sWerte.params.np:=np; sWerte.params.refreshKnownValues; end; gDouble: begin dWerte.params.np:=np; dWerte.params.refreshKnownValues; end; gExtended: begin eWerte.params.np:=np; eWerte.params.refreshKnownValues; end; end{of case}; end; function tWerte.rBeta: extended; begin case genauigkeit of gSingle: result:=sWerte.params.beta; gDouble: result:=dWerte.params.beta; gExtended: result:=eWerte.params.beta; end{of case}; end; procedure tWerte.wBeta(beta: extended); begin case genauigkeit of gSingle: begin sWerte.params.beta:=beta; sWerte.params.refreshKnownValues; end; gDouble: begin dWerte.params.beta:=beta; dWerte.params.refreshKnownValues; end; gExtended: begin eWerte.params.beta:=beta; eWerte.params.refreshKnownValues; end; end{of case}; end; function tWerte.rMinw: extended; begin case genauigkeit of gSingle: result:=sWerte.params.minw; gDouble: result:=dWerte.params.minw; gExtended: result:=eWerte.params.minw; end{of case}; end; procedure tWerte.wMinw(miw: extended); begin Transformationen.wmin:=miw; case genauigkeit of gSingle: begin sWerte.params.minw:=miw; sWerte.params.refreshKnownValues; end; gDouble: begin dWerte.params.minw:=miw; dWerte.params.refreshKnownValues; end; gExtended: begin eWerte.params.minw:=miw; eWerte.params.refreshKnownValues; end; end{of case}; end; function tWerte.rMaxw: extended; begin case genauigkeit of gSingle: result:=sWerte.params.maxw; gDouble: result:=dWerte.params.maxw; gExtended: result:=eWerte.params.maxw; end{of case}; end; procedure tWerte.wMaxw(maw: extended); begin Transformationen.wmax:=maw; case genauigkeit of gSingle: begin sWerte.params.maxw:=maw; sWerte.params.refreshKnownValues; end; gDouble: begin dWerte.params.maxw:=maw; dWerte.params.refreshKnownValues; end; gExtended: begin eWerte.params.maxw:=maw; eWerte.params.refreshKnownValues; end; end{of case}; end; function tWerte.findeAlleDateien(nam: string; var dat: tGenerischeInputDateiInfoArray; Vorlage: tGenerischeInputDateiInfo): boolean; var err: longint; i: longint; sr: tSearchRec; sa: tMyStringList; begin result:=false; shellExpand(nam,sa); for i:=0 to sa.count-1 do begin err:=findfirst(sa[i],$3f,sr); if err<>0 then begin findclose(sr); sa.free; gibAus('Keine Datei passt zum Muster '''+sa[i]+'''!',3); exit; end; while err=0 do begin setlength(dat,length(dat)+1); if Vorlage is tTraceInputDateiInfo then dat[length(dat)-1]:=tTraceInputDateiInfo.create(Vorlage); if Vorlage is tPhaseSpaceInputDateiInfo then dat[length(dat)-1]:=tPhaseSpaceInputDateiInfo.create(Vorlage); if Vorlage is tSpaceTimeInputDateiInfo then dat[length(dat)-1]:=tSpaceTimeInputDateiInfo.create(Vorlage); if Vorlage is tPipeInputDateiInfo then dat[length(dat)-1]:=tPipeInputDateiInfo.create(Vorlage); dat[length(dat)-1].Name:=extractfilepath(nam)+extractfilename(sr.Name); err:=findnext(sr); end; findclose(sr); end; sa.free; result:=true; end; function tWerte.ermittleExterneInputParameter(var f: tMyStringlist; out dateien: tGenerischeInputDateiInfoArray): boolean; // Parameter ermitteln, die in der Config-Datei stehen var s: string; ne,be,maxAmp: extended; Vorlagen: tInputDateiInfoVorlagen; g: textfile; erfolg: Word; i: Longint; mitGewalt: boolean; procedure aufraeumen; var ii: longint; begin if assigned(Vorlagen) then Vorlagen.free; for ii:=0 to length(dateien)-1 do if assigned(dateien[ii]) then dateien[ii].free; setlength(dateien,0); end; begin result:=false; setlength(dateien,0); Vorlagen:=tInputDateiInfoVorlagen.create; Vorlagen.params:=sWerte.params; ne:=0; maxAmp:=0; sWerte.params.beta:=-1; sWerte.params.maxW:=0; sWerte.params.minW:=0; sWerte.params.np:=0; sWerte.params.transformationen.tstart:=0; sWerte.params.transformationen.tstop:=0; sWerte.params.transformationen.xstart:=0; sWerte.params.transformationen.xstop:=0; mitGewalt:=false; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); aufraeumen; exit; end; if s='Ende' then break; if s='mit Gewalt' then begin mitGewalt:=true; continue; end; if startetMit('Genauigkeit:',s) then begin if not Vorlagen.GenauigkeitFromStr(s) then begin aufraeumen; exit; end; if (Genauigkeit < Vorlagen.Genauigkeit) then Genauigkeit:=Vorlagen.Genauigkeit; continue; end; if startetMit('Gamma:',s) then begin Vorlagen.Gamma:=exprtofloat(false,s); continue; end; if startetMit('tmin:',s) then begin Vorlagen.tstart:=exprtofloat(false,s); continue; end; if startetMit('tmax:',s) then begin Vorlagen.tstop:=exprtofloat(false,s); continue; end; if startetMit('xmin:',s) then begin Vorlagen.xstart:=exprtofloat(false,s); continue; end; if startetMit('xmax:',s) then begin Vorlagen.xstop:=exprtofloat(false,s); continue; end; if startetMit('Inputparameterdatei:',s) then begin if (not mitGewalt) and (not fileexists(extractfilepath(s)+'times-1')) and ((Vorlagen.Fehlerbehebungskommando='') or (sysutils.ExecuteProcess(Vorlagen.Fehlerbehebungsprogramm,Vorlagen.Fehlerbehebungsparameter,[])<>0) or not fileexists(extractfilepath(s)+'times-1')) then begin gibAus('Die Simulation in '''+extractfilepath(s)+''' ist nicht abgeschlossen!',3); aufraeumen; exit; end; assignfile(g,s); reset(g); erfolg:=0; while not eof(g) do begin readln(g,s); s:=erstesArgument(s,'#'); if startetMit('Gamma :',s) then begin Vorlagen.Gamma:=strtofloat(s); erfolg:=erfolg or 1; continue; end; if startetMit('Beta :',s) then begin be:=strtofloat(s); erfolg:=erfolg or 2; continue; end; if startetMit('n_el_over_nc :',s) then begin ne:=strtofloat(s); erfolg:=erfolg or 4; continue; end; if startetMit('.a0 :',s) then begin if strtofloat(s)>maxAmp then begin maxAmp:=strtofloat(s); erfolg:=erfolg or 8; end; continue; end; if startetMit('pulse component # ',s) then begin erfolg:=erfolg and (not 8); continue; end; if odd(erfolg shr 3) and startetMit('.frequency :',s) then begin Vorlagen.groeszenFaktor:=strtofloat(s); erfolg:=erfolg and (not 8); continue; end; end; close(g); if erfolg<>7 then begin gibAus('Die Inputparameterdatei enthält die gesuchten Parameter nicht!',3); aufraeumen; exit; end; ne:=sqrt(ne)/Vorlagen.groeszenFaktor; if (sWerte.params.np<>0) and (ne<>sWerte.params.np) then begin gibAus('Die Plasmafrequenzen in den Eingangsdateien unterscheiden sich ('+floattostr(sWerte.params.np)+' vs. '+floattostr(ne)+')!',3); aufraeumen; exit; end; sWerte.params.np:=ne; if (sWerte.params.beta<>-1) and (be<>sWerte.params.beta) then begin gibAus('Die Bezugssystemgeschwindigkeiten in den Eingangsdateien unterscheiden sich ('+floattostr(sWerte.params.beta)+' vs. '+floattostr(be)+')!',3); aufraeumen; exit; end; sWerte.params.beta:=be; continue; end; if startetMit('Fehlerbehebungskommando:',s) then begin Vorlagen.Fehlerbehebungskommando:=s; continue; end; if startetMit('Spurnummer:',s) then begin Vorlagen.SpurNummer:=strtoint(s); continue; end; if startetMit('Feldnummer:',s) then begin Vorlagen.FeldNummer:=strtoint(s); continue; end; if startetMit('Feld:',s) then begin Vorlagen.FeldNummer:=-1; for i:=0 to length(FeldgroeszenNamen)-1 do if uppercase(s)=FeldgroeszenNamen[i] then begin Vorlagen.FeldNummer:=i; break; end; if Vorlagen.FeldNummer>=0 then continue; gibAus('Unbekannte Feldgröße '''+s+'''!',3); aufraeumen; exit; end; if startetMit('Analysator:',s) then begin Vorlagen.Analysator:=s; continue; end; if startetMit('PhaseSpace-Datei:',s) then begin if fileexists(s) then begin setlength(dateien,length(dateien)+1); dateien[length(dateien)-1]:=tPhaseSpaceInputDateiInfo.create(Vorlagen.PhaseSpaceVorlage); dateien[length(dateien)-1].Name:=s; continue; end; if not findeAlleDateien(s,dateien,Vorlagen.PhaseSpaceVorlage) then begin aufraeumen; exit; end; continue; end; if startetMit('SpaceTime-Datei:',s) then begin if fileexists(s) then begin setlength(dateien,length(dateien)+1); dateien[length(dateien)-1]:=tSpaceTimeInputDateiInfo.create(Vorlagen.SpaceTimeVorlage); dateien[length(dateien)-1].Name:=s; continue; end; if not findeAlleDateien(s,dateien,Vorlagen.SpaceTimeVorlage) then begin aufraeumen; exit; end; continue; end; if startetMit('Trace-Datei:',s) then begin if fileexists(s) then begin setlength(dateien,length(dateien)+1); dateien[length(dateien)-1]:=tTraceInputDateiInfo.create(Vorlagen.TraceVorlage); dateien[length(dateien)-1].Name:=s; continue; end; if not findeAlleDateien(s,dateien,Vorlagen.TraceVorlage) then begin aufraeumen; exit; end; continue; end; if startetMit('Sergey-Trace:',s) then begin if not directoryexists(s) then begin gibAus(''''+s+''' ist kein Verzeichnis!',3); aufraeumen; exit; end; setlength(dateien,length(dateien)+1); dateien[length(dateien)-1]:=tSergeyInputDateiInfo.create(Vorlagen.SergeyVorlage); dateien[length(dateien)-1].Name:=s; continue; end; if startetMit('Pipe:',s) then begin setlength(dateien,length(dateien)+1); dateien[length(dateien)-1]:=tPipeInputDateiInfo.create(Vorlagen.PipeVorlage); dateien[length(dateien)-1].Name:=s; continue; end; gibAus('Verstehe Parameter '''+s+''' nicht beim Einlesen!',3); aufraeumen; exit; until false; sWerte.params.refreshKnownValues; Vorlagen.free; result:=true; end; function tWerte.ermittleInterneInputParameter(var Dateien: tGenerischeInputDateiInfoArray): boolean; // Parameter ermitteln, die aus der einzulesenden Datei hervorgehen var i,j,k,num,tmpi,br,SpAnz: longint; tmps: single; tmpd: double; tmpe: extended; f: file; tf: textfile; Positionen: tLongintArray; Sortiert: tGenerischeInputDateiInfoArray; ipp,ipap: tProcess; buf: array of byte; s,t: string; sl: tMyStringList; begin result:=false; if length(Dateien)=0 then begin gibAus('Keine Dateien zum Einlesen!',3); exit; end; genauigkeit:=gSingle; for i:=0 to length(dateien)-1 do genauigkeit:=tGenauigkeit(max(genauigkeit,dateien[i].genauigkeit)); tmpi:=0; num:=0; tmps:=0; tmpd:=0; SpAnz:=-1; setlength(Positionen,length(dateien)); for i:=0 to length(Positionen)-1 do Positionen[i]:=-1; for i:=0 to length(dateien)-1 do begin if dateien[i] is tPipeInputDateiInfo then begin ipp:=tProcess.create(nil); // dieser Prozess generiert die Daten ipp.Executable:=(dateien[i] as tPipeInputDateiInfo).Executable; ipp.Parameters.Text:=(dateien[i] as tPipeInputDateiInfo).ParametersText; ipp.Options:=ipp.Options + [poUsePipes]; ipap:=tProcess.create(nil); // dieser Prozess analysiert die Daten ipap.Executable:=(dateien[i] as tPipeInputDateiInfo).AnalysatorExecutable; ipap.Parameters.Text:=(dateien[i] as tPipeInputDateiInfo).AnalysatorParametersText; ipap.Options:=ipp.Options + [poUsePipes]; ipp.execute; ipap.execute; s:=''; br:=0; while (ipp.running or (ipp.Output.NumBytesAvailable > 0)) and ipap.running do begin if ipap.Output.NumBytesAvailable>0 then begin setlength(s,br+ipap.Output.NumBytesAvailable); br:=br+ipap.Output.Read(s[br+1],length(s)-br); continue; end; if ipp.Output.NumBytesAvailable > 0 then begin setlength(buf,ipp.Output.NumBytesAvailable); setlength(buf,ipp.Output.Read(buf[0],length(buf))); j:=0; k:=-1; while (j0) do begin k:=ipap.Input.Write(buf[j],length(buf)-j); j:=j+k; end; sleep(100); // SEHR DRECKIG !!! continue; end; sleep(10); end; if not ipap.running then ipp.CloseOutput; if not ipp.running then ipap.CloseInput; setlength(buf,0); while ipap.running or (ipap.Output.NumBytesAvailable>0) do begin setlength(s,br+ipap.Output.NumBytesAvailable); br:=br+ipap.Output.Read(s[br+1],length(s)-br); if ipap.running then sleep(10); end; if not ipp.waitOnExit then begin gibAus('ErmittleInterneInputParameter hat ohne Erfolg auf Ende von ipp gewartet!',3); exit; end; if not ipap.waitOnExit then begin gibAus('ErmittleInterneInputParameter hat ohne Erfolg auf Ende von ipap gewartet!',3); exit; end; ipp.free; ipap.free; dateien[i].groeszenFaktor:=1; s:=s+#10; while (pos(#13,s)>0) or (pos(#10,s)>0) do begin t:=copy(s,1,max(pos(#13,s),pos(#10,s))-1); if pos(#13,t)>0 then t:=copy(t,1,pos(#13,t)-1); if pos(#10,t)>0 then t:=copy(t,1,pos(#10,t)-1); delete(s,1,length(t)+1); t:=trim(t); if startetMit('Channels',t) and startetMit(':',t) then begin dateien[i].xsteps:=strtoint(t); continue; end; if startetMit('Sample Rate',t) and startetMit(':',t) then begin dateien[i].groeszenFaktor:=dateien[i].groeszenFaktor/strtofloat(t); continue; end; if startetMit('Precision',t) and startetMit(':',t) then begin if rightStr(t,4)<>'-bit' then begin gibAus('Ich verstehe die Genauigkeitsangabe '''+t+''' nicht bei einer Pipe!',3); exit; end; delete(t,length(t)-3,4); (dateien[i] as tPipeInputDateiInfo).bytesPerSample:=ceil(strtofloat(trim(t))/8); continue; end; if startetMit('Duration',t) and startetMit(':',t) then begin erstesArgument(t,'='); t:=erstesArgument(t); dateien[i].tsiz:=strtoint(t); dateien[i].groeszenFaktor:=dateien[i].groeszenFaktor*dateien[i].tsiz; continue; end; if startetMit('Sample Encoding',t) and startetMit(':',t) then begin if t='32-bit Signed Integer PCM' then begin (dateien[i] as tPipeInputDateiInfo).Kodierung:=k32BitSignedInteger; continue; end; gibAus('Ich kenne die Kodierung '''+t+''' nicht bei einer Pipe!',3); exit; end; end; num:=0; repeat k:=-1; for j:=0 to i-1 do if Positionen[j]=num then begin inc(k); inc(num); end; until k=-1; Positionen[i]:=num; end; if (dateien[i] is tSpaceTimeInputDateiInfo) or (dateien[i] is tTraceInputDateiInfo) then begin assign(f,dateien[i].Name); reset(f,1); blockread(f,num,sizeof(longint)); dec(num); if dateien[i] is tTraceInputDateiInfo then begin dateien[i].xsteps:=1; dateien[i].xstop:=dateien[i].xstart; blockread(f,tmpi,sizeof(longint)); if spAnz<0 then spAnz:=tmpi; if spAnz<>tmpi then begin gibAus('Falsche Anzahl an Spuren ('+inttostr(tmpi)+' statt '+inttostr(spAnz)+') in Datei '''+dateien[i].Name+'''!',3); close(f); exit; end; if ((dateien[i] as TTraceInputDateiInfo).Spurnummer<0) or ((dateien[i] as TTraceInputDateiInfo).Spurnummer>=spAnz) then begin gibAus('Ausgewählte Spurnummer ('+inttostr((dateien[i] as TTraceInputDateiInfo).Spurnummer)+') liegt außerhalb des verfügbaren Bereiches (0..'+inttostr(spAnz-1)+')!',3); close(f); exit; end; if ((dateien[i] as TTraceInputDateiInfo).Feldnummer<0) or ((dateien[i] as TTraceInputDateiInfo).Feldnummer>=length(FeldgroeszenNamen)) then begin gibAus('Ausgewählte Feldnummer ('+inttostr((dateien[i] as TTraceInputDateiInfo).Feldnummer)+') liegt außerhalb des verfügbaren Bereiches (0..'+inttostr(length(FeldgroeszenNamen)-1)+')!',3); close(f); exit; end; end; blockread(f,tmpi,sizeof(longint)); dateien[i].tsiz:=tmpi; if dateien[i] is tSpaceTimeInputDateiInfo then begin case dateien[i].Genauigkeit of gSingle: begin blockread(f,tmps,sizeof(single)); tmpe:=tmps; end; gDouble: begin blockread(f,tmpd,sizeof(double)); tmpe:=tmpd; end; gExtended: blockread(f,tmpe,sizeof(extended)); end{of case}; tmpe:=tmpe*dateien[i].groeszenFaktor; if i=0 then Transformationen.xstart:=tmpe; if tmpe<>Transformationen.xstart then begin gibAus('Falscher linker Rand in '''+dateien[i].Name+''', nämlich '+myfloattostr(tmpe)+' statt '+myfloattostr(Transformationen.xstart)+'.',3); close(f); exit; end; case dateien[i].Genauigkeit of gSingle: begin blockread(f,tmps,sizeof(single)); tmpe:=tmps; end; gDouble: begin blockread(f,tmpd,sizeof(double)); tmpe:=tmpd; end; gExtended: blockread(f,tmpe,sizeof(extended)); end{of case}; tmpe:=tmpe*dateien[i].groeszenFaktor; if i=0 then Transformationen.xstop:=tmpe; if tmpe<>Transformationen.xstop then begin gibAus('Falscher rechter Rand in '''+dateien[i].Name+''', nämlich '+myfloattostr(tmpe)+' statt '+myfloattostr(Transformationen.xstop)+'.',3); close(f); exit; end; blockread(f,tmpi,sizeof(longint)); dateien[i].xsteps:=tmpi; end; close(f); for j:=0 to i-1 do if Positionen[j]=num then begin gibAus('Datei '''+dateien[i].Name+''' ist redundant zu '''+dateien[j].Name+'''.',3); exit; end; Positionen[i]:=num; end; if dateien[i] is tPhaseSpaceInputDateiInfo then begin if (i<>0) or (length(dateien)<>1) then begin gibAus('Ich kann Phasenraumdateien nicht kaskadieren!',3); exit; end; assign(f,dateien[i].Name); reset(f,1); case dateien[i].Genauigkeit of gSingle: begin blockread(f,tmps,sizeof(single)); tmpe:=tmps; end; gDouble: begin blockread(f,tmpd,sizeof(double)); tmpe:=tmpd; end; gExtended: blockread(f,tmpe,sizeof(extended)); end{of case}; tmpe:=tmpe*dateien[i].groeszenFaktor; Transformationen.tstart:=tmpe; case dateien[i].Genauigkeit of gSingle: begin blockread(f,tmps,sizeof(single)); tmpe:=tmps; end; gDouble: begin blockread(f,tmpd,sizeof(double)); tmpe:=tmpd; end; gExtended: blockread(f,tmpe,sizeof(extended)); end{of case}; tmpe:=tmpe*dateien[i].groeszenFaktor; Transformationen.tstop:=tmpe; blockread(f,tmpi,sizeof(longint)); dateien[i].tsiz:=tmpi; case dateien[i].Genauigkeit of gSingle: begin blockread(f,tmps,sizeof(single)); tmpe:=tmps; end; gDouble: begin blockread(f,tmpd,sizeof(double)); tmpe:=tmpd; end; gExtended: blockread(f,tmpe,sizeof(extended)); end{of case}; tmpe:=tmpe*dateien[i].groeszenFaktor; Transformationen.xstart:=tmpe; case dateien[i].Genauigkeit of gSingle: begin blockread(f,tmps,sizeof(single)); tmpe:=tmps; end; gDouble: begin blockread(f,tmpd,sizeof(double)); tmpe:=tmpd; end; gExtended: blockread(f,tmpe,sizeof(extended)); end{of case}; tmpe:=tmpe*dateien[i].groeszenFaktor; Transformationen.xstop:=tmpe; blockread(f,tmpi,sizeof(longint)); dateien[i].xsteps:=tmpi; close(f); Positionen[i]:=0; end; if dateien[i] is tSergeyInputDateiInfo then begin if (i<>0) or (length(dateien)<>1) then begin gibAus('Ich kann Sergey Trace-Dateien nicht kaskadieren!',3); exit; end; if rightstr(dateien[i].Name,1)<>'/' then dateien[i].Name:=dateien[i].Name+'/'; if not fileexists(dateien[i].Name+'numberoftimesteps') then begin gibAus('Datei '''+dateien[i].Name+'numberoftimesteps'' existiert nicht!',3); exit; end; if not fileexists(dateien[i].Name+'dt') then begin gibAus('Datei '''+dateien[i].Name+'dt'' existiert nicht!',3); exit; end; if not fileexists(dateien[i].Name+'traces/traces.dat') then begin gibAus('Datei '''+dateien[i].Name+'traces/traces.dat'' existiert nicht!',3); exit; end; if not fileexists(dateien[i].Name+'../xrom.ini') then begin gibAus('Datei '''+dateien[i].Name+'../xrom.ini'' existiert nicht!',3); exit; end; if ((dateien[i] as TSergeyInputDateiInfo).Feldnummer<0) or ((dateien[i] as TSergeyInputDateiInfo).Feldnummer>=anzSergeyFelder) then begin gibAus('Ausgewählte Feldnummer ('+inttostr((dateien[i] as TSergeyInputDateiInfo).Feldnummer)+') liegt außerhalb des verfügbaren Bereiches (0..'+inttostr(anzSergeyFelder-1)+')!',3); exit; end; assign(tf,dateien[i].Name+'numberoftimesteps'); reset(tf); readln(tf,tmpi); close(tf); dateien[i].tsiz:=tmpi+1; sl:=tMyStringlist.create; sl.loadFromFile(dateien[i].Name+'../xrom.ini'); t:=sl.grepFirst('^\s*Pulse[12]\.a0\s*=.*[^0 ].*$'); if t='' then begin gibAus(''''+s+''' enthält keinen Puls, den ich erkenne!',3); exit; end; erstesArgument(t,'Pulse'); dateien[i].groeszenFaktor:=strtoint(erstesArgument(t,'.')); t:=sl.grepFirst('^\s*Plasma\.Density\s*='); if t='' then begin gibAus(''''+s+''' enthält keine Plasmadichte, die ich erkenne!',3); exit; end; erstesArgument(t,'='); dateien[i].params.np:=sqrt(strtofloat(t))/dateien[i].groeszenFaktor; sl.free; assign(tf,dateien[i].Name+'dt'); reset(tf); readln(tf,tmpe); close(tf); tmpe:=tmpe*dateien[i].groeszenFaktor; dateien[i].tstart:=0; dateien[i].tstop:=tmpe/2/pi*(dateien[i].tsiz-1); dateien[i].xstart:=0; dateien[i].xstop:=0; dateien[i].xsteps:=1; assignfile(f,dateien[i].Name+'traces/traces.dat'); reset(f,1); if filesize(f)<>wertGroesze(dateien[i].Genauigkeit)*dateien[i].tsiz*anzSergeyFelder then begin gibAus(''''+dateien[i].Name+'traces/traces.dat'' hat die falsche Größe ('+inttostr(filesize(f))+' statt '+inttostr(wertGroesze(dateien[i].Genauigkeit)*dateien[i].tsiz*anzSergeyFelder)+' Byte)!',3); close(f); exit; end; close(f); Positionen[i]:=0; end; end; _tsiz:=0; _xsteps:=dateien[0].xsteps; for i:=0 to length(dateien)-1 do begin if dateien[i].xsteps<>_xsteps then begin gibAus('Falsche Anzahl an x-Werten in '''+dateien[i].Name+''', nämlich '+inttostr(dateien[i].xsteps)+' statt '+inttostr(_xsteps)+'.',3); exit; end; _tsiz:=_tsiz+dateien[i].tsiz; if dateien[i].groeszenFaktor<>dateien[0].groeszenFaktor then begin gibAus('Die Dateien haben nicht alle den gleichen Größenfaktor!',3); exit; end; end; if dateien[0] is tSergeyInputDateiInfo then begin transformationen.xstart:=Dateien[0].xstart; transformationen.xstop:=Dateien[0].xstop; transformationen.tstart:=Dateien[0].tstart; transformationen.tstop:=Dateien[0].tstop; end; if not ((dateien[0] is tPhaseSpaceInputDateiInfo) or (dateien[0] is tSergeyInputDateiInfo)) then begin Transformationen.tstart:=Positionen[0]*dateien[0].groeszenFaktor; Transformationen.tstop:=(Positionen[0]+1)*dateien[0].groeszenFaktor; for i:=1 to length(Positionen)-1 do begin Transformationen.tstart:=min(Transformationen.tstart,Positionen[i]*dateien[i].groeszenFaktor); Transformationen.tstop:=max(Transformationen.tstop,(Positionen[i]+1)*dateien[i].groeszenFaktor); end; if 0<>round(Transformationen.tstart+length(dateien)*dateien[0].groeszenFaktor-Transformationen.tstop) then begin gibAus('Die Dateien decken nicht den kompletten Zeitbereich von '+inttostr(round(Transformationen.tstart))+'T bis '+inttostr(round(Transformationen.tstop))+'T ab!',3); exit; end; setlength(sortiert,length(dateien)); for i:=0 to length(Positionen)-1 do sortiert[Positionen[i]-round(Transformationen.tstart/dateien[i].groeszenFaktor)]:=dateien[i]; for i:=0 to length(Positionen)-1 do begin dateien[i]:=sortiert[i]; if i=0 then begin dateien[i].t0abs:=0; sWerte.params.tsiz_:=dateien[i].tmax-dateien[i].tmin+1; sWerte.params.xsteps_:=dateien[i].xmax-dateien[i].xmin+1; end else begin dateien[i].t0abs:= dateien[i-1].t0abs + dateien[i-1].tsiz; sWerte.params.tsiz_:= sWerte.params.tsiz_ + dateien[i].tmax-dateien[i].tmin+1; if sWerte.params.xsteps_<>dateien[i].xmax-dateien[i].xmin+1 then begin gibAus('Die Dateien haben unterschiedliche Anzahlen an x-Werten im ausgewählten Bereich!',3); exit; end; end; end; end; sWerte.params.refreshKnownValues; result:=true; end; procedure tWerte.initVerzerrung(quelle: tWerte; xMin,xMax,tMin,tMax,x0Abs,t0Abs,mt: longint; oberst: boolean; epsilon: extended; verzerrung: tTransformation; verzerrAnzahl: longint; ZPs: tIntPointArray; ZGs: tExtPointArray; ZAs: tExtendedArray; Warn: tWarnstufe); var i,j: longint; vits: array[boolean] of tVerzerrInitThread; b: boolean; begin if mt<=1 then begin for i:=0 to _tsiz-1 do for j:=0 to _xsteps-1 do ZAs[j + i*_xsteps]:=0; for i:=tMin to tMax do for j:=xMin to xMax do begin ZGs[j+i*quelle._xsteps]:=verzerrung.transformiereKoordinaten(j,i,verzerrAnzahl-1); ZPs[j+i*quelle._xsteps]['x']:=floor(ZGs[j+i*quelle._xsteps]['x']); ZPs[j+i*quelle._xsteps]['y']:=floor(ZGs[j+i*quelle._xsteps]['y']); ZGs[j+i*quelle._xsteps]['x']:= ZGs[j+i*quelle._xsteps]['x'] - ZPs[j+i*quelle._xsteps]['x']; ZGs[j+i*quelle._xsteps]['y']:= ZGs[j+i*quelle._xsteps]['y'] - ZPs[j+i*quelle._xsteps]['y']; ZPs[j+i*quelle._xsteps]['x']:=ZPs[j+i*quelle._xsteps]['x'] - x0Abs; // Zielpositionen um die Nullposition verschieben ZPs[j+i*quelle._xsteps]['y']:=ZPs[j+i*quelle._xsteps]['y'] - t0Abs; ZAs[ZPs[j+i*quelle._xsteps]['x'] + ZPs[j+i*quelle._xsteps]['y']*_xsteps]:= ZAs[ZPs[j+i*quelle._xsteps]['x'] + ZPs[j+i*quelle._xsteps]['y']*_xsteps] + (1-ZGs[j+i*quelle._xsteps]['x'])*(1-ZGs[j+i*quelle._xsteps]['y']); ZAs[ZPs[j+i*quelle._xsteps]['x'] + 1 + ZPs[j+i*quelle._xsteps]['y']*_xsteps]:= ZAs[ZPs[j+i*quelle._xsteps]['x'] + 1 + ZPs[j+i*quelle._xsteps]['y']*_xsteps] + ZGs[j+i*quelle._xsteps]['x']*(1-ZGs[j+i*quelle._xsteps]['y']); ZAs[ZPs[j+i*quelle._xsteps]['x'] + (ZPs[j+i*quelle._xsteps]['y'] + 1)*_xsteps]:= ZAs[ZPs[j+i*quelle._xsteps]['x'] + (ZPs[j+i*quelle._xsteps]['y'] + 1)*_xsteps] + (1-ZGs[j+i*quelle._xsteps]['x'])*ZGs[j+i*quelle._xsteps]['y']; ZAs[ZPs[j+i*quelle._xsteps]['x'] + 1 + (ZPs[j+i*quelle._xsteps]['y'] + 1)*_xsteps]:= ZAs[ZPs[j+i*quelle._xsteps]['x'] + 1 + (ZPs[j+i*quelle._xsteps]['y'] + 1)*_xsteps] + ZGs[j+i*quelle._xsteps]['x']*ZGs[j+i*quelle._xsteps]['y']; end; end else begin for b:=false to true do vits[b]:= tVerzerrInitThread.create( quelle, self, byte(not b)*xMin + byte(b)*((xMax+xMin) div 2 + 1), byte(not b)*((xMax+xMin) div 2) + byte(b)*xMax, tMin, tMax, x0Abs, t0Abs, mt div 2 + byte(odd(mt) and b), epsilon, verzerrung, verzerrAnzahl, ZPs, ZGs, Warn); while not (vits[false].fertig and vits[true].fertig) do sleep(10); for i:=0 to length(ZAs)-1 do ZAs[i]:= vits[false].ZAs[i] + vits[true].ZAs[i]; for b:=false to true do vits[b].free; end; if oberst then for i:=0 to length(ZAs)-1 do if ZAs[i]0); if not eof(g) then begin gibAus('Zu viele Zeilen in Asci-Input-Datei '''+datei+'''!',3); closefile(g); exit; end; closefile(g); k:=1; while s[k]<>'{' do inc(k); inc(k); for i:=0 to _tsiz-1 do begin while s[k]<>'{' do inc(k); for j:=0 to _xsteps-1 do begin t:=''; while not (s[k] in [',','}']) do begin if s[k] in ['-','0'..'9','e','E','.'] then t:=t+s[k]; if s[k] = '^' then t:=t+'E'; inc(k); end; if (s[k]='}') xor (j=_xsteps-1) then begin gibAus('Falsche Anzahl an Datenspalten in Asci-Input-Datei '''+datei+''' in Datenzeile '+inttostr(i+1)+'!',3); exit; end; if (pos(',',t)>0) and (pos('e',t)=0) and (pos('E',t)=0) then t:=t+'0'; if not st then eWerte.werte[j+i*_tsiz]:=strtofloat(t); inc(k); end; end; Transformationen.xsteps:=_xsteps; Transformationen.tsiz:=_tsiz; gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.berechneLiKo(st: boolean; var f: tMyStringlist; threads: longint): boolean; var i,xmin,xmax,tmin,tmax: longint; liKo: tLiKo; s: string; fertig: boolean; liKoThreads: array of tLiKoThread; Zeit: extended; begin result:=false; warteaufBeendigungDesLeseThreads; setlength(liKo,0); Genauigkeit:=gExtended; _xsteps:=0; _tsiz:=0; Zeit:=now; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); exit; end; if s='Ende' then break; if startetMit('xmin:',s) then begin if length(liKo)=0 then begin gibAus('xmin kann erst gesetzt werden, wenn wenigstens eine Komponente bekannt ist',3); exit; end; xmin:=liKo[0].werte.kont2disk('x',exprtofloat(st,s)); continue; end; if startetMit('xmax:',s) then begin if length(liKo)=0 then begin gibAus('xmax kann erst gesetzt werden, wenn wenigstens eine Komponente bekannt ist',3); exit; end; xmax:=liKo[0].werte.kont2disk('x',exprtofloat(st,s)); continue; end; if startetMit('tmin:',s) then begin if length(liKo)=0 then begin gibAus('tmin kann erst gesetzt werden, wenn wenigstens eine Komponente bekannt ist',3); exit; end; tmin:=liKo[0].werte.kont2disk('t',exprtofloat(st,s)); continue; end; if startetMit('tmax:',s) then begin if length(liKo)=0 then begin gibAus('tmax kann erst gesetzt werden, wenn wenigstens eine Komponente bekannt ist',3); exit; end; tmax:=liKo[0].werte.kont2disk('t',exprtofloat(st,s)); continue; end; if (s='in t auf Zweierpotenz kürzen') or (s='in y auf Zweierpotenz kürzen') then begin i:=round(power(2,floor(ln(tmax-tmin+1)/ln(2)))); tmax:=(tmax+tmin+i) div 2; tmin:=tmax-i+1; continue; end; if s='in x auf Zweierpotenz kürzen' then begin i:=round(power(2,floor(ln(xmax-xmin+1)/ln(2)))); xmax:=(xmax+xmin+i) div 2; xmin:=xmax-i+1; continue; end; setlength(liKo,length(liKo)+1); i:=findeWerte(erstesArgument(s),nil,wertes,Konturen,false); if i<0 then exit; liKo[length(liKo)-1].alpha:=wertes^[i].exprtofloat(st,s); while i<0 do i:=i+length(wertes^)-1; liKo[length(liKo)-1].werte:=wertes^[i mod (length(wertes^)-1)]; if _xsteps=0 then begin _xsteps:=liKo[length(liKo)-1].werte._xsteps; xmin:=0; xmax:=_xsteps-1; end; if _tsiz=0 then begin _tsiz:=liKo[length(liKo)-1].werte._tsiz; tmin:=0; tmax:=_tsiz-1; end; if _xsteps<>liKo[length(liKo)-1].werte._xsteps then begin gibAus('Unterschiedliche Anzahl an x-Schritten: '+inttostr(_xsteps)+' bisher vs. '+inttostr(liKo[length(liKo)-1].werte._xsteps)+' bei '+inttostr(i)+'!',3); exit; end; if _tsiz<>liKo[length(liKo)-1].werte._tsiz then begin gibAus('Unterschiedliche Anzahl an t-Schritten: '+inttostr(_tsiz)+' bisher vs. '+inttostr(liKo[length(liKo)-1].werte._tsiz)+' bei '+inttostr(i)+'!',3); exit; end; if liKo[length(liKo)-1].werte.Genauigkeit<>liKo[0].werte.Genauigkeit then begin gibAus('Ich bin dumm, ich kann nur Werte mit gleicher Genauigkeit zusammenrechnen!',3); exit; end; if liKo[length(liKo)-1].werte.Transformationen.xstart<>liKo[0].werte.Transformationen.xstart then begin gibAus('Anfangspostionen passen nicht zusammen ('+floattostr(liKo[0].werte.Transformationen.xstart)+' bisher vs. '+floattostr(liKo[length(liKo)-1].werte.Transformationen.xstart)+' bei '+inttostr(i)+')!',3); exit; end; if liKo[length(liKo)-1].werte.Transformationen.xstop<>liKo[0].werte.Transformationen.xstop then begin gibAus('Endpostionen passen nicht zusammen ('+floattostr(liKo[0].werte.Transformationen.xstop)+' bisher vs. '+floattostr(liKo[length(liKo)-1].werte.Transformationen.xstop)+' bei '+inttostr(i)+')!',3); exit; end; if liKo[length(liKo)-1].werte.Transformationen.tstart<>liKo[0].werte.Transformationen.tstart then begin gibAus('Anfangszeiten passen nicht zusammen ('+floattostr(liKo[0].werte.Transformationen.tstart)+' bisher vs. '+floattostr(liKo[length(liKo)-1].werte.Transformationen.tstart)+' bei '+inttostr(i)+')!',3); exit; end; if liKo[length(liKo)-1].werte.Transformationen.tstop<>liKo[0].werte.Transformationen.tstop then begin gibAus('Endzeiten passen nicht zusammen ('+floattostr(liKo[0].werte.Transformationen.tstop)+' bisher vs. '+floattostr(liKo[length(liKo)-1].werte.Transformationen.tstop)+' bei '+inttostr(i)+')!',3); exit; end; until false; if length(liKo)=0 then begin gibAus('Leere Linearkombination!',3); exit; end; _xsteps:=xmax-xmin+1; _tsiz:=tmax-tmin+1; Transformationen:=tUeberlagerung.create; for i:=0 to length(liKo)-1 do (Transformationen as tUeberlagerung).addKomponente(liKo[i].werte.Transformationen); Transformationen:=tKoordinatenAusschnitt.create(Transformationen,xmin,xmax,tmin,tmax); _np:=liKo[0].werte._np; _beta:=liKo[0].werte._beta; if st then begin result:=true; exit; end; eWerte.holeRam(3); gibAus('Berechne ...',3); Zeit:=now; setlength(liKoThreads,threads); for i:=0 to length(liKoThreads)-1 do liKoThreads[i]:=tLiKoThread.create(@liKo,self,round(i*_xsteps/threads),round((i+1)*_xsteps/threads-1),0,_tsiz-1,xmin,tmin); repeat sleep(10); fertig:=true; for i:=0 to length(liKoThreads)-1 do fertig:=fertig and liKoThreads[i].fertig; until fertig; for i:=0 to length(liKoThreads)-1 do liKoThreads[i].free; gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.berechneAgglomeration(st: boolean; var f: tMyStringlist): boolean; var i,xmin,xmax,tmin,tmax: longint; quellen: tWerteArray; s: string; Zeit: extended; begin result:=false; warteaufBeendigungDesLeseThreads; setlength(quellen,0); Genauigkeit:=gExtended; _xsteps:=0; _tsiz:=0; xmin:=-1; xmax:=-1; tmin:=-1; tmax:=-1; Zeit:=now; Transformationen:=tAgglomeration.create; (Transformationen as tAgglomeration).schritt:=-1; (Transformationen as tAgglomeration).horizontal:=false; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); exit; end; if s='Ende' then break; if startetMit('xmin:',s) then begin xmin:=quellen[0].kont2disk('x',exprtofloat(st,s)); continue; end; if startetMit('xmax:',s) then begin xmax:=quellen[0].kont2disk('x',exprtofloat(st,s)); continue; end; if startetMit('tmin:',s) then begin tmin:=quellen[0].kont2disk('t',exprtofloat(st,s)); continue; end; if startetMit('tmax:',s) then begin tmax:=quellen[0].kont2disk('t',exprtofloat(st,s)); continue; end; if startetMit('Schritt:',s) then begin (Transformationen as tAgglomeration).schritt:=exprtofloat(st,s); continue; end; if startetMit('Nullposition:',s) then begin (Transformationen as tAgglomeration).nullposition:=exprtofloat(st,s); continue; end; if s='horizontal' then begin (Transformationen as tAgglomeration).horizontal:=true; continue; end; if s='vertikal' then begin (Transformationen as tAgglomeration).horizontal:=true; continue; end; setlength(quellen,length(quellen)+1); i:=findeWerte(erstesArgument(s),nil,wertes,Konturen,false); if (i<0) or (wertes^[i]=self) then exit; quellen[length(quellen)-1]:=wertes^[i]; if length(quellen)=1 then begin _xsteps:=quellen[0]._xsteps; _tsiz:=quellen[0]._tsiz; end; if _xsteps<>quellen[length(quellen)-1]._xsteps then begin gibAus('Unterschiedliche Anzahl an x-Schritten: '+inttostr(_xsteps)+' bisher vs. '+inttostr(quellen[length(quellen)-1]._xsteps)+' bei '+inttostr(i)+'!',3); exit; end; if _tsiz<>quellen[length(quellen)-1]._tsiz then begin gibAus('Unterschiedliche Anzahl an t-Schritten: '+inttostr(_tsiz)+' bisher vs. '+inttostr(quellen[length(quellen)-1]._tsiz)+' bei '+inttostr(i)+'!',3); exit; end; if quellen[length(quellen)-1].Transformationen.xstart<>quellen[0].Transformationen.xstart then begin gibAus('Anfangspostionen passen nicht zusammen ('+floattostr(quellen[0].Transformationen.xstart)+' bisher vs. '+floattostr(quellen[length(quellen)-1].Transformationen.xstart)+' bei '+inttostr(i)+')!',3); exit; end; if quellen[length(quellen)-1].Transformationen.xstop<>quellen[0].Transformationen.xstop then begin gibAus('Endpostionen passen nicht zusammen ('+floattostr(quellen[0].Transformationen.xstop)+' bisher vs. '+floattostr(quellen[length(quellen)-1].Transformationen.xstop)+' bei '+inttostr(i)+')!',3); exit; end; if quellen[length(quellen)-1].Transformationen.tstart<>quellen[0].Transformationen.tstart then begin gibAus('Anfangszeiten passen nicht zusammen ('+floattostr(quellen[0].Transformationen.tstart)+' bisher vs. '+floattostr(quellen[length(quellen)-1].Transformationen.tstart)+' bei '+inttostr(i)+')!',3); exit; end; if quellen[length(quellen)-1].Transformationen.tstop<>quellen[0].Transformationen.tstop then begin gibAus('Endzeiten passen nicht zusammen ('+floattostr(quellen[0].Transformationen.tstop)+' bisher vs. '+floattostr(quellen[length(quellen)-1].Transformationen.tstop)+' bei '+inttostr(i)+')!',3); exit; end; until false; if length(quellen)=0 then begin gibAus('Leere Agglomeration!',3); exit; end; if xmin<0 then xmin:=0; if xmax<0 then xmax:=quellen[0].Transformationen.xsteps-1; if tmin<0 then tmin:=0; if tmax<0 then tmax:=quellen[0].Transformationen.tsiz-1; for i:=0 to length(quellen)-1 do (Transformationen as tAgglomeration).addKomponente( tKoordinatenAusschnitt.create( quellen[i].Transformationen, xmin,xmax,tmin,tmax) ); _xsteps:=Transformationen.xsteps; _tsiz:=Transformationen.tsiz; _minW:=Transformationen.wmin; _maxW:=Transformationen.wmax; _np:=quellen[0]._np; _beta:=quellen[0]._beta; if st then begin result:=true; exit; end; eWerte.holeRam(3); gibAus('Berechne ...',3); Zeit:=now; for i:=0 to length(quellen)-1 do case quellen[i].Genauigkeit of gSingle: eWerte.kopiereVonNach( pTLLWerteSingle(@quellen[i].sWerte), xmin,xmax, tmin,tmax, (1+xmax-xmin)*i*byte((Transformationen as tAgglomeration).horizontal), (1+tmax-tmin)*i*byte(not (Transformationen as tAgglomeration).horizontal) ); gDouble: eWerte.kopiereVonNach( pTLLWerteDouble(@quellen[i].dWerte), xmin,xmax, tmin,tmax, (1+xmax-xmin)*i*byte((Transformationen as tAgglomeration).horizontal), (1+tmax-tmin)*i*byte(not (Transformationen as tAgglomeration).horizontal) ); gExtended: eWerte.kopiereVonNach( pTLLWerteExtended(@quellen[i].eWerte), xmin,xmax, tmin,tmax, (1+xmax-xmin)*i*byte((Transformationen as tAgglomeration).horizontal), (1+tmax-tmin)*i*byte(not (Transformationen as tAgglomeration).horizontal) ); end; gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.berechneQuotient(st: boolean; var f: tMyStringlist; threads, dividend, divisor: longint): boolean; var i,xmin,xmax,tmin,tmax: longint; s: string; fertig: boolean; quotientThreads: array of tQuotientThread; Zeit,epsilon: extended; begin result:=false; warteaufBeendigungDesLeseThreads; Zeit:=now; Transformationen:=tUeberlagerung.create; (Transformationen as tUeberlagerung).addKomponente(wertes^[dividend].Transformationen); (Transformationen as tUeberlagerung).addKomponente(wertes^[divisor].Transformationen); _xsteps:=wertes^[dividend]._xsteps; xmin:=0; xmax:=_xsteps-1; _tsiz:=wertes^[dividend]._tsiz; tmin:=0; tmax:=_tsiz-1; _np:=wertes^[dividend]._np; _beta:=wertes^[dividend]._beta; epsilon:=1e-9; Zeit:=now; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); exit; end; if s='Ende' then break; if startetMit('xmin:',s) then begin xmin:=kont2disk('x',exprtofloat(st,s)); continue; end; if startetMit('xmax:',s) then begin xmax:=kont2disk('x',exprtofloat(st,s)); continue; end; if startetMit('tmin:',s) then begin tmin:=kont2disk('t',exprtofloat(st,s)); continue; end; if startetMit('tmax:',s) then begin tmax:=kont2disk('t',exprtofloat(st,s)); continue; end; if startetMit('epsilon:',s) then begin epsilon:=exprtofloat(st,s); continue; end; gibAus('Verstehe Option '''+s+''' nicht bei Teile!',3); exit; until false; _xsteps:=xmax-xmin+1; _tsiz:=tmax-tmin+1; if (wertes^[dividend].Transformationen.xstart<>wertes^[divisor].Transformationen.xstart) or (wertes^[dividend].Transformationen.xstop<>wertes^[divisor].Transformationen.xstop) or (wertes^[dividend].Transformationen.tstart<>wertes^[divisor].Transformationen.tstart) or (wertes^[dividend].Transformationen.tstop<>wertes^[divisor].Transformationen.tstop) or (wertes^[dividend]._xsteps<>wertes^[divisor]._xsteps) or (wertes^[dividend]._tsiz<>wertes^[divisor]._tsiz) then begin // gibAus('Dividend und Divisor haben verschiedene Abmessungen oder verschiedene Genauigkeiten, sowas verstehe ich nicht!',3); gibAus('Dividend und Divisor haben verschiedene Abmessungen, sowas verstehe ich nicht!',3); exit; end; Transformationen:=tKoordinatenAusschnitt.create(Transformationen,xmin,xmax,tmin,tmax); _np:=wertes^[dividend]._np; _beta:=wertes^[dividend]._beta; Genauigkeit:=gExtended; if st then begin result:=true; exit; end; eWerte.holeRam(3); gibAus('Berechne ...',3); Zeit:=now; setlength(quotientThreads,threads); for i:=0 to length(quotientThreads)-1 do quotientThreads[i]:=tQuotientThread.create(wertes^[dividend],wertes^[divisor],self,epsilon,round(i*_xsteps/threads),round((i+1)*_xsteps/threads-1),0,_tsiz-1,xmin,tmin); repeat sleep(10); fertig:=true; for i:=0 to length(quotientThreads)-1 do fertig:=fertig and quotientThreads[i].fertig; until fertig; for i:=0 to length(quotientThreads)-1 do quotientThreads[i].free; gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.berechneProdukt(st: boolean; var f: tMyStringlist; threads, faktor1, faktor2: longint): boolean; var i,xmin,xmax,tmin,tmax: longint; s: string; fertig: boolean; produktThreads: array of tProduktThread; Zeit: extended; begin result:=false; warteaufBeendigungDesLeseThreads; Zeit:=now; Transformationen:=tUeberlagerung.create; (Transformationen as tUeberlagerung).addKomponente(wertes^[faktor1].Transformationen); (Transformationen as tUeberlagerung).addKomponente(wertes^[faktor2].Transformationen); _xsteps:=Transformationen.xsteps; xmin:=0; xmax:=_xsteps-1; _tsiz:=Transformationen.tsiz; tmin:=0; tmax:=_tsiz-1; _np:=wertes^[faktor1]._np; _beta:=wertes^[faktor1]._beta; Zeit:=now; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); exit; end; if s='Ende' then break; if startetMit('xmin:',s) then begin xmin:=kont2disk('x',exprtofloat(st,s)); continue; end; if startetMit('xmax:',s) then begin xmax:=kont2disk('x',exprtofloat(st,s)); continue; end; if startetMit('tmin:',s) then begin tmin:=kont2disk('t',exprtofloat(st,s)); continue; end; if startetMit('tmax:',s) then begin tmax:=kont2disk('t',exprtofloat(st,s)); continue; end; gibAus('Verstehe Option '''+s+''' nicht bei Multipliziere!',3); exit; until false; _xsteps:=xmax-xmin+1; _tsiz:=tmax-tmin+1; if (wertes^[faktor1].Transformationen.xstart<>wertes^[faktor2].Transformationen.xstart) or (wertes^[faktor1].Transformationen.xstop<>wertes^[faktor2].Transformationen.xstop) or (wertes^[faktor1].Transformationen.tstart<>wertes^[faktor2].Transformationen.tstart) or (wertes^[faktor1].Transformationen.tstop<>wertes^[faktor2].Transformationen.tstop) or (wertes^[faktor1]._xsteps<>wertes^[faktor2]._xsteps) or (wertes^[faktor1]._tsiz<>wertes^[faktor2]._tsiz) then begin gibAus('Faktor1 und Faktor2 haben verschiedene Abmessungen, sowas verstehe ich nicht!',3); exit; end; Transformationen:=tKoordinatenAusschnitt.create(Transformationen,xmin,xmax,tmin,tmax); _np:=wertes^[faktor1]._np; _beta:=wertes^[faktor1]._beta; Genauigkeit:=gExtended; if st then begin result:=true; exit; end; eWerte.holeRam(3); gibAus('Berechne ...',3); Zeit:=now; setlength(produktThreads,threads); for i:=0 to length(produktThreads)-1 do produktThreads[i]:=tProduktThread.create(wertes^[faktor1],wertes^[faktor2],self,round(i*_xsteps/threads),round((i+1)*_xsteps/threads-1),0,_tsiz-1,xmin,tmin); repeat sleep(10); fertig:=true; for i:=0 to length(produktThreads)-1 do fertig:=fertig and produktThreads[i].fertig; until fertig; for i:=0 to length(produktThreads)-1 do produktThreads[i].free; gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.berechneKorrelation(st: boolean; var f: tMyStringlist; threads: longint; const quelle: tWerte): boolean; var i: longint; s: string; wavelet: tWavelet; fertig: boolean; korrelThreads: array of tKorrelThread; Zeit,pvFehler: extended; begin result:=false; warteaufBeendigungDesLeseThreads; genauigkeit:=gExtended; wavelet:=tWavelet.create; wavelet.mitFFT:=false; Zeit:=now; Transformationen:=quelle.Transformationen; wavelet.freq:=0; wavelet.tfwhm:=1; wavelet.typ:=wtSin2; _xsteps:=quelle._xsteps; _tsiz:=quelle._tsiz; _np:=quelle._np; _beta:=quelle._beta; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); exit; end; if s='Ende' then break; if startetMit('freq:',s) then begin wavelet.freq:=1/kont2diskFak('t',1/exprtofloat(st,s)); continue; end; if startetMit('tfwhm:',s) then begin wavelet.tfwhm:=round(kont2diskFak('t',exprtofloat(st,s))); continue; end; if startetMit('Wavelettyp:',s) then begin if not wavelet.setzeTyp(s) then exit; continue; end; if s='mit FFT' then begin wavelet.mitFFT:=true; continue; end; if s='ohne FFT' then begin wavelet.mitFFT:=false; continue; end; gibAus('Verstehe Option '''+s+''' nicht!',3); exit; until false; if st then begin result:=true; exit; end; if wavelet.mitFFT then begin gibAus('Fordere '+inttostr(floor(_tsiz*_xsteps*sizeof(extended)/1024/1024))+' MB RAM an ('+inttostr(_xsteps)+' x-Schritte mal '+inttostr(_tsiz)+' t-Schritte). ...',3); gibAus(paramsDump,3); gibAus(quelle.paramsDump,3); case quelle.genauigkeit of gSingle: eWerte.kopiereVon(st,pTLLWerteSingle(@quelle.sWerte)); gDouble: dWerte.kopiereVon(st,pTLLWerteDouble(@quelle.dWerte)); gExtended: eWerte.kopiereVon(st,pTLLWerteExtended(@quelle.eWerte)); end{of case}; gibAus('... fertig '+timetostr(now-Zeit)+', berechne ...',3); end else begin genauigkeit:=gExtended; eWerte.holeRam(3); gibAus('Berechne ...',3); end; Zeit:=now; wavelet.werte.params.tsiz:=_tsiz; wavelet.werte.params.refreshKnownValues; if not wavelet.berechneWerte then begin gibAus('Es traten Fehler bei der Waveletberechnung auf!',3); exit; end; setlength(korrelThreads,threads); for i:=0 to length(korrelThreads)-1 do korrelThreads[i]:=tKorrelThread.create(quelle,self,round(i*_xsteps/threads),round((i+1)*_xsteps/threads-1),wavelet); repeat sleep(10); fertig:=true; for i:=0 to length(korrelThreads)-1 do fertig:=fertig and korrelThreads[i].fertig; until fertig; pvFehler:=0; for i:=0 to length(korrelThreads)-1 do begin pvFehler:=pvFehler+korrelThreads[i].pvFehler; korrelThreads[i].free; end; gibAus(' (Parseval-Fehler = '+floattostr(pvFehler/length(korrelThreads))+')',3); wavelet.free; gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; procedure tWerte.ermittleMinMaxDichten(st: boolean; threads: longint; symmetrisch: boolean); begin ermittleMinMaxDichten(st,threads,0,_xsteps-1,0,_tsiz-1,symmetrisch); end; procedure tWerte.ermittleMinMaxDichten(st: boolean; threads,xmin,xmax,tmin,tmax: longint; symmetrisch: boolean); var i,j: longint; DTs: array of tDichteThread; fertig: boolean; Zeit: extended; begin if st then begin if _minW>=_maxW then _maxW:=_minW+1; exit; end; warteaufBeendigungDesLeseThreads; Zeit:=now; setlength(DTs,min(threads,xmax+1-xmin)); gibAus('Ermittle maximale und minimale Dichten ...',3); j:=xmin; for i:=0 to length(DTs)-1 do begin DTs[i]:=tDichteThread.create(j,Byte(i=length(DTs)-1)*xmax + Byte(i=_maxW then _maxW:=_minW+1; exit; end; warteaufBeendigungDesLeseThreads; for i:=0 to length(vgWs)-1 do vgWs[i].warteAufBeendigungDesLeseThreads; Zeit:=now; gibAus('Gleiche maximale und minimale Dichten an ...',3); for i:=0 to length(vgWs)-1 do begin _minW:=min(_minW,vgWs[i]._minw); _maxW:=max(_maxW,vgWs[i]._maxw); end; if symmetrisch then begin _minW:=min(_minW,-_maxW); _maxW:=max(_maxW,-_minW); end; for i:=0 to length(vgWs)-1 do begin vgWs[i]._minw:=_minW; vgWs[i]._maxw:=_maxW; end; gibAus('... sie sind '+myfloattostr(_minW)+' und '+myfloattostr(_maxW)+'. '+timetostr(now-Zeit),3); if symmetrisch then begin _minW:=min(_minW,-_maxW); _maxW:=max(_maxW,-_minW); gibAus('Jetzt sind sie '+myfloattostr(_minW)+' und '+myfloattostr(_maxW)+'. '+timetostr(now-Zeit),3); end; end; function tWerte.fft(threads: longint; senkrecht,invers: boolean; const vor,nach: tFFTDatenordnung; const fen: tFenster; out pvFehler: extended; Warn: tWarnstufe): boolean; var fftThreads: array of tFFTThread; i: longint; fertig: boolean; begin result:=false; if senkrecht then begin if length(fen.Werte)<>_tsiz then fen.berechneWerte(_tsiz); if threads>_xsteps then threads:=_xsteps; end else begin if length(fen.Werte)<>_xsteps then fen.berechneWerte(_xsteps); if threads>_tsiz then threads:=_tsiz; end; setlength(fftThreads,threads); if senkrecht then begin fftThreads[0]:= tFFTThread.create( self, 0, round(_xsteps/threads-1), senkrecht, invers, vor, nach, fen); for i:=1 to threads-1 do fftThreads[i]:= tFFTThread.create( self, round(_xsteps/threads*i), round(_xsteps/threads*(i+1)-1), senkrecht, invers, fftThreads[0].algo, fen); end else begin fftThreads[0]:= tFFTThread.create( self, 0, round(_tsiz/threads-1), senkrecht, invers, vor, nach, fen); for i:=1 to threads-1 do fftThreads[i]:= tFFTThread.create( self, round(_tsiz/threads*i), round(_tsiz/threads*(i+1)-1), senkrecht, invers, fftThreads[0].algo, fen); end; repeat sleep(10); fertig:=true; for i:=0 to length(fftThreads)-1 do fertig:=fertig and fftThreads[i].fertig; until fertig; result:=true; pvFehler:=0; for i:=0 to length(fftThreads)-1 do begin if Warn=wsStreng then result:=result and fftThreads[i].erfolg; pvFehler:=pvFehler+fftThreads[i].pvFehler; fftThreads[i].free; end; pvFehler:=pvFehler/length(fftThreads); gibAus(' (Parseval-Fehler = '+floattostr(pvFehler)+')',1); gibAus('Alle FFTThreads fertig!',1); end; function tWerte.berechneZeitfrequenzanalyse(st: boolean; var f: tMyStringlist; threads: longint; const quelle: tWerte; Warn: tWarnstufe): boolean; var i,j,tmin,tmax,tOf,Schritt: longint; Zeit,pvFehler,freqMax: extended; Fenster: tFenster; s: string; begin result:=false; if (not st) and (quelle._xsteps<>1) and (quelle._tsiz<>1) then begin gibAus('Eine Zeitfrequenzanalyse geht nur auf eindimensionalen Daten! ('+inttostr(quelle._xsteps)+'x'+inttostr(quelle._tsiz)+')',3); exit; end; warteaufBeendigungDesLeseThreads; Zeit:=now; Fenster.Breite:=0; Fenster.aktiv:=false; Fenster.Rand:=0; Schritt:=round(sqrt(quelle._tsiz)); tmin:=0; tmax:=quelle._tsiz-1; if (quelle._xsteps=1) then freqMax:=quelle._tsiz/(quelle.Transformationen.tstop-quelle.Transformationen.tstart) else freqMax:=quelle._xsteps/(quelle.Transformationen.xstop-quelle.Transformationen.xstart); Genauigkeit:=gExtended; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); exit; end; if s='Ende' then break; if startetMit('Threadanzahl:',s) then begin threads:=strtoint(s); continue; end; if startetMit('Fenster:',s) then begin Fenster.Breite:=round(quelle.kont2diskFak('t',quelle.exprtofloat(st,erstesArgument(s,';')))); Fenster.Rand:=round(quelle.kont2diskFak('t',quelle.exprtofloat(st,s))); Fenster.aktiv:=true; continue; end; if startetMit('Schritt:',s) then begin Schritt:=round(quelle.kont2diskFak('t',quelle.exprtofloat(st,s))); continue; end; if (quelle._xsteps=1) then begin if startetMit('xmin:',s) then begin tmin:=quelle.kont2disk('x',quelle.exprtofloat(st,s)); continue; end; if startetMit('xmax:',s) then begin tmax:=quelle.kont2disk('x',quelle.exprtofloat(st,s)); continue; end; if startetMit('wmax:',s) or startetMit('omegamax:',s) or startetMit('ωmax:',s) then begin freqmax:=quelle.exprtofloat(st,s); continue; end; end; if (quelle._tsiz=1) then begin if startetMit('tmin:',s) then begin tmin:=quelle.kont2disk('t',quelle.exprtofloat(st,s)); continue; end; if startetMit('tmax:',s) then begin tmax:=quelle.kont2disk('t',quelle.exprtofloat(st,s)); continue; end; if startetMit('kmax:',s) then begin freqmax:=quelle.exprtofloat(st,s); continue; end; end; gibAus('Verstehe Option '''+s+''' nicht bei Erstellung einer Zeitfrequenzanalyse!',3); exit; until false; tmin:=max(0,tmin); tmax:=min(quelle._tsiz-1,tmax); Schritt:=max(1,Schritt); _tsiz:=round(power(2,ceil(ln(Fenster.Breite)/ln(2)))); _xsteps:=1 + ((tmax-tmin+1-(Fenster.Breite-1)) div Schritt); if _xsteps<=0 then begin gibAus('Das angegebene Fenster passt nicht zwischen Anfangs- und Endzeit! ('+ floattostrtrunc(disk2kontFak('t',Fenster.Breite),2,true)+'>='+ floattostrtrunc(disk2kontFak('t',tmax-tmin+1),2,true)+')',3); exit; end; Transformationen:=tAgglomeration.create; if quelle._tsiz<>1 then begin for i:=0 to _xsteps-1 do (Transformationen as tAgglomeration).addKomponente(quelle.Transformationen); (Transformationen as tAgglomeration).schritt:=(quelle.disk2kont('t',tmax)-quelle.disk2kont('t',tmin))*(1+1/(tmax-tmin)); end else begin for i:=0 to _tsiz-1 do (Transformationen as tAgglomeration).addKomponente(quelle.Transformationen); (Transformationen as tAgglomeration).schritt:=(quelle.disk2kont('x',tmax)-quelle.disk2kont('x',tmin))*(1+1/(tmax-tmin)); end; if not st then begin tOf:=(_tsiz-Fenster.Breite) div 2; eWerte.holeRam(3); gibAus('kopiere Inhalt ...',3); for j:=0 to tOf-1 do for i:=0 to _xsteps-1 do eWerte.werte[i+j*_xsteps]:=0; for j:=tOf+Fenster.Breite to _tsiz-1 do for i:=0 to _xsteps-1 do eWerte.werte[i+j*_xsteps]:=0; case quelle.Genauigkeit of gSingle: for i:=0 to _xsteps-1 do for j:=0 to Fenster.Breite-1 do begin eWerte.werte[i + (j+tOf)*_xsteps]:= quelle.sWerte.werte[i*Schritt+j+tmin]; end; gDouble: for i:=0 to _xsteps-1 do for j:=0 to Fenster.Breite-1 do begin eWerte.werte[i + (j+tOf)*_xsteps]:= quelle.dWerte.werte[i*Schritt+j+tmin]; end; gExtended: for i:=0 to _xsteps-1 do for j:=0 to Fenster.Breite-1 do eWerte.werte[i + (j+tOf)*_xsteps]:= quelle.eWerte.werte[i*Schritt+j+tmin]; end{of case}; gibAus('... fertig, berechne Fouriertransformation ...',3); if not fft(threads,true,false,doRes,doBetrQdr,Fenster,pvFehler,Warn) then begin gibAus('Es traten Fehler auf!',3); exit; end; gibAus(' (Parseval-Fehler = '+floattostr(pvFehler)+')',3); end; Transformationen:=tFFTTransformation.create(Transformationen,false,true); if (Transformationen.tstop<=freqmax) or (freqmax<=0) then _tsiz:=_tsiz div 2 else begin freqmax:=Transformationen.tstop * round((_tsiz div 2)/Transformationen.tstop*freqmax) / (_tsiz div 2); _tsiz:=round((_tsiz div 2)/Transformationen.tstop*freqmax); end; Transformationen:=tKoordinatenAusschnitt.create(Transformationen,0,_xsteps-1,0,_tsiz-1); if not st then eWerte.holeRAM(0); gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.berechneVerzerrung(st: boolean; var f: tMyStringlist; threads: longint; const quelle: tWerte; Warn: tWarnstufe): boolean; var i,j: longint; grenzen: t2x2Longint; ZPs: tIntPointArray; // Zielpositionen ZGs: tExtPointArray; // Zielgewichte ZAs: tExtendedArray; // Anzahl Quellen, die auf entsprechende Zielposition abgebildet werden Zeit,epsilon: extended; Vorbearbeitung, Nachbearbeitung, verzerrung,tmp: tTransformation; vorAnz,nachAnz,verAnz: longint; s: string; verzerrThreads: array of tVerzerrThread; fertig, bearbeitungenLoeschen: boolean; procedure aufraeumen; var ii: longint; begin for ii:=0 to length(verzerrThreads)-1 do if assigned(verzerrThreads[ii]) then verzerrThreads[ii].free; setlength(verzerrThreads,0); if bearbeitungenLoeschen then begin zerstoereTransformationWennObsolet(Vorbearbeitung); zerstoereTransformationWennObsolet(Nachbearbeitung); zerstoereTransformationWennObsolet(Verzerrung); end; setlength(ZPs,0); setlength(ZGs,0); setlength(ZAs,0); end; begin result:=false; warteaufBeendigungDesLeseThreads; gibAus('Verzerrung berechnen ... ',3); Zeit:=now; bearbeitungenLoeschen:=true; verzerrung:=tKeineTransformation.create; verAnz:=0; epsilon:=1e-9; Genauigkeit:=gExtended; Vorbearbeitung:=tKeineTransformation.create; vorAnz:=0; Nachbearbeitung:=tKeineTransformation.create; nachAnz:=0; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); aufraeumen; exit; end; if s='Ende' then break; if quelle.dichtenParameterErkannt(st,s,threads,0,_xsteps-1,0,_tsiz-1) then continue; if startetMit('Threadanzahl:',s) then begin threads:=strtoint(s); continue; end; if startetMit('Epsilon:',s) then begin epsilon:=exprtofloat(st,s); continue; end; if startetMit('Abbildung:',s) then begin tmp:=tKonkreteKoordinatenTransformation.create; if assigned(verzerrung) then tmp.fuegeVorgaengerHinzu(verzerrung); verzerrung:=tmp; if not (verzerrung as tKonkreteKoordinatenTransformation).initAbbildung(st,s,quelle.xscale,quelle.tscale,@exprtofloat) then begin gibAus('Syntaxfehler in der Funktion '''+s+'''!',3); aufraeumen; exit; end; inc(verAnz); if not st then begin gibAus(verzerrung.dumpParams(verAnz),3); for i:=0 to 1 do for j:=0 to 1 do gibAus( inttostr(i*(quelle._xsteps-1))+';'+inttostr(j*(quelle._tsiz-1))+' -> '+ tExtPointToStr(verzerrung.transformiereKoordinaten(i*(quelle._xsteps-1),j*(quelle._tsiz-1),verAnz-1)),3); end; continue; end; if startetMit('Nachbearbeitung:',s) then begin if not liesTWerteTransformationen(st,s,f,@exprtofloat,Nachbearbeitung) then begin aufraeumen; exit; end; inc(nachAnz); continue; end; if startetMit('Vorbearbeitung:',s) then begin if not liesTWerteTransformationen(st,s,f,@exprtofloat,Vorbearbeitung) then begin aufraeumen; exit; end; inc(vorAnz); continue; end; gibAus('Verstehe Option '''+s+''' nicht bei Erstellung einer Verzerrung!',3); aufraeumen; exit; until false; Transformationen:=quelle.Transformationen; Vorbearbeitung.ersetzeAnfangDurch(Transformationen); Verzerrung.ersetzeAnfangDurch(Vorbearbeitung); Nachbearbeitung.ersetzeAnfangDurch(verzerrung); if not st then begin gibAus('... Zielausdehnung berechnen ... ',3); grenzen:=(verzerrung as tKonkreteKoordinatenTransformation).zielausdehnung; _xsteps:=grenzen['x','y']-grenzen['x','x']+2; _tsiz:=grenzen['y','y']-grenzen['y','x']+2; if (_xsteps<=1) or (_tsiz<=1) then begin gibAus('Es passt kein Rechteck des Ziels vollständig in die Quelldaten!',3); aufraeumen; exit; end; eWerte.holeRam(3); gibAus('Positionen und Gewichte initialisieren ...',3); setlength(ZPs,quelle._xsteps*quelle._tsiz); setlength(ZGs,quelle._xsteps*quelle._tsiz); setlength(ZAs,_xsteps*_tsiz); initVerzerrung(quelle,0,quelle._xsteps-1,0,quelle._tsiz-1,grenzen['x','x'],grenzen['y','x'],threads,true,epsilon,verzerrung,verAnz,ZPs,ZGs,ZAs,Warn); gibAus('... fertig, Threads starten',3); setlength(verzerrThreads,threads); for i:=0 to length(verzerrThreads)-1 do verzerrThreads[i]:=tVerzerrThread.create(quelle,self,round(i/length(verzerrThreads)*_xsteps),round((i+1)/length(verzerrThreads)*_xsteps-1),0,_tsiz-1,ZPs,ZGs,ZAs,Vorbearbeitung,Nachbearbeitung,vorAnz,nachAnz); repeat fertig:=true; for i:=0 to length(verzerrThreads)-1 do fertig:=fertig and verzerrThreads[i].fertig; if not fertig then sleep(10); until fertig; end; Transformationen:=Nachbearbeitung; aufraeumen; gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.berechneIntegral(st: boolean; var f: tMyStringlist; threads: longint; const quelle: tWerte): boolean; var i,tmin,tmax,xmin,xmax: longint; Zeit: extended; s: string; rtg: tIntegrationsRichtung; intThreads: array of tIntegralThread; fertig: boolean; begin result:=false; warteaufBeendigungDesLeseThreads; Zeit:=now; tmin:=0; tmax:=quelle._tsiz-1; xmin:=0; xmax:=quelle._xsteps-1; Genauigkeit:=gExtended; rtg:=irHorizontal; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); exit; end; if s='Ende' then break; if startetMit('Threadanzahl:',s) then begin threads:=strtoint(s); continue; end; if startetMit('xmin:',s) then begin xmin:=quelle.kont2disk('x',quelle.exprtofloat(st,s)); continue; end; if startetMit('xmax:',s) then begin xmax:=quelle.kont2disk('x',quelle.exprtofloat(st,s)); continue; end; if startetMit('tmin:',s) then begin tmin:=quelle.kont2disk('t',quelle.exprtofloat(st,s)); continue; end; if startetMit('tmax:',s) then begin tmax:=quelle.kont2disk('t',quelle.exprtofloat(st,s)); continue; end; if startetMit('Richtung:',s) then begin if s='horizontal' then begin rtg:=irHorizontal; continue; end; if s='einfall' then begin rtg:=irEinfall; continue; end; if s='ausfall' then begin rtg:=irAusfall; continue; end; gibAus('Verstehe Richtung '''+s+''' nicht bei Berechnung eines Integrals!',3); exit; end; gibAus('Verstehe Option '''+s+''' nicht bei Berechnung eines Integrals!',3); exit; until false; tmin:=max(0,tmin); tmax:=min(quelle._tsiz-1,tmax); xmin:=max(0,xmin); xmax:=min(quelle._xsteps-1,xmax); Transformationen:=tKoordinatenAusschnitt.create(quelle.Transformationen,xmin,xmax,tmin,tmax); if not st then begin _tsiz:=tmax-tmin+1; _xsteps:=xmax-xmin+1; eWerte.holeRam(3); gibAus('Berechne Integrale ...',3); setlength(intThreads,threads); for i:=0 to length(intThreads)-1 do intThreads[i]:= tIntegralThread.create( quelle, self, xmin, xmax, tmin+round( i /length(intThreads)*(tmax+1-tmin)), tmin+round((i+1)/length(intThreads)*(tmax+1-tmin)-1), xmin, tmin, rtg); repeat fertig:=true; for i:=0 to length(intThreads)-1 do fertig:=fertig and intThreads[i].fertig; if not fertig then sleep(10); until fertig; for i:=0 to length(intThreads)-1 do intThreads[i].free; gibAus('... fertig '+timetostr(now-Zeit),3); end; result:=true; end; function tWerte.berechneFFT(st: boolean; var f: tMyStringlist; threads: longint; Warn: tWarnstufe): boolean; var Zeit,pvFehler: extended; NB: tFFTDatenordnung; Fenster: tFenster; senkrecht: boolean; s: string; begin result:=false; warteaufBeendigungDesLeseThreads; Zeit:=now; NB:=doBetrQdr; Fenster.Breite:=0; Fenster.Rand:=0; Fenster.aktiv:=false; senkrecht:=true; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); end; if s='Ende' then break; if startetMit('Nachbereitung:',s) then begin if not strToFftDo(NB,s) then exit; continue; end; if startetMit('Fenster:',s) then begin if senkrecht then Fenster.Rand:=round(kont2diskFak('t',exprtofloat(st,s))) else Fenster.Rand:=round(kont2diskFak('x',exprtofloat(st,s))); Fenster.aktiv:=true; continue; end; if s='senkrecht' then begin senkrecht:=true; continue; end; if s='waagerecht' then begin senkrecht:=false; continue; end; gibAus('Verstehe Option '''+s+''' nicht bei Erstellung einer FFT!',3); exit; until false; if senkrecht then Fenster.Breite:=_tsiz - Fenster.Rand else Fenster.Breite:=_xsteps - Fenster.Rand; if not st then begin gibAus('berechne FFT ...',3); if not fft(threads,senkrecht,false,doRes,NB,Fenster,pvFehler,Warn) then begin gibAus('Es traten Fehler auf!',3); exit; end; gibAus(' (Parseval-Fehler = '+floattostr(pvFehler)+')',3); end; Transformationen:=tFFTTransformation.create(Transformationen,not senkrecht,senkrecht); if not st then begin eWerte.holeRam(0); gibAus('... fertig! '+timetostr(now-Zeit),3); end; result:=true; end; function tWerte.berechneFFT2d(st: boolean; var f: tMyStringlist; threads: longint; Warn: tWarnstufe): boolean; var Zeit,pvFehler: extended; NB,preOrd: tFFTDatenordnung; Fensters: array[boolean] of tFenster; s: string; b,spiegeln: boolean; begin result:=false; warteaufBeendigungDesLeseThreads; Zeit:=now; NB:=doBetrQdr; for b:=false to true do begin Fensters[b].Breite:=0; Fensters[b].Rand:=0; Fensters[b].aktiv:=false; end; spiegeln:=false; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); end; if s='Ende' then break; if startetMit('Nachbereitung:',s) then begin if not strToFftDo(NB,s) then exit; continue; end; if (pos('-Fenster:',s)=2) and (s[1] in ['x','t']) then begin b:=s[1]='t'; delete(s,1,pos(':',s)); s:=trim(s); if b then Fensters[b].Rand:=round(kont2diskFak('t',exprtofloat(st,s))) else Fensters[b].Rand:=round(kont2diskFak('x',exprtofloat(st,s))); Fensters[b].aktiv:=true; continue; end; if s='x-Spiegelung' then begin spiegeln:=true; continue; end; gibAus('Verstehe Option '''+s+''' nicht bei Erstellung einer zweidimensionalen FFT!',3); exit; until false; Fensters[true].Breite:=_tsiz-Fensters[true].Breite; Fensters[false].Breite:=_xsteps-Fensters[false].Breite; if NB=doResIms then preOrd:=doResIms else preOrd:=doResSmi; if st then begin result:=true; exit; end; Transformationen:=tFFTTransformation.create(Transformationen,true,true); gibAus('... fertig! '+timetostr(now-Zeit),3); if spiegeln then begin gibAus('Werte spiegeln ...',3); spiegle(threads); gibAus('... fertig! '+timetostr(now-Zeit),3); end; gibAus('berechne t-FFT ...',3); if not fft(threads,true,false,doRes,preOrd,Fensters[true],pvFehler,Warn) then begin gibAus('Es traten Fehler auf!',3); exit; end; gibAus(' (Parseval-Fehler = '+floattostr(pvFehler)+')',3); gibAus('... fertig! '+timetostr(now-Zeit),3); gibAus('berechne x-FFT ...',3); if not fft(threads,false,false,doRes,preOrd,Fensters[false],pvFehler,Warn) then begin gibAus('Es traten Fehler auf!',3); exit; end; gibAus(' (Parseval-Fehler = '+floattostr(pvFehler)+')',3); gibAus('... fertig! '+timetostr(now-Zeit),3); gibAus('Wertenachbearbeiten ...',3); case genauigkeit of gSingle: sWerte.fft2dNachbearbeitungA(NB); gDouble: dWerte.fft2dNachbearbeitungA(NB); gExtended: eWerte.fft2dNachbearbeitungA(NB); end{of case}; case NB of doBetr,doBetrQdr: fft2dNachbearbeitung(threads,nb); // die Hauptarbeit end{of case}; gibAus('... fertig! '+timetostr(now-Zeit),3); result:=true; end; function tWerte.erzeugeLinearesBild(st: boolean; var f: tMyStringlist; maxThreads: longint): boolean; var s,datei: string; i,j,k,schriftgroesze: longint; xzoom,yzoom,wert,schritt,miw,maw,Zeit, xp0,tp0: extended; xmin,xmax,tmin,tmax,xp,tp, breite,hoehe,lof,rof,oof,uof: longint; Paletten: pTPalettenArray; Nachbearbeitungen: tTransformationArray; Ausschnitt: tTransformation; BilderThreads: array of TBilderthread; fertig,Rahmen: boolean; img: file; Achsen: array of TAchse; fontRenderer: tFontRenderer; beschriftungen: array of tBeschriftung; verwKonturen: array of tZuZeichnendeKontur; musterKontur: tZuZeichnendeKontur; quellen: tWerteArray; procedure aufraeumen; var ii: longint; begin for ii:=0 to length(Nachbearbeitungen)-1 do zerstoereTransformationWennObsolet(Nachbearbeitungen[ii]); setlength(Nachbearbeitungen,0); Ausschnitt.free; Ausschnitt:=nil; for ii:=0 to length(BilderThreads)-1 do if assigned(BilderThreads[ii]) then BilderThreads[ii].free; setlength(BilderThreads,0); for ii:=0 to length(beschriftungen)-1 do if assigned(beschriftungen[ii]) then beschriftungen[ii].free; setlength(beschriftungen,0); setlength(Achsen,0); if assigned(fontRenderer) then fontRenderer.free; for ii:=0 to length(verwKonturen)-1 do verwKonturen[ii].free; setlength(verwKonturen,0); musterKontur.free; end; begin result:=false; warteaufBeendigungDesLeseThreads; Zeit:=now; if not st then gibAus('erzeuge lineares Bild aus '+bezeichner+' ...',3); datei:=''; xzoom:=1; yzoom:=1; xmin:=0; xmax:=_xsteps-1; tmin:=0; tmax:=_tsiz-1; schriftgroesze:=24; setlength(quellen,1); quellen[0]:=self; setlength(Nachbearbeitungen,1); Nachbearbeitungen[0]:=tKeineTransformation.create; setlength(Paletten,1); findePalette(Paletten[0],'Graustufen'); setlength(Achsen,0); setlength(verwKonturen,0); musterKontur:=tZuZeichnendeKontur.create; setlength(beschriftungen,0); setlength(BilderThreads,0); Ausschnitt:=nil; Rahmen:=false; fontRenderer:=nil; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende in '''+paramstr(1)+'''!',3); aufraeumen; exit; end; if startetMit('Datei:',s) then begin datei:=s; continue; end; if startetMit('Vergrößerung:',s) then begin xzoom:=exprtofloat(st,s); yzoom:=exprtofloat(st,s); continue; end; if startetMit('x-Vergrößerung:',s) then begin xzoom:=exprtofloat(st,s); continue; end; if startetMit('t-Vergrößerung:',s) then begin yzoom:=exprtofloat(st,s); continue; end; if self.dichtenParameterErkannt(st,s,maxThreads,xmin,xmax,tmin,tmax) then continue; if startetMit('xmin:',s) then begin xmin:=kont2disk('x',exprtofloat(st,s)); continue; end; if startetMit('xmax:',s) then begin xmax:=kont2disk('x',exprtofloat(st,s)); continue; end; if startetMit('tmin:',s) then begin tmin:=kont2disk('t',exprtofloat(st,s)); continue; end; if startetMit('tmax:',s) then begin tmax:=kont2disk('t',exprtofloat(st,s)); continue; end; if startetMit('Palette:',s) then begin if s[1] in ['0'..'9'] then i:=strtoint(erstesArgument(s)) else i:=0; if i>=length(Paletten) then setlength(Paletten,i+1); if not findePalette(Paletten[i],s) then begin gibAus('Kenne Palette '''+s+''' nicht!',3); aufraeumen; exit; end; continue; end; if startetMit('Schriftgröße:',s) then begin schriftgroesze:=strtoint(s); continue; end; if s='Rahmen' then begin Rahmen:=true; continue; end; if startetMit('Nachbearbeitung:',s) then begin if s[1] in ['0'..'9'] then i:=strtoint(erstesArgument(s)) else i:=0; if i>=length(nachbearbeitungen) then begin j:=length(nachbearbeitungen); setlength(nachbearbeitungen,i+1); while j'' do begin setlength(verwKonturen,length(verwKonturen)+1); i:=findeKontur(erstesArgument(s),nil,Wertes,Konturen,false); if (i<0) or (i>=length(Konturen^)) then begin gibAus('Die Kontur gibt es nicht!',3); aufraeumen; exit; end; verwKonturen[length(verwKonturen)-1]:=tZuZeichnendeKontur.create(musterKontur,Konturen^[i]); end; until false; continue; end; if startetMit('Daten:',s) then begin i:=strtoint(erstesArgument(s)); if i>=length(quellen) then begin j:=length(quellen); setlength(quellen,i+1); while jlength(Quellen)) or (length(Nachbearbeitungen)<>length(Quellen)) then begin gibAus( 'Die Anzahl der Paletten ('+inttostr(length(Paletten))+'), '+ 'der Daten ('+inttostr(length(Quellen))+') und '+ 'der Nachbearbeitungen ('+inttostr(length(nachbearbeitungen))+') stimmen nicht überein!',3); aufraeumen; exit; end; if st then begin result:=true; aufraeumen; exit; end; if _maxW=_minW then begin gibAus('Zu geringe Dynamik um Dichten auflösen zu können!',3); aufraeumen; exit; end; xmin:=max(xmin,0); xmax:=min(xmax,_xsteps-1); tmin:=max(tmin,0); tmax:=min(tmax,_tsiz-1); gibAus('('+inttostr(xmin)+'-'+inttostr(xmax)+'x'+inttostr(tmin)+'-'+inttostr(tmax)+')',3); gibAus(' ('+floattostr(Transformationen.xstart)+'-'+floattostr(Transformationen.xstop)+' x '+floattostr(Transformationen.tstart)+'-'+floattostr(Transformationen.tstop)+')',3); breite:=round((xmax-xmin+1)*xzoom); hoehe:=round((tmax-tmin+1)*yzoom); Ausschnitt:=tKoordinatenAusschnitt.create(Transformationen,xmin,xmax,tmin,tmax); if (breite=1) or (hoehe=1) then begin gibAus('Keine/kaum Bildpunkte innerhalb der festgelegten Grenzen!',3); aufraeumen; exit; end; gibAus(inttostr(breite)+' x '+inttostr(hoehe)+' Pixel',3); fontRenderer:=tFontRenderer.create(schriftgroesze); setlength(Beschriftungen,0); for i:=0 to length(Achsen)-1 do begin if Achsen[i].Lage in [lOben,lUnten] then begin miw:=Ausschnitt.achsen['x','x']; maw:=Ausschnitt.achsen['x','y']; end else begin miw:=Ausschnitt.achsen['y','x']; maw:=Ausschnitt.achsen['y','y']; end; schritt:=(maw-miw)/Achsen[i].Striche; j:=round(ln(schritt)/ln(10)); schritt:=Achsen[i].faktor*power(10,j); wert:=ceil(miw/schritt)*schritt; while wert<=maw do begin setlength(beschriftungen,length(beschriftungen)+1); beschriftungen[length(beschriftungen)-1]:=tBeschriftung.create; beschriftungen[length(beschriftungen)-1].bBreite:=Breite; beschriftungen[length(beschriftungen)-1].bHoehe:=Hoehe; beschriftungen[length(beschriftungen)-1].Rahmen:=Rahmen; with beschriftungen[length(beschriftungen)-1] do begin fontRend:=fontRenderer; lage:=Achsen[i].lage; // position:=(wert-miw)/(maw-miw); position:=Ausschnitt.wertZuPositionAufAchse(Achsen[i].Lage,wert); if (position<0) or (position>1) then begin gibAus('Der Wert '+floattostr(wert)+' liegt außerhalb des Bildes ('+floattostr(position)+') - das sollte eigentlich nicht passieren!',3); beschriftungen[length(beschriftungen)-1].free; setlength(beschriftungen,length(beschriftungen)-1); aufraeumen; exit; end else begin if lage in [lOben,lUnten] then position:=position*bBreite else position:=position*bHoehe; inhalt:=floattostr(wert); end; end; wert:=wert+schritt; end; end; gibAus(inttostr(length(Beschriftungen))+' Zahlen an den Achsen',3); lof:=Byte(Rahmen); rof:=Byte(Rahmen); oof:=Byte(Rahmen); uof:=Byte(Rahmen); for i:=0 to length(beschriftungen)-1 do with Beschriftungen[i] do begin lof:=max(lof,-links); rof:=max(rof,1+rechts-bBreite); oof:=max(oof,-oben); uof:=max(uof,1+unten-bHoehe); end; if lof+oof+rof+uof>0 then gibAus('Extra-Ränder: '+inttostr(lof)+' Pixel links, '+inttostr(oof)+' Pixel oben, '+inttostr(rof)+' Pixel rechts und '+inttostr(uof)+' Pixel unten.',3); setlength(Bilderthreads,maxThreads); for i:=0 to length(Bilderthreads)-1 do Bilderthreads[i]:=tBilderthread.create(i,length(Bilderthreads),breite,hoehe,lof,oof,rof,uof,quellen,xmin,xmax,tmin,tmax,xzoom,yzoom,Nachbearbeitungen,paletten,@Beschriftungen,rahmen); for i:=0 to length(Bilderthreads)-1 do begin gibAus('starte Thread '+inttostr(i)+' ...',1); Bilderthreads[i].suspended:=false; gibAus('... ok!',1); end; repeat sleep(10); fertig:=true; for i:=0 to length(Bilderthreads)-1 do fertig:=fertig and Bilderthreads[i].fertig; until fertig; gibAus('Alle Threads beendet, Konturen einfügen ...',1); for i:=0 to length(verwKonturen)-1 do begin for j:=0 to length(BilderThreads)-1 do bilderThreads[j].initAnzahlensFuerKontur; for j:=0 to length(verwKonturen[i].kontur.orte)-1 do begin xp0:=(kont2diskFak('x',verwKonturen[i].kontur.orte[j]['x'])-xmin)*xzoom; tp0:=(kont2diskFak('t',verwKonturen[i].kontur.orte[j]['y'])-tmin)*yzoom; for xp:=ceil(xp0-verwKonturen[i].dicke/2) to floor(xp0+verwKonturen[i].dicke/2) do for tp:=ceil(tp0-verwKonturen[i].dicke/2) to floor(tp0+verwKonturen[i].dicke/2) do if (0<=xp) and (xp=Bilderthreads[k+1].xpmi) do inc(k); if Bilderthreads[k].anzahlens[0,(tp+oof)*Bilderthreads[k].Breite + xp - Bilderthreads[k].xpmi] = 0 then begin Bilderthreads[k].anzahlens[0,(tp+oof)*Bilderthreads[k].Breite + xp - Bilderthreads[k].xpmi]:=1; Bilderthreads[k].farben[(tp+oof)*Bilderthreads[k].Breite + xp - Bilderthreads[k].xpmi]:= mischeFarben( Bilderthreads[k].farben[(tp+oof)*Bilderthreads[k].Breite + xp - Bilderthreads[k].xpmi], verwKonturen[i].farbe, verwKonturen[i].deckKraft ); end; end; end; end; gibAus('fertig, speichere Bild ...',1); assign(img,datei); rewrite(img,1); schreibeBmpHeader(img,breite+lof+rof,hoehe+oof+uof); for j:=-oof to uof+hoehe-1 do begin for i:=0 to length(Bilderthreads)-1 do blockwrite(img,Bilderthreads[i].farben[(j+oof)*Bilderthreads[i].Breite],3*Bilderthreads[i].Breite); i:=0; blockwrite(img,i,(4-(((lof+breite+rof)*3) mod 4)) mod 4); end; close(img); gibAus('... Threads freigeben ...',1); aufraeumen; result:=true; gibAus('... fertig '+timetostr(now-Zeit),3); end; function tWerte.erzeugeAscii(st: boolean; var f: tMyStringlist): boolean; var datei,s,separator: string; outf: textfile; i,j: longint; xmin,xmax,tmin,tmax: longint; Zeit: extended; mitKoordinaten: byte; begin result:=false; warteaufBeendigungDesLeseThreads; Zeit:=now; gibAus('erzeuge Ascii-Datei ...',3); datei:=''; xmin:=0; xmax:=_xsteps-1; tmin:=0; tmax:=_tsiz-1; mitKoordinaten:=0; separator:=','; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende in '''+paramstr(1)+'''!',3); exit; end; if startetMit('Datei:',s) then begin datei:=s; continue; end; if startetMit('xmin:',s) then begin xmin:=kont2disk('x',exprtofloat(st,s)); continue; end; if startetMit('xmax:',s) then begin xmax:=kont2disk('x',exprtofloat(st,s)); continue; end; if startetMit('tmin:',s) then begin tmin:=kont2disk('t',exprtofloat(st,s)); continue; end; if startetMit('tmax:',s) then begin tmax:=kont2disk('t',exprtofloat(st,s)); continue; end; if (s='Koordinaten einfügen') and ((_xsteps=1) or (_tsiz=1)) then begin mitKoordinaten:=byte(_xsteps=1)*2 + byte(_tsiz=1); continue; end; if startetMit('Separator:',s) then begin if s='Leerzeichen' then begin Separator:=' '; continue; end; if s='Tab' then begin Separator:=#9; continue; end; Separator:=s; continue; end; if s='Ende' then break; gibAus('Verstehe Option '''+s+''' nicht bei Erzeugung einer Ascii-Datei!',3); exit; until false; if st then begin result:=true; exit; end; assign(outf,datei); rewrite(outf); case mitKoordinaten of 0: case Genauigkeit of gSingle: for i:=max(0,tmin) to min(_tsiz-1,tmax) do begin s:=''; for j:=max(0,xmin) to min(_xsteps-1,xmax) do s:=s+floattostr(sWerte.werte[i*_xsteps+j])+separator; delete(s,length(s),1); writeln(outf,s); end; gDouble: for i:=max(0,tmin) to min(_tsiz-1,tmax) do begin s:=''; for j:=max(0,xmin) to min(_xsteps-1,xmax) do s:=s+floattostr(dWerte.werte[i*_xsteps+j])+separator; delete(s,length(s),1); writeln(outf,s); end; gExtended: for i:=max(0,tmin) to min(_tsiz-1,tmax) do begin s:=''; for j:=max(0,xmin) to min(_xsteps-1,xmax) do s:=s+floattostr(eWerte.werte[i*_xsteps+j])+separator; delete(s,length(s),1); writeln(outf,s); end; end{of Case}; 1: case Genauigkeit of gSingle: for i:=max(0,xmin) to min(_xsteps-1,xmax) do writeln(outf,floattostr(disk2kont('x',i))+separator+floattostr(sWerte.werte[i])); gDouble: for i:=max(0,xmin) to min(_xsteps-1,xmax) do writeln(outf,floattostr(disk2kont('x',i))+separator+floattostr(dWerte.werte[i])); gExtended: for i:=max(0,xmin) to min(_xsteps-1,xmax) do writeln(outf,floattostr(disk2kont('x',i))+separator+floattostr(eWerte.werte[i])); end{of Case}; 2: case Genauigkeit of gSingle: for i:=max(0,tmin) to min(_tsiz-1,tmax) do writeln(outf,floattostr(disk2kont('t',i))+separator+floattostr(sWerte.werte[i])); gDouble: for i:=max(0,tmin) to min(_tsiz-1,tmax) do writeln(outf,floattostr(disk2kont('t',i))+separator+floattostr(dWerte.werte[i])); gExtended: for i:=max(0,tmin) to min(_tsiz-1,tmax) do writeln(outf,floattostr(disk2kont('t',i))+separator+floattostr(eWerte.werte[i])); end{of Case}; 3: case Genauigkeit of gSingle: writeln(outf,floattostr(disk2kont('x',0))+separator+floattostr(disk2kont('t',0))+separator+floattostr(sWerte.werte[0])); gDouble: writeln(outf,floattostr(disk2kont('x',0))+separator+floattostr(disk2kont('t',0))+separator+floattostr(dWerte.werte[0])); gExtended: writeln(outf,floattostr(disk2kont('x',0))+separator+floattostr(disk2kont('t',0))+separator+floattostr(eWerte.werte[0])); end{of Case}; end{of Case}; close(outf); gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.erzeugeLineout(st: boolean; params: string): boolean; var ab: array[boolean,boolean] of longint; s: string; f: textfile; Zeit: extended; i: longint; b1,b2: boolean; begin result:=false; warteaufBeendigungDesLeseThreads; Zeit:=now; if not st then begin gibAus('erzeuge Lineout ...',3); gibAus('insgesamt: '+floattostr(Transformationen.xstart)+'..'+floattostr(Transformationen.xstop)+' x '+floattostr(Transformationen.tstart)+'..'+floattostr(Transformationen.tstop),3); end; for b1:=false to true do for b2:=false to true do ab[b1,b2]:=0; params:=trim(params); if startetMit('integriere ',params) then begin if startetMit('horizontal',params) then b1:=true else if startetMit('vertikal',params) then b1:=false else exit; if st then begin result:=true; exit; end; if b1 then s:='horizontal' else s:='vertikal'; gibAus('... schreibe in '''+params+''', integriere '+s,3); if pos(' ',params)>0 then begin gibAus('Leerzeichen im Dateinamen sind nicht erlaubt!',3); exit; end; assignFile(f,params); rewrite(f); for i:=0 to _xsteps*byte(not b1)+_tsiz*byte(b1)-1 do schreibeWertIntegriert(f,i,b1); closefile(f); end else begin for b1:=false to true do if startetMit('(',params) then begin s:=erstesArgument(params,','); ab[b1,false]:=kont2disk('x',exprtofloat(st,s)); s:=erstesArgument(params,')'); ab[b1,true]:=kont2disk('t',exprtofloat(st,s)); end else begin ab[true,false]:=ab[false,false]; ab[true,true]:=ab[false,true]; ab[false,false]:=(_xsteps-1)*byte(not b1); ab[false,true]:=(_tsiz-1)*byte(not b1); end; if st then begin result:=true; exit; end; if pos(' ',params)>0 then begin gibAus('Leerzeichen im Dateinamen sind nicht erlaubt!',3); exit; end; s:='... schreibe in '''+params+''' ('; for i:=0 to 3 do begin s:=s+inttostr(ab[odd(i div 2),odd(i)]); if not odd(i) then s:=s+',' else if i=1 then s:=s+')--('; end; gibAus(s+') ...',3); assignFile(f,params); rewrite(f); if abs(ab[true,true]-ab[false,true])>abs(ab[true,false]-ab[false,false]) then begin if ab[true,true]>ab[false,true] then begin for i:=ab[false,true] to ab[true,true] do schreibeWert(f,round(ab[false,false]+i/(ab[true,true]-ab[false,true])*(ab[true,false]-ab[false,false])),i); end else for i:=ab[false,true] downto ab[true,true] do schreibeWert(f,round(ab[false,false]+i/(ab[true,true]-ab[false,true])*(ab[true,false]-ab[false,false])),i); end else begin if ab[true,false]>ab[false,false] then begin for i:=ab[false,false] to ab[true,false] do schreibeWert(f,i,round(ab[false,true]+i/(ab[true,false]-ab[false,false])*(ab[true,true]-ab[false,true]))); end else for i:=ab[false,false] downto ab[true,false] do schreibeWert(f,i,round(ab[false,true]+i/(ab[true,false]-ab[false,false])*(ab[true,true]-ab[false,true]))); end; closefile(f); end; gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.erzeugeBinning(st: boolean; params: string): boolean; var senkrecht,linien: boolean; Zeit,x0,dx: extended; begin result:=false; warteaufBeendigungDesLeseThreads; Zeit:=now; if not st then begin gibAus('erzeuge Binning ...',3); gibAus('insgesamt: '+floattostr(Transformationen.xstart)+'..'+floattostr(Transformationen.xstop)+' x '+floattostr(Transformationen.tstart)+'..'+floattostr(Transformationen.tstop),3); end; senkrecht:=Transformationen.xstart=Transformationen.xstop; if (not senkrecht) and (Transformationen.tstart<>Transformationen.tstop) then begin gibAus('Binning geht nur auf eindimensionalen Daten!',3); exit; end; params:=trim(params); linien:=startetMit('(Gnuplotlinien)',params); x0:=kont2disk(char(ord('x')+byte(senkrecht)),exprtofloat(st,erstesArgument(params))); dx:=kont2diskFak(char(ord('x')+byte(senkrecht)),exprtofloat(st,erstesArgument(params))); if pos(' ',params)>0 then begin gibAus('Leerzeichen im Dateinamen sind nicht erlaubt!',3); exit; end; if not st then case Genauigkeit of gSingle: sWerte.erzeugeBinning(senkrecht,linien,x0,dx,params); gDouble: dWerte.erzeugeBinning(senkrecht,linien,x0,dx,params); gExtended: eWerte.erzeugeBinning(senkrecht,linien,x0,dx,params); end{of case}; gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; procedure tWerte.schreibeWert(var f: textfile; x,y: longint); begin case Genauigkeit of gSingle: sWerte.schreibeWert(f,x,y); gDouble: dWerte.schreibeWert(f,x,y); gExtended: eWerte.schreibeWert(f,x,y); end{of Case}; end; procedure tWerte.spiegle(threads: longint); begin spiegle(threads,0,_tsiz-1); end; procedure tWerte.spiegle(threads,tmin,tmax: longint); var i: longint; sts: array of tSpiegelthread; fertig: boolean; begin warteaufBeendigungDesLeseThreads; setlength(sts,threads); for i:=0 to length(sts)-1 do sts[i]:=tSpiegelthread.create( tmin+round(i*(tmax+1-tmin)/length(sts)), tmin+round((i+1)*(tmax+1-tmin)/length(sts))-1, self); repeat sleep(10); fertig:=true; for i:=0 to length(sts)-1 do fertig:=fertig and sts[i].fertig; until fertig; for i:=0 to length(sts)-1 do sts[i].free; Transformationen:=tSpiegelungsTransformation.create(Transformationen); gibAus('Alle Spiegelthreads fertig!',1); end; procedure tWerte.fft2dNachbearbeitung(threads: longint; nb: tFFTDatenordnung); var i: longint; FNTs: array of tFFT2dNBThread; fertig: boolean; begin // bearbeitet nur den Hauptteil (außer erster und mittlerer Zeile/Spalte) nach! setlength(FNTs,threads); for i:=0 to length(FNTs)-1 do FNTs[i]:=TFFT2dNBThread.create( round(i*(_xsteps div 2 -1)/length(FNTs))+1, round((i+1)*(_xsteps div 2 -1)/length(FNTs)), self, nb); repeat sleep(10); fertig:=true; for i:=0 to length(FNTs)-1 do fertig:=fertig and FNTs[i].fertig; until fertig; for i:=0 to length(FNTs)-1 do FNTs[i].free; gibAus('Alle FFT2dNBThreads fertig!',1); end; function tWerte.exprtofloat(st: boolean; s: string): extended; begin case genauigkeit of gSingle: result:=matheunit.exprtofloat(st,s,swerte.params.knownValues,@callBackGetValue); gDouble: result:=matheunit.exprtofloat(st,s,dwerte.params.knownValues,@callBackGetValue); gExtended: result:=matheunit.exprtofloat(st,s,ewerte.params.knownValues,@callBackGetValue); end; end; function tWerte.paramsdump: string; begin result:=bezeichner+' '+inttostr(integer(genauigkeit))+' '+inttostr(_xsteps)+' '+inttostr(_tsiz) +' '+floattostr(sWerte.params.xstart)+'-'+floattostr(sWerte.params.xstop) +'x'+floattostr(sWerte.params.tstart)+'-'+floattostr(sWerte.params.tstop); if sWerte.params<>eWerte.params then result:='!! '+result; end; procedure tWerte.beendeLeseThreadWennFertig; begin if assigned(leseThread) and leseThread.fertig then begin leseThread.free; leseThread:=nil; end; end; // tZuZeichnendeKontur ********************************************************* constructor tZuZeichnendeKontur.create; begin inherited create; farbe:=rgb($00,$00,$00); deckKraft:=1; dicke:=1; kontur:=nil; end; constructor tZuZeichnendeKontur.create(original: tZuZeichnendeKontur; kont: tKontur); begin inherited create; farbe:=original.farbe; deckKraft:=original.deckKraft; dicke:=original.dicke; kontur:=kont; end; destructor tZuZeichnendeKontur.destroy; begin kontur:=nil; inherited destroy; end; // tLogThread ****************************************************************** constructor tLogThread.create; begin inherited create(true); raisedException:=nil; freeonterminate:=false; fertig:=false; end; destructor tLogThread.destroy; begin raisedException.free; if (not behalteLogs) and not odd(__ausgabenMaske) then cleanupLog(threadID); inherited destroy; end; function tLogThread.rFertig: boolean; var ei: string; i: longint; begin if assigned(raisedException) then begin if self is tBefehlThread then begin if assigned((self as tBefehlThread).p) then begin ei:=' '''+(self as tBefehlThread).p.Executable+''''; for i:=0 to (self as tBefehlThread).p.parameters.count-1 do ei:=ei+' '''+(self as tBefehlThread).p.parameters[i]+''''; ei:=ei; end else ei:=': p=NIL'; end else ei:=''; raise raisedException; raise exception.create('Fehler innerhalb eines Threads ('+className+')'+ei+'!'); end; result:=_fertig; end; procedure tLogThread.execute; begin try stExecute; except on E: exception do begin dumpExceptionCallStack(E); raisedException:=E; end; end; fertig:=true; end; // tLiKoThread ***************************************************************** constructor tLiKoThread.create(lk: pTLiKo; pWerte: tWerte; xMin,xMax,tMin,tMax,xOff,tOff: longint); begin inherited create; liKo:=lk; pW:=pWerte; xMi:=xMin; xMa:=xMax; tMi:=tMin; tMa:=tMax; tOf:=tOff; xOf:=xOff; gibAus('Starte LiKo-Berechnungsthread!',1); suspended:=false; end; destructor tLiKoThread.destroy; begin inherited destroy; end; procedure tLiKoThread.stExecute; var i,j,k: longint; out0,in0: boolean; begin gibAus('LiKo-Berechnungsthread gestartet ('+inttostr(xmi)+'-'+inttostr(xma)+'x'+inttostr(tmi)+'-'+inttostr(tma)+') ...',1); for i:=0 to length(liKo^)-1 do gibAus(liko^[i].werte.bezeichner+' * '+floattostr(liko^[i].alpha),1); out0:=true; in0:=true; case liKo^[0].werte.Genauigkeit of //<> gSingle: for j:=tMi to tMa do begin if (tMa-j) mod ((tMa-tMi) div 10) = 0 then gibAus('LiKo-Berechnungsthread: '+inttostr(j)+'/'+inttostr(tMi)+'..'+inttostr(tMa)+' ('+inttostr(xMi)+'..'+inttostr(xMa)+')',1); for i:=xMi to xMa do begin pW.eWerte.werte[i+j*pW._xsteps]:=0; for k:=0 to length(liKo^)-1 do begin pW.eWerte.werte[i+j*pW._xsteps]:= pW.eWerte.werte[i+j*pW._xsteps] + liKo^[k].alpha*liKo^[k].werte.sWerte.werte[(xOf+i) + (tOf+j)*liKo^[k].werte._xsteps]; in0:=in0 and (liKo^[k].werte.sWerte.werte[(xOf+i) + (tOf+j)*liKo^[k].werte._xsteps]=0); end; out0:=out0 and (pW.eWerte.werte[i+j*pW._xsteps]=0); end; end; gDouble: for j:=tMi to tMa do begin if (tMa-j) mod ((tMa-tMi) div 10) = 0 then gibAus('LiKo-Berechnungsthread: '+inttostr(j)+'/'+inttostr(tMi)+'..'+inttostr(tMa)+' ('+inttostr(xMi)+'..'+inttostr(xMa)+')',1); for i:=xMi to xMa do begin pW.eWerte.werte[i+j*pW._xsteps]:=0; for k:=0 to length(liKo^)-1 do begin pW.eWerte.werte[i+j*pW._xsteps]:= pW.eWerte.werte[i+j*pW._xsteps] + liKo^[k].alpha*liKo^[k].werte.dWerte.werte[(xOf+i) + (tOf+j)*liKo^[k].werte._xsteps]; in0:=in0 and (liKo^[k].werte.dWerte.werte[(xOf+i) + (tOf+j)*liKo^[k].werte._xsteps]=0); end; out0:=out0 and (pW.eWerte.werte[i+j*pW._xsteps]=0); end; end; gExtended: for j:=tMi to tMa do begin if (tMa-j) mod ((tMa-tMi) div 10) = 0 then gibAus('LiKo-Berechnungsthread: '+inttostr(j)+'/'+inttostr(tMi)+'..'+inttostr(tMa)+' ('+inttostr(xMi)+'..'+inttostr(xMa)+')',1); for i:=xMi to xMa do begin pW.eWerte.werte[i+j*pW._xsteps]:=0; for k:=0 to length(liKo^)-1 do begin pW.eWerte.werte[i+j*pW._xsteps]:= pW.eWerte.werte[i+j*pW._xsteps] + liKo^[k].alpha*liKo^[k].werte.eWerte.werte[(xOf+i) + (tOf+j)*liKo^[k].werte._xsteps]; in0:=in0 and (liKo^[k].werte.eWerte.werte[(xOf+i) + (tOf+j)*liKo^[k].werte._xsteps]=0); end; out0:=out0 and (pW.eWerte.werte[i+j*pW._xsteps]=0); end; end; end{of Case}; if in0 then gibAus('Nur Nullen im Input!',1); if out0 then gibAus('Nur Nullen im Output!',1); gibAus('... und fertig!',1); fertig:=true; end; // tQuotientThread ************************************************************* constructor tQuotientThread.create(dividend, divisor, quotient: tWerte; epsilon: extended; xMin,xMax,tMin,tMax,xOff,tOff: longint); begin inherited create; dend:=dividend; sor:=divisor; quot:=quotient; eps:=epsilon; xMi:=xMin; xMa:=xMax; tMi:=tMin; tMa:=tMax; tOf:=tOff; xOf:=xOff; gibAus('Starte Quotient-Berechnungsthread!',1); suspended:=false; end; destructor tQuotientThread.destroy; begin inherited destroy; end; procedure tQuotientThread.stExecute; var i,j: longint; i01,i02,o0: boolean; begin gibAus('Quotient-Berechnungsthread gestartet ...',1); i01:=true; i02:=true; o0:=true; case dend.Genauigkeit of gSingle: case sor.Genauigkeit of gSingle: // single / single for j:=tMi to tMa do begin if (tMa-j) mod ((tMa-tMi) div 10) = 0 then gibAus('Quotient-Berechnungsthread: '+inttostr(j)+'/'+inttostr(tMi)+'..'+inttostr(tMa)+' ('+inttostr(xMi)+'..'+inttostr(xMa)+')',1); for i:=xMi to xMa do if abs(sor.sWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]) Bild ...',1); for j:=-oof to whoehe-1+uof do for i:=xpmi to xpma do if (j>=0) and (j=0) and (i=-1) and (j<=whoehe))) and // links (not ((i=gesBreite) and (j>=-1) and (j<=whoehe))) and // rechts (not ((j=-1) and (i>=-1) and (i<=gesBreite))) and // oben (not ((j=whoehe) and (i>=-1) and (i<=gesBreite))))); // unten farben[i-xpmi+(j+oof)*breite].rgbGreen:=farben[i-xpmi+(j+oof)*breite].rgbRed; farben[i-xpmi+(j+oof)*breite].rgbBlue:=farben[i-xpmi+(j+oof)*breite].rgbRed; end; gibAus('Thread '+inttostr(nummer)+': Beschriftung einfügen ...',1); for i:=0 to length(Beschr^)-1 do begin for j:=max(Beschr^[i].links,xpmi) to min(Beschr^[i].rechts,xpma) do for k:=Beschr^[i].oben to Beschr^[i].unten do farben[j-xpmi+(k+oof)*breite]:= andFarben( farben[j-xpmi+(k+oof)*breite], Beschr^[i].bild.farben[j-Beschr^[i].links + (k-Beschr^[i].oben)*Beschr^[i].bild.breite]); case Beschr^[i].lage of lRechts: for j:=max(Beschr^[i].bBreite,xpmi) to min(Beschr^[i].bBreite+3+byte(Rahmen),xpma) do begin farben[j-xpmi+(Beschr^[i].strich+oof)*breite].rgbRed:=$00; farben[j-xpmi+(Beschr^[i].strich+oof)*breite].rgbGreen:=$00; farben[j-xpmi+(Beschr^[i].strich+oof)*breite].rgbBlue:=$00; end; lLinks: for j:=max(-4-byte(Rahmen),xpmi) to min(-1,xpma) do begin farben[j-xpmi+(Beschr^[i].strich+oof)*breite].rgbRed:=$00; farben[j-xpmi+(Beschr^[i].strich+oof)*breite].rgbGreen:=$00; farben[j-xpmi+(Beschr^[i].strich+oof)*breite].rgbBlue:=$00; end; lOben: if (Beschr^[i].strich>=xpmi) and (Beschr^[i].strich<=xpma) then for j:=Beschr^[i].bHoehe to Beschr^[i].bHoehe+3+byte(Rahmen) do begin farben[Beschr^[i].strich-xpmi+(j+oof)*breite].rgbRed:=$00; farben[Beschr^[i].strich-xpmi+(j+oof)*breite].rgbGreen:=$00; farben[Beschr^[i].strich-xpmi+(j+oof)*breite].rgbBlue:=$00; end; lUnten: if (Beschr^[i].strich>=xpmi) and (Beschr^[i].strich<=xpma) then for j:=-4-byte(Rahmen) to -1 do begin farben[Beschr^[i].strich-xpmi+(j+oof)*breite].rgbRed:=$00; farben[Beschr^[i].strich-xpmi+(j+oof)*breite].rgbGreen:=$00; farben[Beschr^[i].strich-xpmi+(j+oof)*breite].rgbBlue:=$00; end; end{of case}; end; for k:=0 to length(wertes)-1 do if length(wertes[k])>0 then begin b:=false; for i:=0 to length(wertes[k])-1 do b:=b or (wertes[k,i]<>0); wert:=wertes[k,0]; for i:=0 to length(wertes[k])-1 do wert:=max(wert,wertes[k,i]); gibAus('Thread '+inttostr(nummer)+' hat max. ['+inttostr(k)+'] '+myfloattostr(wert),1); for i:=0 to length(wertes[k])-1 do wert:=min(wert,wertes[k,i]); gibAus('Thread '+inttostr(nummer)+' hat min. ['+inttostr(k)+'] '+myfloattostr(wert),1); if not b then gibAus('Thread '+inttostr(nummer)+' hat nur Nullen!',1); end; gibAus('Thread '+inttostr(nummer)+' fertig!',1); fertig:=true; end; procedure tBilderThread.initAnzahlensFuerKontur; var ii: longint; begin for ii:=1 to length(anzahlens)-1 do setlength(anzahlens[ii],0); setlength(anzahlens,1); setlength(anzahlens[0],length(farben)); for ii:=0 to length(anzahlens[0])-1 do anzahlens[0,ii]:=0; end; // tDichteThread *************************************************************** constructor tDichteThread.create(xmi,xma,tmi,tma: longint; const werte: tWerte); begin inherited create; xmin:=xmi; xmax:=xma; tmin:=tmi; tmax:=tma; w:=werte; maxdichte:=0; gibAus('Dichtethread kreiert: '+inttostr(xmin)+'-'+inttostr(xmax)+' '+inttostr(tmin)+'-'+inttostr(tmax),1); suspended:=false; end; destructor tDichteThread.destroy; begin inherited destroy; end; procedure tDichteThread.stExecute; begin gibAus('Dichtethread gestartet!',1); case w.Genauigkeit of gSingle: w.sWerte.gibMinMaxDichten(minDichte,maxDichte,xmin,xmax,tmin,tmax); gDouble: w.dWerte.gibMinMaxDichten(minDichte,maxDichte,xmin,xmax,tmin,tmax); gExtended: w.eWerte.gibMinMaxDichten(minDichte,maxDichte,xmin,xmax,tmin,tmax); end{of case}; gibAus('Dichtethread fertig!',1); fertig:=true; end; // tFFTThread ****************************************************************** constructor tFFTThread.create(werte: tWerte; smin,smax: longint; senkrecht,invers: boolean; const vor,nach: tFFTDatenordnung; const fenster: tFenster); var tmpFFTAlgo: tFFTAlgorithmus; begin if senkrecht then tmpFFTAlgo:=createFFTAlgorithmus(werte._tsiz,vor,nach) else tmpFFTAlgo:=createFFTAlgorithmus(werte._xsteps,vor,nach); create(werte,smin,smax,senkrecht,invers,tmpFFTAlgo,fenster); tmpFFTAlgo.free; end; constructor tFFTThread.create(werte: tWerte; smin,smax: longint; senkrecht,invers: boolean; algorithmus: tFFTAlgorithmus; const fenster: tFenster); begin inherited create; pW:=werte; smi:=smin; sma:=smax; sen:=senkrecht; inv:=invers; algo:=createFFTAlgorithmus(algorithmus); fen:=fenster; erfolg:=false; gibAus('FFTthread kreiert ('+inttostr(pW._xsteps)+' x '+inttostr(pW._tsiz)+': '+inttostr(smi)+' .. '+inttostr(sma)+'): '+algo.className,3); suspended:=false; end; destructor tFFTThread.destroy; begin inherited destroy; end; procedure tFFTThread.stExecute; begin gibAus('FFTthread gestartet ('+inttostr(pW._xsteps)+' x '+inttostr(pW._tsiz)+': '+inttostr(smi)+' .. '+inttostr(sma)+'): '+algo.className+' ...',1); case pW.Genauigkeit of gSingle: erfolg:=pW.sWerte.fft(smi,sma,sen,inv,algo,fen,pvFehler); gDouble: erfolg:=pW.dWerte.fft(smi,sma,sen,inv,algo,fen,pvFehler); gExtended: erfolg:=pW.eWerte.fft(smi,sma,sen,inv,algo,fen,pvFehler); end{of case}; gibAus('... und fertig! ',1); fertig:=true; end; // tSpiegelThread ************************************************************** constructor tSpiegelThread.create(tmi,tma: longint; pWerte: tWerte); begin inherited create; tmin:=tmi; tmax:=tma; pW:=pWerte;; gibAus('Spiegelthread kreiert: '+inttostr(tmin)+'-'+inttostr(tmax),1); suspended:=false; end; destructor tSpiegelThread.destroy; begin inherited destroy; end; procedure tSpiegelThread.stExecute; begin gibAus('Spiegelthread gestartet: '+inttostr(tMin)+'-'+inttostr(tMax)+' ...',1); case pW.Genauigkeit of gSingle: pW.sWerte.spiegle(tMin,tMax); gDouble: pW.dWerte.spiegle(tMin,tMax); gExtended: pW.eWerte.spiegle(tMin,tMax); end{of case}; gibAus('... und fertig!',1); fertig:=true; end; // tFFT2dNBThread ************************************************************** constructor tFFT2dNBThread.create(xmi,xma: longint; pWerte: tWerte; endordnung: tFFTDatenordnung); begin inherited create; xmin:=xmi; xmax:=xma; pW:=pWerte; nb:=endordnung; gibAus('FFT2d-Nachbearbeitungsthread kreiert: '+inttostr(xmin)+'-'+inttostr(xmax),1); suspended:=false; end; destructor tFFT2dNBThread.destroy; begin inherited destroy; end; procedure tFFT2dNBThread.stExecute; begin gibAus('FFT2d-Nachbearbeitungsthread gestartet: '+inttostr(xMin)+'-'+inttostr(xMax)+' ...',1); case pW.Genauigkeit of gSingle: pW.sWerte.fft2dNachbearbeitungB(xMin,xMax,nb); gDouble: pW.dWerte.fft2dNachbearbeitungB(xMin,xMax,nb); gExtended: pW.eWerte.fft2dNachbearbeitungB(xMin,xMax,nb); end{of case}; gibAus('... und fertig!',1); fertig:=true; end; // tKorrelThread *************************************************************** constructor tKorrelThread.create(quelle,ziel: tWerte; xMin,xMax: longint; wavelet: tWavelet); begin inherited create; qu:=quelle; zi:=ziel; xMi:=xMin; xMa:=xMax; wl:=wavelet; gibAus('Korrelationsthread kreiert: '+inttostr(xmin)+'-'+inttostr(xmax),1); suspended:=false; end; destructor tKorrelThread.destroy; begin inherited destroy; end; procedure tKorrelThread.stExecute; var i,j,k,hl: longint; sus,suc,tmp,pvF: extended; in0,out0: boolean; fenster: tFenster; tmpW: tWerte; tmpFFTAlgo: tFFTAlgorithmus; begin gibAus('Korrelationsberechnungsthread gestartet ...',1); gibAus('('+inttostr(xmi)+'-'+inttostr(xma)+' x '+inttostr(qu._tsiz)+'), '+inttostr(wl.werte.params.tsiz),1); in0:=true; out0:=true; pvFehler:=0; if wl.mitFFT then begin for i:=xmi to xma do for j:=0 to qu._tsiz-1 do in0:=in0 and (zi.eWerte.werte[i+j*zi._xsteps]=0); fenster.aktiv:=false; gibAus('FFT berechnen ...',1); tmpFFTAlgo:=createFFTAlgorithmus(zi._tsiz,doRes,doResIms); zi.eWerte.fft(true,false,tmpFFTAlgo,fenster,pvF); tmpFFTAlgo.free; pvFehler:=pvF+pvFehler; if wl.typ=wtSin2 then // Das Sin²-Wavelet besteht eigntlich aus zwei! tmpW:=tWerte.create(zi,xmi,xma); gibAus('... fertig, punktweise Produkte berechnen ...',1); hl:=qu._tsiz div 2; // halbe Länge for i:=xmi to xma do begin zi.eWerte.werte[i]:=zi.eWerte.werte[i]*wl.werte.werte[0]; // f_0 zi.eWerte.werte[i+hl*zi._xsteps]:=zi.eWerte.werte[i+hl*zi._xsteps]*wl.werte.werte[2*hl]; // f_n/2 if wl.typ=wtSin2 then begin // Das Sin²-Wavelet besteht eigntlich aus zwei! // und das gleiche für tmpW statt zi^: tmpW.eWerte.werte[i-xmi]:=tmpW.eWerte.werte[i-xmi]*wl.werte.werte[1]; // f_0 tmpW.eWerte.werte[i-xmi+hl*tmpW._xsteps]:=tmpW.eWerte.werte[i-xmi+hl*tmpW._xsteps]*wl.werte.werte[2*hl+1]; // f_n/2 end; for j:=1 to hl-1 do begin tmp:=zi.eWerte.werte[i+j*zi._xsteps]; // Re_j zi.eWerte.werte[i+j*zi._xsteps]:=tmp*wl.werte.werte[2*j]-zi.eWerte.werte[i+(j+hl)*zi._xsteps]*wl.werte.werte[2*(j+hl)]; // Re_j * wRe_j - Im_j * wIm_j zi.eWerte.werte[i+(j+hl)*zi._xsteps]:=tmp*wl.werte.werte[2*(j+hl)]+zi.eWerte.werte[i+(j+hl)*zi._xsteps]*wl.werte.werte[2*j]; // Re_j * wIm_j + Im_j * wRe_j if wl.typ=wtSin2 then begin // Das Sin²-Wavelet besteht eigntlich aus zwei! // und das gleiche für tmpW statt zi^: tmp:=tmpW.eWerte.werte[i-xmi+j*tmpW._xsteps]; // Re_j tmpW.eWerte.werte[i-xmi+j*tmpW._xsteps]:=tmp*wl.werte.werte[2*j+1]-tmpW.eWerte.werte[i-xmi+(j+hl)*tmpW._xsteps]*wl.werte.werte[2*(j+hl)+1]; // Re_j * wRe_j - Im_j * wIm_j tmpW.eWerte.werte[i-xmi+(j+hl)*tmpW._xsteps]:=tmp*wl.werte.werte[2*(j+hl)+1]+tmpW.eWerte.werte[i-xmi+(j+hl)*tmpW._xsteps]*wl.werte.werte[2*j+1]; // Re_j * wIm_j + Im_j * wRe_j end; end; end; gibAus('... fertig, iFFT berechnen ...',1); tmpFFTAlgo:=createFFTAlgorithmus(zi._tsiz,doResIms,doBetrQdr); zi.eWerte.fft(xmi,xma,true,true,tmpFFTAlgo,fenster,pvF); pvFehler:=pvF+pvFehler; case wl.typ of wtSin2: begin // Das Sin²-Wavelet besteht eigntlich aus zwei! tmpW.eWerte.fft(true,true,tmpFFTAlgo,fenster,pvF); pvFehler:=(pvF+pvFehler)/3; for i:=xmi to xma do for j:=0 to zi._tsiz-1 do begin zi.eWerte.werte[i+j*zi._xsteps]:=zi.eWerte.werte[i+j*zi._xsteps]+tmpW.eWerte.werte[i-xmi+j*tmpW._xsteps]; out0:=out0 and (zi.eWerte.werte[i+j*zi._xsteps]=0); end; tmpW.free; end; wtFrequenzfenster: begin // Das Frequenzfenster-Wavelet ist nur eines! pvFehler:=pvFehler/2; for i:=xmi to xma do for j:=0 to zi._tsiz-1 do out0:=out0 and (zi.eWerte.werte[i+j*zi._xsteps]=0); end; end{of case}; tmpFFTAlgo.free; gibAus(' (Parseval-Fehler = '+floattostr(pvFehler)+')',1); gibAus('... fertig',1); end else begin case qu.Genauigkeit of gSingle: for i:=xmi to xma do begin if (xma-i) mod ((xma-xmi) div 10) = 0 then gibAus(inttostr(i)+'/'+inttostr(xmi)+'-'+inttostr(xma),1); for j:=0 to zi._tsiz-1 do begin sus:=0; suc:=0; for k:=max(-wl.hlen,-j) to min(wl.hlen,qu._tsiz-j-1) do begin suc:=suc + qu.sWerte.werte[i+(j+k)*qu._xsteps]*wl.werte.werte[(k+wl.hlen)*2]; sus:=sus + qu.sWerte.werte[i+(j+k)*qu._xsteps]*wl.werte.werte[(k+wl.hlen)*2+1]; end; zi.eWerte.werte[i+j*zi._xsteps]:=(sqr(sus)+sqr(suc))/sqr(1+2*wl.hlen); in0:=in0 and (qu.sWerte.werte[i+j*qu._xsteps]=0); out0:=out0 and (zi.eWerte.werte[i+j*zi._xsteps]=0); end; end; gDouble: for i:=xmi to xma do begin if (xma-i) mod ((xma-xmi) div 10) = 0 then gibAus(inttostr(i)+'/'+inttostr(xmi)+'-'+inttostr(xma),1); for j:=0 to zi._tsiz-1 do begin sus:=0; suc:=0; for k:=max(-wl.hlen,-j) to min(wl.hlen,qu._tsiz-j-1) do begin suc:=suc + qu.dWerte.werte[i+(j+k)*qu._xsteps]*wl.werte.werte[(k+wl.hlen)*2]; sus:=sus + qu.dWerte.werte[i+(j+k)*qu._xsteps]*wl.werte.werte[(k+wl.hlen)*2+1]; end; zi.eWerte.werte[i+j*zi._xsteps]:=(sqr(sus)+sqr(suc))/sqr(1+2*wl.hlen); in0:=in0 and (qu.dWerte.werte[i+j*qu._xsteps]=0); out0:=out0 and (zi.eWerte.werte[i+j*zi._xsteps]=0); end; end; gExtended: for i:=xmi to xma do begin if (xma-i) mod ((xma-xmi) div 10) = 0 then gibAus(inttostr(i)+'/'+inttostr(xmi)+'-'+inttostr(xma),1); for j:=0 to zi._tsiz-1 do begin sus:=0; suc:=0; for k:=max(-wl.hlen,-j) to min(wl.hlen,qu._tsiz-j-1) do begin suc:=suc + qu.eWerte.werte[i+(j+k)*qu._xsteps]*wl.werte.werte[(k+wl.hlen)*2]; sus:=sus + qu.eWerte.werte[i+(j+k)*qu._xsteps]*wl.werte.werte[(k+wl.hlen)*2+1]; end; zi.eWerte.werte[i+j*zi._xsteps]:=(sqr(sus)+sqr(suc))/sqr(1+2*wl.hlen); in0:=in0 and (qu.eWerte.werte[i+j*qu._xsteps]=0); out0:=out0 and (zi.eWerte.werte[i+j*zi._xsteps]=0); end; end; end{of case}; end; if in0 then gibAus('Nur Nullen im Input der Korrelation!',1); if out0 then gibAus('Nur Nullen im Output der Korrelation!',1); gibAus('... und fertig!',1); fertig:=true; end; // tKontur ********************************************************************* constructor tKontur.create(Kont: pTKonturenArray; wert: pTWerteArray); begin inherited create(Kont,wert); setlength(orte,0); bezeichner:=''; end; destructor tKontur.destroy; begin setlength(orte,0); inherited destroy; end; function tKontur.rxmin: extended; var i: longint; begin if length(orte)=0 then begin result:=nan; exit; end; result:=orte[0]['x']; for i:=1 to length(orte)-1 do result:=min(result,orte[i]['x']); end; function tKontur.rxmax: extended; var i: longint; begin if length(orte)=0 then begin result:=nan; exit; end; result:=orte[0]['x']; for i:=1 to length(orte)-1 do result:=max(result,orte[i]['x']); end; function tKontur.rtmin: extended; var i: longint; begin if length(orte)=0 then begin result:=nan; exit; end; result:=orte[0]['y']; for i:=1 to length(orte)-1 do result:=min(result,orte[i]['y']); end; function tKontur.rtmax: extended; var i: longint; begin if length(orte)=0 then begin result:=nan; exit; end; result:=orte[0]['y']; for i:=1 to length(orte)-1 do result:=max(result,orte[i]['y']); end; function tKontur.exprtofloat(st: boolean; s: string; kvs: tKnownValues): extended; begin result:=matheunit.exprtofloat(st,s,kvs,@callBackGetValue); end; function tKontur.init(st: boolean; var f: tMyStringlist; w: pTWerteArray; mt: longint): boolean; var s,xmi,xma,tmi,tma,dx,dt: string; i,j,k: longint; begin result:=false; gibAus('Kontur erzeugen ...',1); xmi:='-1e9'; xma:='1e9'; tmi:='-1e9'; tma:='1e9'; dx:='1'; dt:='1'; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende in '''+paramstr(1)+'''!',3); exit; end; if startetMit('Datei:',s) then begin if length(orte)>0 then begin gibAus('Diese Kontur hat schon Werte!',3); exit; end; if not liesVonDatei(st,s,exprtofloat(st,xmi,nil),exprtofloat(st,xma,nil),exprtofloat(st,tmi,nil),exprtofloat(st,tma,nil)) then exit; continue; end; if startetMit('Werte:',s) then begin if length(orte)>0 then begin gibAus('Diese Kontur hat schon Werte!',3); exit; end; if not erzeugeAusWerten(st,s,w,mt,xmi,xma,tmi,tma) then exit; continue; end; if startetMit('xmin:',s) then begin xmi:=s; continue; end; if startetMit('xmax:',s) then begin xma:=s; continue; end; if startetMit('tmin:',s) then begin tmi:=s; continue; end; if startetMit('tmax:',s) then begin tma:=s; continue; end; if startetMit('dx:',s) then begin dx:=s; continue; end; if startetMit('dy:',s) or startetMit('dt:',s) then begin dt:=s; continue; end; if startetMit('reduziere nach ',s) then begin if not st then if not sortiere_nach_y(mt) then exit; if s='rechts' then begin i:=0; j:=0; while jOrte[k]['x'] then k:=j; inc(j); end; Orte[i]:=Orte[k]; inc(i); end; setlength(Orte,i); continue; end; if s='links' then begin i:=0; j:=0; while jxma) or (tmp['y']tma) then continue; if i>=length(orte) then setlength(orte,length(orte)+Speicherhappen); orte[i]:=tmp; inc(i); end; closefile(tf); setlength(orte,i); result:=true; end; function tKontur.erzeugeAusWerten(st: boolean; s: string; w: pTWerteArray; mt: longint; _xmin,_xmax,_tmin,_tmax: string): boolean; var i,j,k,l,xmi,xma,tmi,tma: longint; Schwelle: extended; fertig: boolean; Konturthreads: array of tKonturAusWertenThread; begin result:=false; i:=findeWerte(erstesArgument(s),nil,w,nil,false); if i<0 then exit; Schwelle:=w^[i].exprtofloat(false,s); if _xmin='' then xmi:=1 else xmi:=max(1,w^[i].kont2disk('x',w^[i].exprtofloat(st,_xmin))); if _xmax='' then xma:=w^[i]._xsteps-1 else xma:=max(1,w^[i].kont2disk('x',w^[i].exprtofloat(st,_xmax))); if _tmin='' then tmi:=1 else tmi:=max(1,w^[i].kont2disk('t',w^[i].exprtofloat(st,_tmin))); if _tmax='' then tma:=w^[i]._tsiz-1 else tma:=max(1,w^[i].kont2disk('x',w^[i].exprtofloat(st,_tmax))); if st then begin result:=true; exit; end; setlength(Konturthreads,mt); for j:=0 to length(Konturthreads)-1 do Konturthreads[j]:= tKonturAusWertenThread.create( w^[i], Schwelle, round(j/length(Konturthreads)*(xma+1-xmi)+xmi), round((j+1)/length(Konturthreads)*(xma+1-xmi)+xmi-1), tmi, tma); repeat fertig:=true; for j:=0 to length(Konturthreads)-1 do fertig:=fertig and Konturthreads[j].fertig; if not fertig then sleep(10); until fertig; k:=0; for j:=0 to length(Konturthreads)-1 do k:=k+length(Konturthreads[j].punkte); setlength(orte,k); k:=0; for j:=0 to length(Konturthreads)-1 do begin for l:=0 to length(Konturthreads[j].punkte)-1 do orte[k+l]:=Konturthreads[j].punkte[l]; k:=k+length(Konturthreads[j].punkte); Konturthreads[j].Free; end; result:=true; end; function tKontur.erzeugeAusFunktion(st: boolean; s: string; xmi,xma,tmi,tma,dx,dt: extended; mt: longint): boolean; var xf,yf: string; kvs: tKnownValues; pOrte: array of array[0..2] of extended; baustellen: array of tIntPoint; lenPO,lenB,i: longint; procedure berechnePOrt(i: longint); inline; begin kvs.add(s,pOrte[i,0]); pOrte[i,1]:=exprToFloat(st,xf,kvs); pOrte[i,2]:=exprToFloat(st,yf,kvs); end; function pOIndexInnerhalb(i: longint): boolean; inline; begin result:=(i>=0) and (i=xmi) and (pOrte[i,1]<=xma) and (pOrte[i,2]>=tmi) and (pOrte[i,2]<=tma); end; function punkteFastGleich(i1,i2: longint): boolean; inline; begin result:= pOIndexInnerhalb(i1) and pOIndexInnerhalb(i2) and (abs(round(pOrte[i1,1]/dx)-round(pOrte[i2,1]/dx))<=1) and (abs(round(pOrte[i1,2]/dt)-round(pOrte[i2,2]/dt))<=1); end; function baustelleUeberfluessig(i: longint): boolean; inline; begin result:= punkteFastGleich(baustellen[i,'x'],baustellen[i,'y']); end; begin result:=false; xf:=erstesArgument(s,';'); yf:=erstesArgument(s,';'); kvs:=tKnownValues.create; lenPO:=1; setlength(pOrte,speicherHappen); pOrte[0,0]:=0; berechnePOrt(0); if st then begin result:=true; kvs.free; setlength(pOrte,0); exit; end; if not liegtInnerhalb(0) then begin gibAus('Die Funktionen '''+xf+''' bzw. '''+yf+''' erzeugen für '''+s+'''=0 keinen Punkt innerhalb der Grenzen ('+floattostr(xmi)+'..'+floattostr(xma)+' x '+floattostr(tmi)+'..'+floattostr(tma)+')!',3); kvs.free; setlength(pOrte,0); exit; end; lenB:=2; setlength(baustellen,speicherHappen); baustellen[0,'x']:=low(longint); baustellen[0,'y']:=0; baustellen[1,'x']:=0; baustellen[1,'y']:=high(longint); while lenB>0 do begin if baustelleUeberfluessig(lenB-1) then begin dec(lenB); continue; end; if length(baustellen)<=lenB+1 then setlength(baustellen,lenB+speicherHappen); if length(pOrte)<=lenPO+2 then setlength(pOrte,lenPO+speicherHappen); inc(lenPO); if baustellen[lenB-1,'x']=low(longint) then pOrte[lenPO-1,0]:=pOrte[baustellen[lenB-1,'y'],0]-max(round(max(dx,dt)),1) else if baustellen[lenB-1,'y']=high(longint) then pOrte[lenPO-1,0]:=pOrte[baustellen[lenB-1,'x'],0]+max(round(max(dx,dt)),1) else pOrte[lenPO-1,0]:=(pOrte[baustellen[lenB-1,'x'],0] + pOrte[baustellen[lenB-1,'y'],0])/2; berechnePOrt(lenPO-1); case 4*byte(liegtInnerhalb(lenPO-1)) + 2*byte(liegtInnerhalb(baustellen[lenB-1,'x'])) + byte(liegtInnerhalb(baustellen[lenB-1,'y'])) of 3..7: begin // Punkt oder wenigstens beide Grenzen innerhalb => Baustelle wird vmtl. geteilt baustellen[lenB,'x']:=lenPO-1; baustellen[lenB,'y']:=baustellen[lenB-1,'y']; baustellen[lenB-1,'y']:=lenPO-1; inc(lenB); if baustelleUeberfluessig(lenB-2) then begin baustellen[lenB-2]:=baustellen[lenB-1]; dec(lenB); end; if baustelleUeberfluessig(lenB-1) then dec(lenB); end; 2: // Punkt und rechte Grenze außerhalb => rechte Grenze auf neuen Punkt verschieben if pOIndexInnerhalb(baustellen[lenB-1,'y']) then begin // rechte Grenze ist real pOrte[baustellen[lenB-1,'y']]:=pOrte[lenPO-1]; // dann wird der Ort verschoben dec(lenPO); // und der alte gelöscht end else // sonst baustellen[lenB-1,'y']:=lenPO-1; // wird nur der Ortsindex verschoben 1: // Punkt und linke Grenze außerhalb => linke Grenze auf neuen Punkt verschieben if pOIndexInnerhalb(baustellen[lenB-1,'x']) then begin // linke Grenze ist real pOrte[baustellen[lenB-1,'x']]:=pOrte[lenPO-1]; // dann wird der Ort verschoben dec(lenPO); // und der alte gelöscht end else // sonst baustellen[lenB-1,'x']:=lenPO-1; // wird nur der Ortsindex verschoben 0: begin // alles außer Rand und Band => Baustelle und Punkt entfernen dec(lenB); dec(lenPO); end; end{of case}; end; setlength(orte,lenPO); for i:=0 to lenPO-1 do begin orte[i,'x']:=i; orte[i,'y']:=pOrte[i,0]; end; if not sortiere_nach_y(mt) then begin setlength(baustellen,0); setlength(pOrte,0); kvs.free; exit; end; for i:=0 to lenPO-1 do begin orte[i,'y']:=pOrte[round(orte[i,'x']),2]; orte[i,'x']:=pOrte[round(orte[i,'x']),1]; end; setlength(baustellen,0); setlength(pOrte,0); kvs.free; result:=true; end; function tKontur.sortiere_nach_y(mt: longint): boolean; begin result:=sortiere_nach_y(mt,0,length(Orte)-1); end; function tKontur.sortiere_nach_y(mt,von,bis: longint): boolean; var i,j: longint; avg: extended; tmp: tExtPoint; st1,st2: tSortiereNachYThread; begin result:=false; if von>=bis then begin result:=true; exit; end; avg:=0; for i:=von to bis do avg:=avg+Orte[i]['y']; avg:=avg/(bis-von+1); i:=von; j:=bis; while i=avg) do dec(j); if ij+1 then begin gibAus(' interner Quicksort-Fehler: "quicksort-sanity-check nicht bestanden! (i='+inttostr(i)+' & j='+inttostr(j)+')"',1); exit; end; if (jbis) then begin for i:=von+1 to bis do if Orte[i]['y'] <> Orte[von]['y'] then begin gibAus(' interner Quicksort-Fehler: "komisch, die Orte sind doch unterschiedlich ..."',1); halt; end; result:=true; exit; end; if mt<=1 then result:=sortiere_nach_y(mt,von,i-1) and sortiere_nach_y(mt,i,bis) else begin j:=min(max(1,round(mt/(bis+1-von)*(i-von))),mt-1); st1:=tSortiereNachYThread.create(self,j,von,i-1); st2:=tSortiereNachYThread.create(self,mt-j,i,bis); repeat sleep(10); until st1.fertig and st2.fertig; result:=st1.erfolg and st2.erfolg; st1.free; st2.free; end; end; // tKonturAusWertenThread ****************************************************** constructor tKonturAusWertenThread.create(werte: tWerte; schwelle: extended; xmin, xmax, tmin, tmax: longint); begin inherited create; w:=werte; s:=schwelle; xmi:=xmin; xma:=xmax; tmi:=tmin; tma:=tmax; setlength(punkte,0); suspended:=false; end; destructor tKonturAusWertenThread.destroy; begin setlength(punkte,0); inherited destroy; end; procedure tKonturAusWertenThread.stExecute; begin case w.Genauigkeit of gSingle: punkte:=w.sWerte.findeSchwellwerte(xmi,xma,tmi,tma,s); gDouble: punkte:=w.dWerte.findeSchwellwerte(xmi,xma,tmi,tma,s); gExtended: punkte:=w.eWerte.findeSchwellwerte(xmi,xma,tmi,tma,s); end{of case}; fertig:=true; end; // tIntegralThread ************************************************************* constructor tIntegralThread.create(quelle, ziel: tWerte; xmin, xmax, tmin, tmax, xoff, toff: longint; richtung: tIntegrationsRichtung); begin inherited create; qu:=quelle; zi:=ziel; xmi:=xmin; xma:=xmax; tmi:=tmin; tma:=tmax; xof:=xoff; tof:=toff; rtg:=richtung; gibAus('Integralthread kreiert',1); suspended:=false; end; destructor tIntegralThread.destroy; begin inherited destroy; end; procedure tIntegralThread.stExecute; begin gibAus('Integralthread gestartet ('+inttostr(xmi)+'-'+inttostr(xma)+'x'+inttostr(tmi)+'-'+inttostr(tma)+') '+ '('+inttostr(qu._xsteps)+'x'+inttostr(qu._tsiz)+') -> '+ '('+inttostr(zi._xsteps)+'x'+inttostr(zi._tsiz)+') delta: '+ inttostr(xof)+'x'+inttostr(tof)+' ...',1); case rtg of irHorizontal: gibAus(' (horizontal)',1); irEinfall: gibAus(' (einfallend)',1); irAusfall: gibAus(' (ausfallend)',1); end{of case}; case zi.Genauigkeit of gSingle: case qu.Genauigkeit of gSingle: zi.sWerte.integriereSingle(@(qu.sWerte),xmi,xma,tmi,tma,xof,tof,rtg); gDouble: zi.sWerte.integriereDouble(@(qu.dWerte),xmi,xma,tmi,tma,xof,tof,rtg); gExtended: zi.sWerte.integriereExtended(@(qu.eWerte),xmi,xma,tmi,tma,xof,tof,rtg); end{of case}; gDouble: case qu.Genauigkeit of gSingle: zi.dWerte.integriereSingle(@(qu.sWerte),xmi,xma,tmi,tma,xof,tof,rtg); gDouble: zi.dWerte.integriereDouble(@(qu.dWerte),xmi,xma,tmi,tma,xof,tof,rtg); gExtended: zi.dWerte.integriereExtended(@(qu.eWerte),xmi,xma,tmi,tma,xof,tof,rtg); end{of case}; gExtended: case qu.Genauigkeit of gSingle: zi.eWerte.integriereSingle(@(qu.sWerte),xmi,xma,tmi,tma,xof,tof,rtg); gDouble: zi.eWerte.integriereDouble(@(qu.dWerte),xmi,xma,tmi,tma,xof,tof,rtg); gExtended: zi.eWerte.integriereExtended(@(qu.eWerte),xmi,xma,tmi,tma,xof,tof,rtg); end{of case}; end{of case}; gibAus('... und fertig',1); fertig:=true; end; // tSortiereNachYThread ******************************************************** constructor tSortiereNachYThread.create(K: tKontur; threads,von,bis: longint); begin inherited create; Kont:=K; vo:=von; bi:=bis; mt:=threads; erfolg:=false; gibAus('Sortierthread kreiert ('+inttostr(vo)+'-'+inttostr(bi)+') -> x'+inttostr(mt),1); suspended:=false; end; destructor tSortiereNachYThread.destroy; begin inherited destroy; end; procedure tSortiereNachYThread.stExecute; begin gibAus('Sortierthread gestartet ('+inttostr(vo)+'-'+inttostr(bi)+') -> x'+inttostr(mt)+' ...',1); erfolg:=Kont.sortiere_nach_y(mt,vo,bi); gibAus(' ... und fertig',1); fertig:=true; end; // tBefehlThread *************************************************************** constructor tBefehlThread.create(st: boolean; cmd: string; out erfolg: boolean); var nichtLeeresArgument: boolean; function shellParseNextArg(var s: string): string; var err: longint; sr: tSearchRec; begin if length(s)=0 then exit; if startetMit('"',s) then begin if pos('"',s)=0 then begin gibAus('Kein passendes zweites Anführungszeichen im Argument für den Befehl gefunden!',3); erfolg:=false; exit; end; result:=erstesArgument(s,'"'); end else begin result:=stringReplace(erstesArgument(s),'$$DATETIME',mydatetimetostr(now),[rfReplaceAll]); if pos('*',result)>0 then begin err:=findFirst(result,$3F,sr); while err=0 do begin if (sr.Name<>'.') and (sr.Name<>'..') then s:=trim('"'+extractfilepath(result)+sr.Name+'" '+s); err:=findNext(sr); end; findClose(sr); result:=shellParseNextArg(s); end; end; if startetMit('./',result) then result:=extractfilepath(paramstr(0))+result; if result<>'' then nichtLeeresArgument:=true; end; begin if not st then inherited create; erfolg:=cmd<>''; if st then begin endetMit('&',cmd); shellParseNextArg(cmd); end else begin bg:=endetMit('&',cmd); p:=tProcess.create(nil); p.Options:=p.Options + [poWaitOnExit]; p.Executable:=shellParseNextArg(cmd); end; nichtLeeresArgument:=cmd=''; if not erfolg then begin if not st then begin p.free; p:=nil; end; exit; end; while length(cmd)>0 do begin if st then shellParseNextArg(cmd) else p.Parameters.Add(shellParseNextArg(cmd)); if not erfolg then begin if not st then begin p.free; p:=nil; end; exit; end; end; if st then exit; if not nichtLeeresArgument then begin p.free; p:=nil; end; if assigned(p) then begin cmd:=p.Parameters.Text; while (length(cmd)>0) and (cmd[length(cmd)] in [#10,#13]) do delete(cmd,length(cmd),1); cmd:=''''+cmd+''''; while pos(#10,cmd)>0 do cmd:=leftStr(cmd,pos(#10,cmd)-1)+''' '''+copy(cmd,pos(#10,cmd)+1,length(cmd)); while pos(#13,cmd)>0 do cmd:=leftStr(cmd,pos(#13,cmd)-1)+''' '''+copy(cmd,pos(#13,cmd)+1,length(cmd)); gibAus('Externer Befehl: '''+p.Executable+''' '+cmd+' erzeugt.',3); end else gibAus('Des Befehls zu expandierende Argumente hatten keine Treffer, er wird ignoriert.',3); end; destructor tBefehlThread.destroy; begin gibAus('Befehl zerstört.',3); p.free; inherited destroy; end; procedure tBefehlThread.stExecute; begin if assigned(p) then begin gibAus('externen Befehl ausführen ... '+inttostr(belegterSpeicher),3); gibAus(p.Executable,3); gibAus(p.Parameters.text,3); p.Execute; gibAus('... fertig!',1); end else gibAus('Externer Befehl hätte nichts zu tun und wird daher gar nicht erst gestartet.',1); fertig:=true; end; // tLeseThread ***************************************************************** constructor tLeseThread.create(we: tWerte; inps: tGenerischeInputDateiInfoArray); var i: longint; begin inherited create; w:=we; setlength(inputs,length(inps)); for i:=0 to length(inputs)-1 do begin if inps[i] is tPhaseSpaceInputDateiInfo then begin inputs[i]:=tPhaseSpaceInputDateiInfo.create(inps[i]); continue; end; if inps[i] is tSpaceTimeInputDateiInfo then begin inputs[i]:=tSpaceTimeInputDateiInfo.create(inps[i]); continue; end; if inps[i] is tTraceInputDateiInfo then begin inputs[i]:=tTraceInputDateiInfo.create(inps[i]); continue; end; if inps[i] is tPipeInputDateiInfo then begin inputs[i]:=tPipeInputDateiInfo.create(inps[i]); continue; end; gibAus('unbekannter InputDateiInfo-Typ ...',3); halt(1); end; gibAus('LeseThread erzeugt',1); suspended:=false; end; destructor tLeseThread.destroy; begin w:=nil; inherited destroy; end; procedure tLeseThread.stExecute; begin gibAus('LeseThread gestartet',1); case w.Genauigkeit of gSingle: if not w.sWerte.liesDateien(inputs) then exit; gDouble: if not w.dWerte.liesDateien(inputs) then exit; gExtended: if not w.eWerte.liesDateien(inputs) then exit; end{of case}; gibAus('LeseThread beendet',1); fertig:=true; end; // tVerzerrInitThread ********************************************************** constructor tVerzerrInitThread.create(quelle,ziel: tWerte; xMin,xMax,tMin,tMax,x0Abs,t0Abs,threads: longint; epsilon: extended; verzerrung: tTransformation; verzerrAnz: longint; zielpositionen: tIntPointArray; zielgewichte: tExtPointArray; Warn: tWarnstufe); begin inherited create; qu:=quelle; zi:=ziel; ZPs:=zielpositionen; ZGs:=zielgewichte; setlength(ZAs,zi._xsteps*zi._tsiz); xMi:=xMin; xMa:=xMax; tMi:=tMin; tMa:=tMax; x0:=x0Abs; t0:=t0Abs; eps:=epsilon; verz:=verzerrung; va:=verzerrAnz; mt:=threads; Warnstufe:=Warn; gibAus('VerzerrInitThread kreiert',1); suspended:=false; end; destructor tVerzerrInitThread.destroy; begin setlength(ZAs,0); inherited destroy; end; procedure tVerzerrInitThread.stExecute; begin gibAus('VerzerrInitThread gestartet ('+inttostr(xMi)+'-'+inttostr(xMa)+'/'+inttostr(tMi)+'-'+inttostr(tMa)+')',1); zi.initVerzerrung(qu,xMi,xMa,tMi,tMa,x0,t0,mt,false,eps,verz,va,ZPs,ZGs,ZAs,Warnstufe); gibAus('VerzerrInitThread beendet',1); end; // tVerzerrThread ************************************************************** constructor tVerzerrThread.create(quelle,ziel: tWerte; xMin,xMax,tMin,tMax: longint; zielpositionen: tIntPointArray; zielgewichte: tExtPointArray; zielanzahlen: tExtendedArray; Vorbearbeitungen,Nachbearbeitungen: tTransformation; vorAnz,nachAnz: longint); begin inherited create; qu:=quelle; zi:=ziel; ZPs:=zielpositionen; ZGs:=zielgewichte; ZAs:=zielanzahlen; xMi:=xMin; xMa:=xMax; tMi:=tMin; tMa:=tMax; vb:=Vorbearbeitungen; va:=vorAnz; nb:=Nachbearbeitungen; na:=nachAnz; gibAus('Verzerrthread erzeugt',1); suspended:=false; end; destructor tVerzerrThread.destroy; begin inherited destroy; end; procedure tVerzerrThread.stExecute; begin gibAus('Verzerrthread gestartet '+floattostr(qu._minW)+' '+floattostr(qu._maxW),1); case zi.genauigkeit of gSingle: case qu.genauigkeit of gSingle: zi.sWerte.kopiereVerzerrt(pTLLWerteSingle(@qu.sWerte),ZPs,ZGs,ZAs,xMi,xMa,tMi,tMa,vb,nb,va,na); gDouble: zi.sWerte.kopiereVerzerrt(pTLLWerteDouble(@qu.dWerte),ZPs,ZGs,ZAs,xMi,xMa,tMi,tMa,vb,nb,va,na); gExtended: zi.sWerte.kopiereVerzerrt(pTLLWerteExtended(@qu.eWerte),ZPs,ZGs,ZAs,xMi,xMa,tMi,tMa,vb,nb,va,na); end{of case}; gDouble: case qu.genauigkeit of gSingle: zi.dWerte.kopiereVerzerrt(pTLLWerteSingle(@qu.sWerte),ZPs,ZGs,ZAs,xMi,xMa,tMi,tMa,vb,nb,va,na); gDouble: zi.dWerte.kopiereVerzerrt(pTLLWerteDouble(@qu.dWerte),ZPs,ZGs,ZAs,xMi,xMa,tMi,tMa,vb,nb,va,na); gExtended: zi.dWerte.kopiereVerzerrt(pTLLWerteExtended(@qu.eWerte),ZPs,ZGs,ZAs,xMi,xMa,tMi,tMa,vb,nb,va,na); end{of case}; gExtended: case qu.genauigkeit of gSingle: zi.eWerte.kopiereVerzerrt(pTLLWerteSingle(@qu.sWerte),ZPs,ZGs,ZAs,xMi,xMa,tMi,tMa,vb,nb,va,na); gDouble: zi.eWerte.kopiereVerzerrt(pTLLWerteDouble(@qu.dWerte),ZPs,ZGs,ZAs,xMi,xMa,tMi,tMa,vb,nb,va,na); gExtended: zi.eWerte.kopiereVerzerrt(pTLLWerteExtended(@qu.eWerte),ZPs,ZGs,ZAs,xMi,xMa,tMi,tMa,vb,nb,va,na); end{of case}; end{of case}; gibAus('Verzerrthread beendet',1); end; // sonstiges ******************************************************************* function findePalette(out Palette: pTPalette; name: string): boolean; var i: longint; begin result:=true; for i:=0 to length(paletten)-1 do if paletten[i].name=name then begin Palette:=@(paletten[i]); exit; end; Palette:=nil; result:=false; end; function erzeugeLegende(st: boolean; var f: tMyStringlist; datei: string; Qu: tWerte; minDichte,maxDichte: extended; nb: tTransformation; pal: pTPalette): boolean; var s: string; breite,hoehe,i,j,k,lo,ro,oo,uo, schriftgroesze: longint; img: file; lineareFarbe,waagerecht,rahmen: boolean; farben: tRgbArray; col: tRGB; wert,tmp,schritt: extended; fontRenderer: tFontRenderer; beschriftungsschritte: array of tBeschriftungsschritt; beschriftungen: array of tBeschriftung; tmpTr: tTransformation; begin result:=false; breite:=100; hoehe:=100; waagerecht:=false; lineareFarbe:=false; schriftgroesze:=24; setlength(beschriftungen,0); setlength(beschriftungsschritte,2); beschriftungsschritte[0].schritte:=0; beschriftungsschritte[0].bis:=minDichte; beschriftungsschritte[0].linear:=false; beschriftungsschritte[0].faktor:=1; beschriftungsschritte[1].bis:=maxDichte; beschriftungsschritte[1].schritte:=10; beschriftungsschritte[1].linear:=true; beschriftungsschritte[1].faktor:=1; rahmen:=false; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende in '''+paramstr(1)+'''!',3); exit; end; if startetMit('Ausrichtung:',s) then begin waagerecht:=s='waagerecht'; if (s='waagerecht') or (s='senkrecht') then continue; gibAus(''''+s+''' ist keine gültige Ausrichtung!',3); exit; end; if startetMit('Breite:',s) then begin breite:=strtoint(s); continue; end; if startetMit('Höhe:',s) then begin hoehe:=strtoint(s); continue; end; if startetMit('Schriftgröße:',s) then begin schriftgroesze:=strtoint(s); continue; end; if s='Farbe linear' then begin lineareFarbe:=true; continue; end; if s='Werte linear' then begin lineareFarbe:=false; continue; end; if s='Rahmen' then begin rahmen:=true; continue; end; if s='Beschriftungen:' then begin setlength(beschriftungsschritte,1); beschriftungsschritte[0].schritte:=0; beschriftungsschritte[0].bis:=minDichte; beschriftungsschritte[0].linear:=false; beschriftungsschritte[0].faktor:=1; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende in '''+paramstr(1)+'''!',3); exit; end; if s='Ende' then break; setlength(beschriftungsschritte,length(beschriftungsschritte)+1); if startetMit('linear',s) then beschriftungsschritte[length(beschriftungsschritte)-1].linear:=true else if startetMit('logarithmisch',s) then begin beschriftungsschritte[length(beschriftungsschritte)-1].linear:=false; minDichte:=Qu.exprtofloat(st,erstesArgument(s)); beschriftungsschritte[0].bis:=maxDichte*minDichte; tmpTr:=nb; while assigned(tmpTr) do begin if tmpTr is tWerteLogTransformation then begin if (tmpTr as tWerteLogTransformation).logMin<>minDichte then begin gibAus('Die minimale Dichte der logarithmischen Farbskala ('+myfloattostr(minDichte)+') und der logarithmischen Nachbearbeitung ('+myfloattostr((tmpTr as tWerteLogTransformation).logMin)+') stimmen nicht überein!',3); exit; end; minDichte:=minDichte*maxDichte; break; end; tmpTr:=tmpTr.beliebigerVorgaenger; end; end else if length(beschriftungsschritte)>2 then beschriftungsschritte[length(beschriftungsschritte)-1].linear:= beschriftungsschritte[length(beschriftungsschritte)-2].linear else begin gibAus('Ich weiß nicht, ob die Beschriftung linear oder logarithmisch sein soll!',3); exit; end; beschriftungsschritte[length(beschriftungsschritte)-1].bis:=Qu.exprtofloat(st,erstesArgument(s)); if endetMit('+',s) then beschriftungsschritte[length(beschriftungsschritte)-1].faktor:=0.5 else if endetMit('-',s) then beschriftungsschritte[length(beschriftungsschritte)-1].faktor:=2 else beschriftungsschritte[length(beschriftungsschritte)-1].faktor:=1; beschriftungsschritte[length(beschriftungsschritte)-1].schritte:=strtoint(s); until false; continue; end; if s='Ende' then break; gibAus('Verstehe Option '''+s+''' nicht bei Erzeugund der Legende!',3); exit; until false; if st then begin result:=true; exit; end; fontRenderer:=tFontRenderer.create(schriftgroesze); gibAus(floattostr(minDichte)+' '+floattostr(maxDichte),1); for i:=0 to length(beschriftungsschritte)-1 do gibAus(inttostr(i)+' '+floattostr(beschriftungsschritte[i].bis)+' '+floattostr(beschriftungsschritte[i].faktor)+' '+inttostr(beschriftungsschritte[i].schritte)+' '+inttostr(byte(beschriftungsschritte[i].linear)),1); i:=0; wert:=minDichte; schritt:=-1; while wert0 then gibAus(inttostr(i)+' '+floattostr(wert)+' '+floattostr(schritt)+' '+floattostr(beschriftungsschritte[i].bis),1); if ((ibeschriftungsschritte[i].bis)) or (i=0) then begin repeat inc(i); until (i>=length(beschriftungsschritte)-1) or (beschriftungsschritte[i].bis>=wert); if beschriftungsschritte[i].linear then begin schritt:=(beschriftungsschritte[i].bis-beschriftungsschritte[i-1].bis)/beschriftungsschritte[i].schritte; schritt:=power(10,round(ln(schritt)/ln(10)))*beschriftungsschritte[i].faktor; end else schritt:=power(10,floor(ln(wert)/ln(10)-beschriftungsschritte[i].schritte))*beschriftungsschritte[i].faktor; tmp:=round(beschriftungsschritte[i-1].bis/schritt)*schritt; while tmp0 then gibAus('Extra-Ränder: '+inttostr(lo)+' Pixel links, '+inttostr(oo)+' Pixel oben, '+inttostr(ro)+' Pixel rechts und '+inttostr(uo)+' Pixel unten.',3); setlength(farben,byte(waagerecht)*(breite-hoehe)+hoehe); for i:=0 to length(farben)-1 do begin wert:=i/length(farben); if not lineareFarbe then wert:=nb.transformiereWert(wert); farben[i]:=wertZuFarbe(wert,pal^.farben); end; assign(img,datei); rewrite(img,1); schreibeBmpHeader(img,breite+lo+ro,hoehe+oo+uo); for j:=-oo to hoehe+uo-1 do begin i:=-lo; while i=0) and (j=0) and (i=0) and (j=-1) and (j<=hoehe)) or ((i=breite) and (j>=-1) and (j<=hoehe)) or ((j=-1) and (i>=-1) and (i<=breite)) or ((j=hoehe) and (i>=-1) and (i<=breite)) then begin col.rgbRed:=$00; col.rgbGreen:=$00; col.rgbBlue:=$00; end; end; for k:=0 to length(Beschriftungen)-1 do with Beschriftungen[k] do begin if (links<=i) and (rechts>=i) and (oben<=j) and (unten>=j) then col:=andFarben(col,bild.farben[i-links + (j-oben)*bild.breite]); if ((bBreite<=i) and (is) do inc(result); if result0; for i:=1 to length(s) do istZahl:=istZahl and (s[i] in ['0'..'9']); if istZahl then begin // bei s handelt es sich um den Index selbst result:=strtoint(s); if (result<0) or (result>=length(pws^)) then begin gibAus('Index ('+s+') liegt außerhalb des gültigen Bereichs (0..'+inttostr(length(pws^)-1)+')!',3); result:=-1; end else pws^[result].warteaufBeendigungDesLeseThreads; exit; end; if not darfErstellen then begin gibAus('Ich habe Werte '''+s+''' nicht gefunden und darf sie auch nicht erstellen!',3); result:=-1; exit; end; setlength(pws^,length(pws^)+1); pws^[length(pws^)-1]:=tWerte.create(Kont,pws); pws^[length(pws^)-1].bezeichner:=s; i:=f.count-1; while (i>=0) and not f.needInLine(s,i) do dec(i); // i ist das letzte Vorkommen von s in f if pos('lösche Werte ',f[i])=0 then // wenn es sich um einen Löschbefehl handelt, machen wir nichts f.insert(i+1,'lösche Werte '+s); // ansonsten veranlassen wir die Löschung result:=length(pws^)-1; end; function findeKontur(s: String; f: tMyStringlist; pws: pTWerteArray; pks: pTKonturenArray; darfErstellen: boolean): integer; var i: integer; istZahl: boolean; begin s:=trimAll(s); result:=length(pks^)*byte(s=''); // kleine Abkürzung while (results) do inc(result); if result0; for i:=1 to length(s) do istZahl:=istZahl and (s[i] in ['0'..'9']); if istZahl then begin // bei s handelt es sich um den Index selbst result:=strtoint(s); if (result<0) or (result>=length(pks^)) then begin gibAus('Index ('+s+') liegt außerhalb des gültigen Bereichs (0..'+inttostr(length(pks^)-1)+')!',3); result:=-1; end; exit; end; if not darfErstellen then begin gibAus('Ich habe Konturen '''+s+''' nicht gefunden und darf sie auch nicht erstellen!',3); result:=-1; exit; end; setlength(pks^,length(pks^)+1); pks^[length(pks^)-1]:=tKontur.create(pks,pws); pks^[length(pks^)-1].bezeichner:=s; i:=f.count-1; while (i>=0) and not f.needInLine(s,i) do dec(i); // i ist das letzte Vorkommen von s in f if pos('lösche Kontur ',f[i])=0 then // wenn es sich um einen Löschbefehl handelt, machen wir nichts f.insert(i+1,'lösche Kontur '+s); // ansonsten veranlassen wir die Löschung result:=length(pks^)-1; end; function initBmpHeader(w,h: longint): tBmpHeader; begin With result do begin bfType1 := $42; bfType2 := $4D; bfSize := $36 + ((3*w+3) div 4)*4*h; bfReserved1 := $0000; bfReserved2 := $0000; bfOffBits := $36; biSize := $28; biWidth := w; biHeight := h; biPlanes := $0001; biBitCount := $0018; biCompression := $00000000; biSizeImage := ((3*w+3) div 4)*4*h; biXPelsPerMeter := $00000000; biYPelsPerMeter := $00000000; biClrUsed := $00000000; biClrImportant := $00000000; end; end; procedure schreibeBmpHeader(var f: file; w,h: longint); var bmpHeader: tBmpHeader; begin bmpHeader:=initBmpHeader(w,h); blockwrite(f,bmpHeader,sizeof(bmpHeader)); end; function neuePalette(var f: tMyStringlist): boolean; var s,name: string; Palette: tRGBArray; i: longint; nPalette: pTPalette; begin result:=false; setlength(Palette,0); name:=''; nPalette:=nil; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende in '''+paramstr(1)+'''!',3); exit; end; if s='Ende' then break; if startetMit('Name:',s) then begin name:=s; findePalette(nPalette,s); continue; end; setlength(Palette,length(Palette)+1); if strToTRGB(s,Palette[length(Palette)-1]) then continue; gibAus(''''+s+''' ist keine Farbe für eine Palette!',3); exit; until false; if name='' then begin gibAus('Die Palette braucht einen Namen!',3); exit; end; if length(Palette)<2 then begin gibAus('Zu wenige Farben in der Palette '''+name+''', nämlich nur '+inttostr(length(Palette)),3); exit; end; if nPalette=nil then begin setlength(Paletten,length(Paletten)+1); nPalette:=@(Paletten[length(Paletten)-1]); end; nPalette^.name:=name; setlength(nPalette^.farben,length(Palette)); for i:=0 to length(Palette)-1 do nPalette^.farben[i]:=Palette[i]; gibAus('Neue Palette '''+nPalette^.name+''' erstellt!',3); result:=true; end; function externerBefehl(st: boolean; s: string): boolean; var bt: tBefehlThread; begin bt:=tBefehlThread.create(st,s,result); if st then begin // bt.free; exit; end; if not result then begin try bt.free; except end; exit; end; bt.suspended:=false; gibAus('Befehl gestartet.',3); if bt.bg then begin setlength(externeBefehle,length(externeBefehle)+1); externeBefehle[length(externeBefehle)-1]:=bt; exit; // Job läuft im Hintergrund weiter! end; while not bt.fertig do sleep(10); bt.free; end; procedure warte_auf_externeBefehle; var i: longint; b,c: boolean; begin c:=true; repeat b:=false; for i:=0 to length(externeBefehle)-1 do b:=b or (assigned(externeBefehle[i]) and not externeBefehle[i].fertig); if b then begin if c then gibAus('Warte auf Beendigung externer Befehle ...',3); c:=false; sleep(10); end; until not b; if not c then gibAus('... alle externen Befehle fertig.',3); for i:=0 to length(externeBefehle)-1 do if assigned(externeBefehle[i]) then externeBefehle[i].free; setlength(externeBefehle,0); end; procedure beendeExterneBefehleWennFertig; var i,j: longint; begin for i:=length(externeBefehle)-1 downto 0 do if assigned(externeBefehle) then if externeBefehle[i].fertig then begin externeBefehle[i].free; for j:=i+1 to length(externeBefehle)-1 do externeBefehle[j-1]:=externeBefehle[j]; setlength(externeBefehle,length(externeBefehle)-1); end; end; begin fileMode := fmOpenRead; setlength(externeBefehle,0); setlength(Paletten,6); Paletten[0].name:='Graustufen'; setlength(Paletten[0].farben,2); Paletten[0].farben[0]:=rgb($ff,$ff,$ff); Paletten[0].farben[1]:=rgb($00,$00,$00); Paletten[1].name:='invertierte Graustufen'; setlength(Paletten[1].farben,2); Paletten[1].farben[0]:=rgb($00,$00,$00); Paletten[1].farben[1]:=rgb($ff,$ff,$ff); Paletten[2].name:='Regenbogen'; setlength(Paletten[2].farben,6); Paletten[2].farben[0]:=rgb($00,$00,$ff); Paletten[2].farben[1]:=rgb($00,$ff,$ff); Paletten[2].farben[2]:=rgb($00,$ff,$00); Paletten[2].farben[3]:=rgb($ff,$ff,$00); Paletten[2].farben[4]:=rgb($ff,$00,$00); Paletten[2].farben[5]:=rgb($00,$00,$00); Paletten[3].name:='invertierter Regenbogen'; setlength(Paletten[3].farben,6); Paletten[3].farben[0]:=rgb($00,$00,$00); Paletten[3].farben[1]:=rgb($ff,$00,$00); Paletten[3].farben[2]:=rgb($ff,$ff,$00); Paletten[3].farben[3]:=rgb($00,$ff,$00); Paletten[3].farben[4]:=rgb($00,$ff,$ff); Paletten[3].farben[5]:=rgb($00,$00,$ff); Paletten[4].name:='Jet-Regenbogen'; setlength(Paletten[4].farben,5); Paletten[4].farben[0]:=rgb($ff,$00,$00); Paletten[4].farben[1]:=rgb($ff,$ff,$00); Paletten[4].farben[2]:=rgb($00,$ff,$00); Paletten[4].farben[3]:=rgb($00,$ff,$ff); Paletten[4].farben[4]:=rgb($00,$00,$ff); Paletten[5].name:='erweiterter Regenbogen'; setlength(Paletten[5].farben,8); Paletten[5].farben[0]:=rgb($ff,$ff,$ff); Paletten[5].farben[1]:=rgb($00,$00,$ff); Paletten[5].farben[2]:=rgb($00,$ff,$ff); Paletten[5].farben[3]:=rgb($00,$ff,$00); Paletten[5].farben[4]:=rgb($ff,$ff,$00); Paletten[5].farben[5]:=rgb($ff,$00,$00); Paletten[5].farben[6]:=rgb($ff,$00,$ff); Paletten[5].farben[7]:=rgb($00,$00,$00); end.