unit epostunit; {$mode objfpc}{$H+} interface uses classes, sysutils, mystringlistunit, werteunit, typenunit, process, lowlevelunit, matheunit, fftunit, randomunit; 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 = class private farben: array[boolean] of tRGBArray; public name: string; constructor create; constructor create(original: tPalette); destructor destroy; override; procedure kopiereVon(original: tPalette); function neuerWert(s: string; imPart: boolean): boolean; overload; function neuerWert(farbe: tRGB; imPart: boolean): boolean; overload; function wertZuFarbe(x: extended; imPart: boolean = false): tRGB; inline; end; tPalettenArray = array of tPalette; 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 sortiereNachY(mT: longint): boolean; overload; function sortiereNachY(mT,von,bis: longint): boolean; overload; function exprToFloat(sT: boolean; s: string; kvs: tKnownValues): extended; public orte: tExtPointArray; function init(sT: boolean; 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; procedure erzeugeAlsGerade(sT: boolean; von,bis: tExtPoint; dX,dT: extended); 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(f: tMyStringList; out dateien: tGenerischeInputDateiInfoArray; out dump: boolean): 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 rMinP: tInt64Point; procedure wMinP(miP: tInt64Point); function rMaxP: tInt64Point; procedure wMaxP(maP: tInt64Point); function rZDP: tInt64Point; procedure wZDP(zDP: tInt64Point); function rIstKomplex: boolean; procedure wIstKomplex(komplex: boolean); function xScale: extended; function tScale: extended; function dichtenParameterErkannt(sT: boolean; s: string; var bekannteBefehle: tMyStringList; threads,xMin,xMax,tMin,tMax: longint): boolean; function ausdehnungsParameterErkannt(sT: boolean; s: string; wessenSkala: tWerte; var bekannteBefehle: tMyStringList; var xMin,xMax,tMin,tMax: longint): boolean; function kont2disk(senkrecht: boolean; x: extended): longint; overload; inline; function kont2disk(dir: char; x: extended): longint; overload; function kont2diskFak(senkrecht: boolean; x: extended): extended; overload; inline; function kont2diskFak(dir: char; x: extended): extended; overload; function disk2kont(dir: char; x: extended): extended; overload; inline; function disk2kont(x: tExtPoint): tExtPoint; overload; inline; function disk2kontFak(senkrecht: boolean; x: longint): extended; overload; inline; function disk2kontFak(dir: char; x: longint): extended; overload; procedure schreibeWertIntegriert(var f: textFile; i: longint; hor: boolean; var letzterWert: extended; entspringen: extended); function ermittleHintergrund(sT: boolean; threads: longint; hintergrundAbzugsArt: tHintergrundAbzugsArt; out hintergrund: tExtendedArray): boolean; procedure wertAusUmgebungMitteln(x,y: longint); procedure holeRAM(ausgaben: byte); inline; public eWerte: tLLWerteExtended; dWerte: tLLWerteDouble; sWerte: tLLWerteSingle; genauigkeit: tGenauigkeit; constructor create(kont: pTKonturenArray; wert: pTWerteArray); overload; constructor create(original: tWerte; gen: tGenauigkeit); 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; f: tMyStringList; pl,sA: boolean): boolean; function ladeAscii(sT: boolean; datei: string): boolean; function berechneLiKo(sT: boolean; f: tMyStringList; threads: longint): boolean; function berechneAgglomeration(sT: boolean; var f: tMyStringList): boolean; function berechneQuotient(sT: boolean; f: tMyStringList; threads, dividend, divisor: longint): boolean; function berechneProdukt(sT: boolean; f: tMyStringList; threads, faktor1, faktor2: longint): boolean; function berechneKorrelation(sT: boolean; f: tMyStringList; threads: longint; quelle: tWerte): boolean; procedure ermittleMinMaxDichten(sT: boolean; threads: longint; symmetrisch: boolean; warn: tWarnStufe = wsLasch); overload; inline; function ermittleMinMaxDichten(sT: boolean; f: tMyStringList; threads: longint; symmetrisch: boolean; warn: tWarnStufe = wsLasch): boolean; overload; inline; procedure ermittleMinMaxDichten(sT: boolean; threads,xMin,xMax,tMin,tMax: longint; symmetrisch: boolean; warn: tWarnStufe = wsLasch); overload; procedure gleicheMinMaxDichtenAn(sT: boolean; f: tMyStringList; symmetrisch: boolean); function fft(threads: longint; senkrecht,invers: boolean; const vor,nach: tFFTDatenordnung; fen: tFenster; hg: tExtendedArray; out pvFehler: extended; warn: tWarnStufe): boolean; overload; procedure initFuerGauszFit(sT: boolean; daten: tWerte; senkrecht: boolean; adLaenge: longint; adStart,adStop: extended); function fitteGausze(sT: boolean; f: tMyStringList; threads: longint): boolean; function fitte2dGausze(sT: boolean; f: tMyStringList): boolean; function faktorisiere(sT: boolean; f: tMyStringList): boolean; function berechneZeitfrequenzanalyse(sT: boolean; f: tMyStringList; threads: longint; quelle: tWerte; warn: tWarnStufe): boolean; function berechneVerzerrung(sT: boolean; f: tMyStringList; threads: longint; quelle: tWerte; warn: tWarnStufe): boolean; function berechneLambdaZuOmegaVerzerrung(sT: boolean; f: tMyStringList; threads: longint; quelle: tWerte): boolean; function entferneArtefakte(sT: boolean; f: tMyStringList; threads: longint): boolean; function entferneNullteOrdnung(sT: boolean; f: tMyStringList; threads: longint): boolean; function extrahiereEinhuellende(sT: boolean; f: tMyStringList; threads: longint; warn: tWarnStufe): boolean; function extrahierePhase(sT: boolean; f: tMyStringList; threads: longint; warn: tWarnStufe): boolean; function extrahiereKanten(sT: boolean; f: tMyStringList; threads: longint): boolean; function skaliere(sT: boolean; f: tMyStringList; threads: longint): boolean; function nullenEinfuegen(sT: boolean; f: tMyStringList): boolean; function macheKomplex(sT: boolean; f: tMyStringList; threads: longint): boolean; function berechneIntegral(sT: boolean; f: tMyStringList; threads: longint; quelle: tWerte): boolean; function berechneFFT(sT: boolean; f: tMyStringList; threads: longint; warn: tWarnStufe): boolean; function berechneFFT2d(sT: boolean; f: tMyStringList; threads: longint; warn: tWarnStufe): boolean; function berechneAutokorrelation2d(sT: boolean; f: tMyStringList; threads: longint; warn: tWarnStufe): boolean; function berechneRadonTransformation(sT: boolean; f: tMyStringList; threads: longint; quelle: tWerte; warn: tWarnStufe): boolean; function erzeugeLinearesBild(sT: boolean; var f: tMyStringList; threads: longint): boolean; function erzeugeAscii(sT: boolean; f: tMyStringList): boolean; function erzeugeLineout(sT: boolean; f: tMyStringList): boolean; function erzeugeBinning(sT: boolean; params: string): boolean; procedure spiegle(threads: longint); overload; procedure spiegle(threads,tMin,tMax: longint); overload; procedure fuelleMitDummys(sT: boolean); procedure verschiebe(threads: longint; richtung: tInt64Point); procedure ermittlePhasenWinkel(threads: longint); procedure entspringe(threads: longint; entspringen: tEntspringModus); procedure fft2dNachbearbeitung(threads: longint; nB: tFFTDatenordnung; znt: boolean); procedure fft2dQuadrieren(threads: longint; hcc,vcc: boolean); procedure schreibeWert(var f: textFile; p: tExtPoint; var letzterWert: extended; entspringen,verschiebung: extended; skalierung: string; linienIntegral: tLinienIntegral; tmpValues: tKnownValues; auszerhalbInOrdnung: boolean); function exprToFloat(sT: boolean; s: string): extended; function findeZweitdominantestenPunkt(sT: boolean; f: tMyStringList): boolean; function findeMaximum(sT: boolean; f: tMyStringList; threads: longint; warn: tWarnStufe): boolean; function paramsDump: string; function knownValues: tKnownValues; procedure beendeLeseThreadWennFertig; function diskRand: tGeradenArray; function kontRand: tGeradenArray; 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; property _xStop: extended read rXStop; property _tStart: extended read rTStart; property _tStop: extended read rTStop; 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; property _minP: tInt64Point read rMinP write wMinP; property _maxP: tInt64Point read rMaxP write wMaxP; property _zDP: tInt64Point read rZDP write wZDP; property istKomplex: boolean read rIstKomplex write wIstKomplex; 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; leerIstInOrdnung: boolean; 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 erfolg: boolean; 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); 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); procedure stExecute; override; end; tProduktThread = class(tLogThread) xMi,xMa,tMi,tMa,tOf,xOf: longint; f1,f2,pro: tWerte; daO: tFFTDatenordnung; konj: boolean; constructor create(faktor1, faktor2, produkt: tWerte; xMin,xMax,tMin,tMax,xOff,tOff: longint; datenOrdnung: tFFTDatenordnung; konjugiert: boolean); 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; istKomplex: array of boolean; wertes: array of tExtendedArray; anzahlens: array of tLongintArray; pals: array of tPalette; mo,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; modulo: boolean; nachbearbeitungen: tTransformationArray; paletten: tPalettenArray; beschri: pTBeschriftungen; rm: boolean); destructor destroy; override; procedure stExecute; override; procedure initAnzahlensFuerKontur; end; tDichteThread = class(tLogThread) maxDichte,minDichte: extended; maxPos,minPos: tInt64Point; mehrereMaxima,mehrereMinima: boolean; xMin,xMax,tMin,tMax: longint; w: tWerte; constructor create(xMi,xMa,tMi,tMa: longint; const werte: tWerte); procedure stExecute; override; end; tSpiegelThread = class(tLogThread) tMin,tMax: longint; pW: tWerte; constructor create(tMi,tMa: longint; pWerte: tWerte); procedure stExecute; override; end; tFFT2dNBThread = class(tLogThread) xMin,xMax: longint; pW: tWerte; nB: tFFTDatenordnung; constructor create(xMi,xMa: longint; pWerte: tWerte; endordnung: tFFTDatenordnung); procedure stExecute; override; end; tFFT2dQThread = class(tLogThread) xMin,xMax: longint; pW: tWerte; hcc,vcc: boolean; constructor create(xMi,xMa: longint; pWerte: tWerte; hComplConj,vComplConj: boolean); procedure stExecute; override; end; tTauschThread = class(tLogThread) min,max: longint; vertikal: boolean; pW: tWerte; constructor create(mi,ma: longint; ve: boolean; pWerte: tWerte); procedure stExecute; override; end; tFFTThread = class(tLogThread) sMi,sMa: longint; fen: tFenster; sen,inv: boolean; algo: tFFTAlgorithmus; pW: tWerte; pvFehler: extended; hg: tExtendedArray; constructor create(werte: tWerte; sMin,sMax: longint; senkrecht,invers: boolean; const vor,nach: tFFTDatenordnung; fenster: tFenster; hintergrund: tExtendedArray); overload; constructor create(werte: tWerte; sMin,sMax: longint; senkrecht,invers: boolean; algorithmus: tFFTAlgorithmus; fenster: tFenster; hintergrund: tExtendedArray); overload; procedure stExecute; override; end; tGauszFitThread = class(tLogThread) qu: tWerte; ampl,br,posi,ueberl,hint: pTLLWerteExtended; vo,bi: longint; senkr: boolean; fenBr,maxBr,maxVersch: extended; posiMitten: tExtendedArray; constructor create(daten,amplituden,breiten,positionen,ueberlappe,hintergruende: tWerte; von,bis: longint; senkrecht: boolean; fensterBreite,maxBreite,maxVerschiebung: extended; positionsMitten: tExtendedArray); 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); 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); procedure stExecute; override; end; tSortiereNachYThread = class(tLogThread) kont: tKontur; vo,bi,mT: longint; constructor create(k: tKontur; threads,von,bis: longint); procedure stExecute; override; end; tBefehlThread = class(tLogThread) bg: boolean; p: tProcess; constructor create(sT: boolean; cmd: string; out erzeugungsErfolg: 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); procedure stExecute; override; end; tVerzerrLOThread = class(tLogThread) qu,zi: tWerte; ho,ve: boolean; verhHo,verhVe: extended; // lambda_min / (lambda_max - lambda_min) xMi,xMa,tMi,tMa: longint; // bzgl. Ziel constructor create(quelle,ziel: tWerte; xMin,xMax,tMin,tMax: longint; verhaeltnisHorizontal, verhaeltnisVertikal: extended); procedure stExecute; override; end; tFensterThread = class(tLogThread) we: tWerte; xFen,tFen: tFenster; hg: tExtendedArray; xMi,xMa,tMi,tMa: longint; constructor create(werte: tWerte; xMin,xMax,tMin,tMax: longint; fensterX,fensterT: tFenster; hintergrund: tExtendedArray); procedure stExecute; override; end; tVerschiebeThread = class(tLogThread) we: tWerte; xMi,xMa,tMi,tMa: longint; rtg: tInt64Point; constructor create(werte: tWerte; xMin,xMax,tMin,tMax: longint; richtung: tInt64Point); procedure stExecute; override; end; tPhasenWinkelThread = class(tLogThread) we: tWerte; xMi,xMa: longint; constructor create(werte: tWerte; xMin,xMax: longint); procedure stExecute; override; end; tEntspringThread = class(tLogThread) we: tWerte; mi,ma: longint; em: tEntspringModus; constructor create(werte: tWerte; min,max: longint; entspringModus: tEntspringModus); procedure stExecute; override; end; tKomplexMachThread = class(tLogThread) we: tWerte; xMi,xMa: longint; kmm: tKomplexMachModus; mT: tMersenneTwister; constructor create(werte: tWerte; xMin,xMax: longint; komplexMachModus: tKomplexMachModus; randomSeed: longword); procedure stExecute; override; end; tHintergrungIntegrationsThread = class(tLogThread) we: tWerte; xMi,xMa,tMi,tMa,tRa: longint; hg: pTExtendedArray; constructor create(werte: tWerte; xMin,xMax,tMin,tMax,tRand: longint; hintergrund: pTExtendedArray); procedure stExecute; override; end; tKantenExtraktionsThread = class(tLogThread) we: tWerte; xMi,xMa,tMi,tMa: longint; vert: boolean; expo: int64; constructor create(werte: tWerte; xMin,xMax,tMin,tMax: longint; vertikal: boolean; exponent: int64); procedure stExecute; override; end; tSkalierungsThread = class(tLogThread) we: tWerte; tMi,tMa: longint; skal: string; kvs: tKnownValues; constructor create(werte: tWerte; tMin,tMax: longint; skalierung: string); destructor destroy; override; procedure stExecute; override; end; tRadonTransformationsLineOutThread = class(tLogThread) qu,zi: tWerte; xMi,xMa: longint; constructor create(quelle,ziel: tWerte; xMin,xMax: longint); procedure stExecute; override; end; function neuePalette(f: tMyStringList): boolean; function initBmpHeader(w,h: longint): tBmpHeader; procedure schreibeBmpHeader(var f: file; w,h: longint); function findePalette(out palette: tPalette; name: string): boolean; function dumpPalettenNamen: string; procedure exportiereAchsen(achsenDatei: string; achsen: t2x2Extended; breite, hoehe: int64); function erzeugeLegende(sT: boolean; f: tMyStringList; datei: string; qu: tWerte; minDichte,maxDichte: extended; nB: tTransformation; pal: tPalette): 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 warteAufExterneBefehle; procedure beendeExterneBefehleWennFertig; function ermittleAnstieg(sT: boolean; s: string): boolean; function ermittleMittelwert(sT: boolean; s: string): boolean; function liesWert(sT: boolean; s: string): boolean; var allePaletten: tPalettenArray; globaleWerte: tKnownValues; behalteLogs: boolean; externeBefehle: array of tBefehlThread; implementation uses math, systemunit; // tPalette ******************************************************************** constructor tPalette.create; var b: boolean; begin inherited create; for b:=false to true do begin fillChar(farben,sizeOf(farben),0); setLength(farben[b],0); end; fillChar(name,sizeOf(name),0); end; constructor tPalette.create(original: tPalette); begin create; kopiereVon(original); end; destructor tPalette.destroy; var b: boolean; begin for b:=false to true do setLength(farben[b],0); inherited destroy; end; procedure tPalette.kopiereVon(original: tPalette); var b: boolean; i: longint; begin name:=original.name; for b:=false to true do begin setLength(farben[b],length(original.farben[b])); for i:=0 to length(farben[b])-1 do move(original.farben[b][i],farben[b][i],sizeOf(farben[b][i])); end; end; function tPalette.neuerWert(s: string; imPart: boolean): boolean; var farbe: tRGB; begin result:=strToTRGB(s,farbe); if result then neuerWert(farbe,imPart); end; function tPalette.neuerWert(farbe: tRGB; imPart: boolean): boolean; begin setLength(farben[imPart],length(farben[imPart])+1); farben[imPart][length(farben[imPart])-1]:=farbe; result:=true; end; function tPalette.wertZuFarbe(x: extended; imPart: boolean = false): tRGB; begin if length(farben[imPart])<2 then fehler('Die Palette '''+name+''' besitzt keine Farben für Imaginärteile!'); result:=lowlevelunit.wertZuFarbe(x,farben[imPart]); end; // 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') or (s='yMin') then result:=konturen^[i].tMin else if (s='tMax') or (s='yMax') 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!'#10 + 'Ich kenne:'#10 + '''xMin'''#10 + '''xMax'''#10 + '''yMin'''#10 + '''yMax'''#10 + '''tMin'''#10 + '''tMax'''#10 + '''Breite'''#10 + '''Hoehe''' ); 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') or (s='yMin') or (s='yStart') then result:=wertes^[i].transformationen.tStart else if (s='tMax') or (s='tStop') or (s='yMax') or (s='yStop') then result:=wertes^[i].transformationen.tStop else if (s='dX') or (s='ΔX') or (s='δX') or (s='Δx') or (s='δx') then result:=(wertes^[i].transformationen.xStop-wertes^[i].transformationen.xStart)/wertes^[i]._xSteps else if (s='dY') or (s='ΔY') or (s='δY') or (s='Δy') or (s='δy') or (s='dT') or (s='ΔT') or (s='δT') or (s='Δt') or (s='δt') then result:=(wertes^[i].transformationen.tStop-wertes^[i].transformationen.tStart)/wertes^[i]._tSiz 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='pMinX') or (s='minPX') then result:=wertes^[i].disk2kont('x',wertes^[i]._minP['x']) else if (s='pMaxX') or (s='maxPX') then result:=wertes^[i].disk2kont('x',wertes^[i]._maxP['x']) else if (s='pMinT') or (s='minPT') or (s='pMinY') or (s='minPY') then result:=wertes^[i].disk2kont('y',wertes^[i]._minP['y']) else if (s='pMaxT') or (s='maxPT') or (s='pMaxY') or (s='maxPY') then result:=wertes^[i].disk2kont('y',wertes^[i]._maxP['y']) else if (s='pZDX') or (s='zDPX') then result:=wertes^[i].disk2kont('x',wertes^[i]._zDP['x']) else if (s='pZDT') or (s='zDPT') or (s='pZDY') or (s='zDPY') then result:=wertes^[i].disk2kont('y',wertes^[i]._zDP['y']) 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!'#10 + 'Ich kenne:'#10 + '''[xty]Min'''#10 + '''[xty]Start'''#10 + '''[xty]Max'''#10 + '''[xty]Stop'''#10 + '''[dΔδ]X'''#10 + '''[Δδ]x'''#10 + '''[dΔδ][YT]'''#10 + '''[Δδ][yt]'''#10 + '''wMin'''#10 + '''minW'''#10 + '''wMax'''#10 + '''maxW'''#10 + '''pMin[XYT]'''#10 + '''minP[XYT]'''#10 + '''pMax[XYT]'''#10 + '''maxP[XYT]'''#10 + '''pZD[XYT]'''#10 + '''zDP[XYT]'''#10 + '''np'''#10 + '''beta'''#10 + '''β'''#10 + '''Breite'''#10 + '''Hoehe''' ); 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(globaleWerte); 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; leseThread:=nil; genauigkeit:=original.genauigkeit; case genauigkeit of gSingle: begin ps:=tExtraInfos.create(original.sWerte.params); sWerte:=tLLWerteSingle.create(pTLLWerteSingle(@original.sWerte),ps,xMin,xMax); dWerte:=tLLWerteDouble.create(ps); eWerte:=tLLWerteExtended.create(ps); end; gDouble: begin ps:=tExtraInfos.create(original.dWerte.params); sWerte:=tLLWerteSingle.create(ps); dWerte:=tLLWerteDouble.create(pTLLWerteDouble(@original.dWerte),ps,xMin,xMax); eWerte:=tLLWerteExtended.create(ps); end; gExtended: begin ps:=tExtraInfos.create(original.eWerte.params); 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:=tIdentitaet.create(original.transformationen); end; constructor tWerte.create(original: tWerte; gen: tGenauigkeit); var ps: tExtraInfos; begin inherited create(original.konturen,original.wertes); original.warteAufBeendigungDesLeseThreads; leseThread:=nil; genauigkeit:=gen; case original.genauigkeit of gSingle: ps:=tExtraInfos.create(original.sWerte.params); gDouble: ps:=tExtraInfos.create(original.dWerte.params); gExtended: ps:=tExtraInfos.create(original.eWerte.params); end{of case}; case genauigkeit of gSingle: begin dWerte:=tLLWerteDouble.create(ps); eWerte:=tLLWerteExtended.create(ps); case original.genauigkeit of gSingle: sWerte:=tLLWerteSingle.create(pTLLWerteSingle(@original.sWerte),ps,0,ps.xSteps-1); gDouble: sWerte:=tLLWerteSingle.create(pTLLWerteDouble(@original.dWerte),ps,0,ps.xSteps-1); gExtended: sWerte:=tLLWerteSingle.create(pTLLWerteExtended(@original.eWerte),ps,0,ps.xSteps-1); end{of case}; end; gDouble: begin sWerte:=tLLWerteSingle.create(ps); eWerte:=tLLWerteExtended.create(ps); case original.genauigkeit of gSingle: dWerte:=tLLWerteDouble.create(pTLLWerteSingle(@original.sWerte),ps,0,ps.xSteps-1); gDouble: dWerte:=tLLWerteDouble.create(pTLLWerteDouble(@original.dWerte),ps,0,ps.xSteps-1); gExtended: dWerte:=tLLWerteDouble.create(pTLLWerteExtended(@original.eWerte),ps,0,ps.xSteps-1); end{of case}; end; gExtended: begin sWerte:=tLLWerteSingle.create(ps); dWerte:=tLLWerteDouble.create(ps); case original.genauigkeit of gSingle: eWerte:=tLLWerteExtended.create(pTLLWerteSingle(@original.sWerte),ps,0,ps.xSteps-1); gDouble: eWerte:=tLLWerteExtended.create(pTLLWerteDouble(@original.dWerte),ps,0,ps.xSteps-1); gExtended: eWerte:=tLLWerteExtended.create(pTLLWerteExtended(@original.eWerte),ps,0,ps.xSteps-1); end{of case}; end; end{of case}; if original.bezeichner='' then bezeichner:='' else bezeichner:=original.bezeichner+''''; transformationen:=tIdentitaet.create(original.transformationen); end; destructor tWerte.destroy; begin warteAufBeendigungDesLeseThreads; if assigned(eWerte) and (not assigned(sWerte) or (eWerte.params<>sWerte.params)) then begin eWerte.params.free; gibAus('Die Werteparameter sind verschieden instaziiert!!!',3); end; if assigned(dWerte) and (not assigned(sWerte) or (dWerte.params<>sWerte.params)) then begin dWerte.params.free; gibAus('Die Werteparameter sind verschieden instaziiert!!!',3); end; if assigned(sWerte) then 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.rMinP: tInt64Point; begin case genauigkeit of gSingle: result:=sWerte.params.minP; gDouble: result:=dWerte.params.minP; gExtended: result:=eWerte.params.minP; end{of case}; end; procedure tWerte.wMinP(miP: tInt64Point); begin transformationen.pMin:=miP; case genauigkeit of gSingle: begin sWerte.params.minP:=miP; sWerte.params.refreshKnownValues; end; gDouble: begin dWerte.params.minP:=miP; dWerte.params.refreshKnownValues; end; gExtended: begin eWerte.params.minP:=miP; eWerte.params.refreshKnownValues; end; end{of case}; end; function tWerte.rMaxP: tInt64Point; begin case genauigkeit of gSingle: result:=sWerte.params.maxP; gDouble: result:=dWerte.params.maxP; gExtended: result:=eWerte.params.maxP; end{of case}; end; procedure tWerte.wMaxP(maP: tInt64Point); begin transformationen.pMax:=maP; case genauigkeit of gSingle: begin sWerte.params.maxP:=maP; sWerte.params.refreshKnownValues; end; gDouble: begin dWerte.params.maxP:=maP; dWerte.params.refreshKnownValues; end; gExtended: begin eWerte.params.maxP:=maP; eWerte.params.refreshKnownValues; end; end{of case}; end; function tWerte.rZDP: tInt64Point; begin case genauigkeit of gSingle: result:=sWerte.params.zDP; gDouble: result:=dWerte.params.zDP; gExtended: result:=eWerte.params.zDP; end{of case}; end; procedure tWerte.wZDP(zDP: tInt64Point); begin transformationen.zDP:=zDP; case genauigkeit of gSingle: begin sWerte.params.zDP:=zDP; sWerte.params.refreshKnownValues; end; gDouble: begin dWerte.params.zDP:=zDP; dWerte.params.refreshKnownValues; end; gExtended: begin eWerte.params.zDP:=zDP; eWerte.params.refreshKnownValues; end; end{of case}; end; function tWerte.rIstKomplex: boolean; begin case genauigkeit of gSingle: result:=sWerte.params.istKomplex; gDouble: result:=dWerte.params.istKomplex; gExtended: result:=eWerte.params.istKomplex; end{of case}; end; procedure tWerte.wIstKomplex(komplex: boolean); begin if komplex=istKomplex then exit; if komplex then _tSiz:=2*_tSiz else _tSiz:=_tSiz div 2; case genauigkeit of gSingle: sWerte.params.istKomplex:=komplex; gDouble: dWerte.params.istKomplex:=komplex; gExtended: eWerte.params.istKomplex:=komplex; 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); gibAus('Keine Datei passt zum Muster '''+sA[i]+'''!',3); sA.free; 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(f: tMyStringList; out dateien: tGenerischeInputDateiInfoArray; out dump: boolean): boolean; // Parameter ermitteln, die in der Config-Datei stehen var s,t: string; ne,be,maxAmp: extended; vorlagen: tInputDateiInfoVorlagen; g: textFile; erfolg: word; i: longint; mitGewalt: boolean; bekannteBefehle: tMyStringList; 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); bekannteBefehle.free; 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; bekannteBefehle:=tMyStringList.create; mitGewalt:=false; dump:=false; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); aufraeumen; exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if istDasBefehl('mit Gewalt',s,bekannteBefehle,false) then begin mitGewalt:=true; continue; end; if istDasBefehl('Genauigkeit:',s,bekannteBefehle,true) then begin if not vorlagen.genauigkeitFromStr(s) then begin aufraeumen; exit; end; if (genauigkeit < vorlagen.genauigkeit) then genauigkeit:=vorlagen.genauigkeit; continue; end; if istDasBefehl('Gamma:',s,bekannteBefehle,true) then begin vorlagen.gamma:=exprToFloat(false,s); continue; end; if istDasBefehl('tMin:',s,bekannteBefehle,true) or istDasBefehl('yMin:',s,bekannteBefehle,true) then begin vorlagen.tStart:=exprToFloat(false,s); continue; end; if istDasBefehl('tMax:',s,bekannteBefehle,true) or istDasBefehl('yMax:',s,bekannteBefehle,true) then begin vorlagen.tStop:=exprToFloat(false,s); continue; end; if istDasBefehl('xMin:',s,bekannteBefehle,true) then begin vorlagen.xStart:=exprToFloat(false,s); continue; end; if istDasBefehl('xMax:',s,bekannteBefehle,true) then begin vorlagen.xStop:=exprToFloat(false,s); continue; end; if istDasBefehl('Parameter ausgeben',s,bekannteBefehle,false) then begin dump:=true; continue; end; if istDasBefehl('Inputparameterdatei:',s,bekannteBefehle,true) 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 istDasBefehl('Fehlerbehebungskommando:',s,bekannteBefehle,true) then begin vorlagen.fehlerBehebungsKommando:=s; continue; end; if istDasBefehl('Spurnummer:',s,bekannteBefehle,true) then begin vorlagen.spurNummer:=strToInt(s); continue; end; if istDasBefehl('Feldnummer:',s,bekannteBefehle,true) then begin vorlagen.feldNummer:=strToInt(s); continue; end; if istDasBefehl('Feld:',s,bekannteBefehle,true) 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 istDasBefehl('Analysator:',s,bekannteBefehle,true) then begin vorlagen.analysator:=s; continue; end; if istDasBefehl('PhaseSpace-Datei:',s,bekannteBefehle,true) then begin while s<>'' do begin t:=erstesArgument(s); if fileExists(t) then begin setLength(dateien,length(dateien)+1); dateien[length(dateien)-1]:=tPhaseSpaceInputDateiInfo.create(vorlagen.phaseSpaceVorlage); dateien[length(dateien)-1].name:=t; continue; end; if not findeAlleDateien(t,dateien,vorlagen.phaseSpaceVorlage) then begin aufraeumen; exit; end; end; continue; end; if istDasBefehl('SpaceTime-Datei:',s,bekannteBefehle,true) then begin while s<>'' do begin t:=erstesArgument(s); if fileExists(t) then begin setLength(dateien,length(dateien)+1); dateien[length(dateien)-1]:=tSpaceTimeInputDateiInfo.create(vorlagen.spaceTimeVorlage); dateien[length(dateien)-1].name:=t; continue; end; if not findeAlleDateien(t,dateien,vorlagen.spaceTimeVorlage) then begin aufraeumen; exit; end; end; continue; end; if istDasBefehl('Trace-Datei:',s,bekannteBefehle,true) then begin while s<>'' do begin t:=erstesArgument(s); if fileExists(t) then begin setLength(dateien,length(dateien)+1); dateien[length(dateien)-1]:=tTraceInputDateiInfo.create(vorlagen.traceVorlage); dateien[length(dateien)-1].name:=t; continue; end; if not findeAlleDateien(t,dateien,vorlagen.traceVorlage) then begin aufraeumen; exit; end; end; continue; end; if istDasBefehl('Sergey-Trace:',s,bekannteBefehle,true) 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 istDasBefehl('Pipe:',s,bekannteBefehle,true) then begin setLength(dateien,length(dateien)+1); dateien[length(dateien)-1]:=tPipeInputDateiInfo.create(vorlagen.pipeVorlage); dateien[length(dateien)-1].name:=s; continue; end; if istDasBefehl('Andor-Datei:',s,bekannteBefehle,true) then begin vorlagen.istHintergrund:=startetMit('Hintergrund',s); if fileExists(s) then begin setLength(dateien,length(dateien)+1); dateien[length(dateien)-1]:=tAndorInputDateiInfo.create(vorlagen.andorVorlage); dateien[length(dateien)-1].name:=s; continue; end; if not findeAlleDateien(s,dateien,vorlagen.andorVorlage) then begin aufraeumen; exit; end; continue; end; bekannteBefehle.sort; gibAus('Verstehe Parameter '''+s+''' nicht beim Einlesen!'#10'Ich kenne:'#10+bekannteBefehle.text,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,iArr: 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; 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 (erwartet: ''#-bit'')!',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!'#10'Ich kenne:'#10'''32-bit Signed Integer PCM''',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 if not fileExists(dateien[i].name) then begin gibAus('Kann Datei '''+dateien[i].name+''' nicht finden!',3); exit; end; 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; if not fileExists(dateien[i].name) then begin gibAus('Kann Datei '''+dateien[i].name+''' nicht finden!',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; if dateien[i] is tAndorInputDateiInfo then begin if (i<>0) or (length(dateien)<>1) then begin gibAus('Ich kann Andor-Dateien nicht kaskadieren!',3); exit; end; if not fileExists(dateien[i].name) then begin gibAus('Kann Datei '''+dateien[i].name+''' nicht finden!',3); exit; end; assignFile(f,dateien[i].name); reset(f,1); s:=readALine(f); if s<>'Andor Technology Multi-Channel File' then begin gibAus('Syntax-Fehler in '''+dateien[i].name+''': erkenne Andor Datei nicht ('+intToStr(filePos(f))+')!',3); closeFile(f); exit; end; s:=readALine(f); if s<>'65538 1' then begin gibAus('Syntax-Fehler in '''+dateien[i].name+''': diese Andor Datei hält der strengen Prüfung nicht stand ('+intToStr(filePos(f))+')!',3); closeFile(f); exit; end; s:=readALine(f); for j:=0 to 4 do erstesArgument(s,' ',false); try (dateien[i] as tAndorInputDateiInfo).temperatur:=strToFloat(erstesArgument(s,' ',false)); except gibAus('Syntax-Fehler in '''+dateien[i].name+''': Temperatur nicht lesbar ('+intToStr(filePos(f))+')!',3); closeFile(f); exit; end; for j:=6 to 11 do erstesArgument(s,' ',false); try (dateien[i] as tAndorInputDateiInfo).belichtungsZeit:=strToFloat(erstesArgument(s,' ',false)); except gibAus('Syntax-Fehler in '''+dateien[i].name+''': Belichtungszeit nicht lesbar ('+intToStr(filePos(f))+')!',3); closeFile(f); exit; end; try (dateien[i] as tAndorInputDateiInfo).zyklusZeit:=strToFloat(erstesArgument(s,' ',false)); except gibAus('Syntax-Fehler in '''+dateien[i].name+''': Zykluszeit nicht lesbar ('+intToStr(filePos(f))+')!',3); closeFile(f); exit; end; try (dateien[i] as tAndorInputDateiInfo).akkumulierteZyklusZeit:=strToFloat(erstesArgument(s,' ',false)); except gibAus('Syntax-Fehler in '''+dateien[i].name+''': akkumulierte Zykluszeit nicht lesbar ('+intToStr(filePos(f))+')!',3); closeFile(f); exit; end; try (dateien[i] as tAndorInputDateiInfo).akkumulierteZyklen:=strToInt64(erstesArgument(s,' ',false)); except gibAus('Syntax-Fehler in '''+dateien[i].name+''': akkumulierte Zyklen nicht lesbar ('+intToStr(filePos(f))+')!',3); closeFile(f); exit; end; erstesArgument(s,' ',false); // 16 try (dateien[i] as tAndorInputDateiInfo).zyklusStapelZeit:=strToFloat(erstesArgument(s,' ',false)); except gibAus('Syntax-Fehler in '''+dateien[i].name+''': Zyklusstapelzeit nicht lesbar ('+intToStr(filePos(f))+')!',3); closeFile(f); exit; end; try (dateien[i] as tAndorInputDateiInfo).pixelAusleseZeit:=strToFloat(erstesArgument(s,' ',false)); except gibAus('Syntax-Fehler in '''+dateien[i].name+''': Pixelauslesezeit nicht lesbar ('+intToStr(filePos(f))+')!',3); closeFile(f); exit; end; for j:=19 to 20 do erstesArgument(s,' ',false); try (dateien[i] as tAndorInputDateiInfo).verstaerkungADW:=strToFloat(erstesArgument(s,' ',false)); except gibAus('Syntax-Fehler in '''+dateien[i].name+''': ADW-Verstärkung nicht lesbar ('+intToStr(filePos(f))+')!',3); closeFile(f); exit; end; for j:=22 to 75 do erstesArgument(s,' ',false); try (dateien[i] as tAndorInputDateiInfo).detektorTyp:=readAnAndorString(f,strToInt64(s),true); except gibAus('Syntax-Fehler in '''+dateien[i].name+''': Detektor-String nicht lesbar ('+intToStr(filePos(f))+')!',3); closeFile(f); exit; end; s:=trim(readALine(f)); try (dateien[i] as tAndorInputDateiInfo).detektorGroesze['x']:=strToInt64(erstesArgument(s,' ',false)); (dateien[i] as tAndorInputDateiInfo).detektorGroesze['y']:=strToInt64(erstesArgument(s,' ',false)); except gibAus('Syntax-Fehler in '''+dateien[i].name+''': Detektorgröße nicht lesbar ('+intToStr(filePos(f))+')!',3); closeFile(f); exit; end; if (dateien[i].tStart=-myInf) and (dateien[i].tStop=myInf) then begin dateien[i].tStart:=0; dateien[i].tStop:=(dateien[i] as tAndorInputDateiInfo).detektorGroesze['y']-1; end; try (dateien[i] as tAndorInputDateiInfo).dateiName:=readAnAndorString(f,strToInt64(s),true); except gibAus('Syntax-Fehler in '''+dateien[i].name+''': originaler Dateiname nicht lesbar ('+intToStr(filePos(f))+')!',3); closeFile(f); exit; end; if extractFileName((dateien[i] as tAndorInputDateiInfo).dateiName) <> extractFileName(dateien[i].name) then gibAus('Warnung in '''+dateien[i].name+''': interner Name ist '''+extractFileName((dateien[i] as tAndorInputDateiInfo).dateiName)+'''.',3); s:=readALine(f); erstesArgument(s); seek(f,filePos(f)+strToInt64(s)); for j:=0 to 2 do s:=readALine(f); for j:=0 to 3 do erstesArgument(s,' ',false); try (dateien[i] as tAndorInputDateiInfo).shutterZeit['x']:=strToFloat(erstesArgument(s,' ',false)); (dateien[i] as tAndorInputDateiInfo).shutterZeit['y']:=strToFloat(erstesArgument(s,' ',false)); except gibAus('Syntax-Fehler in '''+dateien[i].name+''': Shutterzeit nicht lesbar ('+intToStr(filePos(f))+')!',3); closeFile(f); exit; end; for j:=0 to (dateien[i] as tAndorInputDateiInfo).detectorSkipLines do s:=readALine(f); try dateien[i].xStart:=strToFloat(erstesArgument(s,' ',false)); except gibAus('Syntax-Fehler in '''+dateien[i].name+''': xStart nicht lesbar ('+intToStr(filePos(f))+')!',3); closeFile(f); exit; end; try for j:=0 to 2 do (dateien[i] as tAndorInputDateiInfo).xAchse[j]:=strToFloat(erstesArgument(s,' ',false)); except gibAus('Syntax-Fehler in '''+dateien[i].name+''': x-Achsen Skalierung nicht lesbar ('+intToStr(filePos(f))+')!',3); closeFile(f); exit; end; for j:=1 to (dateien[i] as tAndorInputDateiInfo).detectorSkipLines2 do s:=readALine(f); try (dateien[i] as tAndorInputDateiInfo).xAchsenTitel:=readAnAndorString(f,false); (dateien[i] as tAndorInputDateiInfo).datenTypTitel:=readAnAndorString(f,false); (dateien[i] as tAndorInputDateiInfo).yAchsenTitel:=readAnAndorString(f,false); except gibAus('Syntax-Fehler in '''+dateien[i].name+''': Achsenbeschriftung nicht lesbar ('+intToStr(filePos(f))+')!',3); closeFile(f); exit; end; s:=readALine(f); t:=readALine(f); splitStrToInt(s+' '+t,iArr); if (iArr[0]<>65541) or (iArr[9]<>65538) or (iArr[16]<>0) then begin gibAus('Syntax-Fehler in '''+dateien[i].name+''': inkonsistenter Kopf ('+intToStr(filePos(f))+'): '+intArrayToStr(iArr),3); closeFile(f); exit; end; (dateien[i] as tAndorInputDateiInfo).bildBereich['x','x']:=iArr[1]; (dateien[i] as tAndorInputDateiInfo).bildBereich['x','y']:=iArr[3]; (dateien[i] as tAndorInputDateiInfo).bildBereich['y','x']:=iArr[4]; (dateien[i] as tAndorInputDateiInfo).bildBereich['y','y']:=iArr[2]; (dateien[i] as tAndorInputDateiInfo).bildBereichStapel['x']:=iArr[6]; (dateien[i] as tAndorInputDateiInfo).bildBereichStapel['y']:=iArr[5]; (dateien[i] as tAndorInputDateiInfo).rahmenBereich['x','x']:=iArr[10]; (dateien[i] as tAndorInputDateiInfo).rahmenBereich['x','y']:=iArr[12]; (dateien[i] as tAndorInputDateiInfo).rahmenBereich['x','x']:=iArr[13]; (dateien[i] as tAndorInputDateiInfo).rahmenBereich['x','y']:=iArr[11]; (dateien[i] as tAndorInputDateiInfo).rahmenToepfe['x']:=iArr[15]; (dateien[i] as tAndorInputDateiInfo).rahmenToepfe['y']:=iArr[14]; j:=(dateien[i] as tAndorInputDateiInfo).bildBereichStapel['y'] - (dateien[i] as tAndorInputDateiInfo).bildBereichStapel['x'] + 1; if j<>1 then begin gibAus('So ein Mist - Ich kenn hier nur den Wert "1" in '''+dateien[i].name+''' ('+intToStr(filePos(f))+').',3); closeFile(f); exit; end; dateien[i].xSteps:= ((dateien[i] as tAndorInputDateiInfo).bildBereich['x','y']- (dateien[i] as tAndorInputDateiInfo).bildBereich['x','x']+1) div (dateien[i] as tAndorInputDateiInfo).rahmenToepfe['x']; dateien[i].tSiz:= ((dateien[i] as tAndorInputDateiInfo).bildBereich['y','y']- (dateien[i] as tAndorInputDateiInfo).bildBereich['y','x']+1) div (dateien[i] as tAndorInputDateiInfo).rahmenToepfe['y']; (dateien[i] as tAndorInputDateiInfo).berechneXStop; if (dateien[i].xSteps*dateien[i].tSiz <> iArr[8]) or (iArr[8]*j <> iArr[7]) then begin gibAus('Syntax-Fehler in '''+dateien[i].name+''': inkonsistenter Kopf ('+intToStr(filePos(f))+'): '+intArrayToStr(iArr),3); if dateien[i].xSteps*dateien[i].tSiz <> iArr[8] then gibAus(' ' + intToStr(dateien[i].xSteps) + ' * ' + intToStr(dateien[i].tSiz) + ' <> ' +intToStr(iArr[8]),3); if iArr[8]*j <> iArr[7] then gibAus(intToStr(iArr[8]) + ' * ' + intToStr(j) + ' <> ' + intToStr(iArr[7]),3); closeFile(f); exit; end; while j>=0 do begin s:=readAnAndorString(f,false); // labels dec(j); end; (dateien[i] as tAndorInputDateiInfo).datenStart:=filePos(f); seek(f,(dateien[i] as tAndorInputDateiInfo).datenStart+dateien[i].xSteps*dateien[i].tSiz*sizeOf(single)); try s:=readAnAndorString(f,false); except s:='falsch'; end; if s<>'' then begin gibAus('Syntax-Fehler in '''+dateien[i].name+''': vmtl. zu viele/wenige Daten ('+intToStr(filePos(f))+').',3); closeFile(f); exit; end; s:=readALine(f); (dateien[i] as tAndorInputDateiInfo).hatHintergrund:=s='1'; // es kommen noch Daten if (dateien[i] as tAndorInputDateiInfo).hatHintergrund then begin // wir überspringen den Header und hoffen, dass der mit dem anderen übereinstimmt (was er nicht muss!) for j:=0 to 4 do s:=readALine(f); erstesArgument(s); seek(f,filePos(f)+strToInt64(s)); for j:=0 to 3 + (dateien[i] as tAndorInputDateiInfo).detectorSkipLines + (dateien[i] as tAndorInputDateiInfo).detectorSkipLines2 do readALine(f); for j:=0 to 2 do readAnAndorString(f,false); for j:=0 to 1 do readALine(f); for j:=0 to 1 do readAnAndorString(f,false); (dateien[i] as tAndorInputDateiInfo).hintergrundStart:=filePos(f); seek(f,(dateien[i] as tAndorInputDateiInfo).hintergrundStart+dateien[i].xSteps*dateien[i].tSiz*sizeOf(single)); try s:=readAnAndorString(f,false); except s:='falsch'; end; if s<>'' then begin gibAus('Syntax-Fehler in '''+dateien[i].name+''': vmtl. zu viele/wenige Daten ('+intToStr(filePos(f))+').',3); closeFile(f); exit; end; s:=readALine(f); if s<>'0' then begin gibAus('Syntax-Fehler in '''+dateien[i].name+''': hier gibt es zusätzlich zum Hintergrund und den Daten noch mehr (eine Referenz?) - das versteh ich (noch) nicht ('+intToStr(filePos(f))+').',3); closeFile(f); exit; end; if not eof(f) then begin s:=readALine(f); if s<>'' then begin gibAus('Syntax-Fehler in '''+dateien[i].name+''': Nach dem Hintergrund kommen noch unerwartete Daten: '''+s+''' ('+intToStr(filePos(f))+'/'+intToStr(fileSize(f))+').',3); closeFile(f); exit; end; end; end; closeFile(f); 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) or (dateien[0] is tAndorInputDateiInfo) 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) or (dateien[0] is tAndorInputDateiInfo)) 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*_xSteps]:=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; f: tMyStringList; threads: longint): boolean; var i,xMin,xMax,tMin,tMax: longint; liKo: tLiKo; s: string; fertig: boolean; liKoThreads: array of tLiKoThread; Zeit: extended; bekannteBefehle: tMyStringList; begin result:=false; warteAufBeendigungDesLeseThreads; setLength(liKo,0); genauigkeit:=gExtended; _xSteps:=0; _tSiz:=0; xMin:=0; xMax:=0; tMin:=0; tMax:=0; bekannteBefehle:=tMyStringList.create; Zeit:=now; repeat bekannteBefehle.clear; if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); bekannteBefehle.free; exit; end; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if ((length(liKo)=0) and ausdehnungsParameterErkannt(sT,s,nil,bekannteBefehle,xMin,xMax,tMin,tMax)) then begin gibAus('Ausdehnung kann erst gesetzt werden, wenn wenigstens eine Komponente bekannt ist',3); exit; end; if (length(liKo)>0) and ausdehnungsParameterErkannt(sT,s,liKo[0].werte,bekannteBefehle,xMin,xMax,tMin,tMax) then continue; if tMaxliKo[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); bekannteBefehle.free; 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); bekannteBefehle.free; 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); bekannteBefehle.free; 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); bekannteBefehle.free; 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); bekannteBefehle.free; 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); bekannteBefehle.free; 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); bekannteBefehle.free; exit; end; until false; bekannteBefehle.free; 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; 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; bekannteBefehle: tMyStringList; 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; bekannteBefehle:=tMyStringList.create; repeat bekannteBefehle.clear; if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); bekannteBefehle.free; exit; end; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if ausdehnungsParameterErkannt(sT,s,quellen[0],bekannteBefehle,xMin,xMax,tMin,tMax) then continue; if istDasBefehl('Schritt:',s,bekannteBefehle,true) then begin (transformationen as tAgglomeration).schritt:=exprToFloat(sT,s); continue; end; if istDasBefehl('Nullposition:',s,bekannteBefehle,true) then begin (transformationen as tAgglomeration).nullposition:=exprToFloat(sT,s); continue; end; if istDasBefehl('waagerecht',s,bekannteBefehle,false) then begin (transformationen as tAgglomeration).horizontal:=true; continue; end; if istDasBefehl('senkrecht',s,bekannteBefehle,false) 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 begin bekannteBefehle.sort; gibAus('Ansonsten kenne ich noch folgende Befehle:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; end; 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); bekannteBefehle.free; 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); bekannteBefehle.free; 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); bekannteBefehle.free; 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); bekannteBefehle.free; 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); bekannteBefehle.free; 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); bekannteBefehle.free; exit; end; until false; bekannteBefehle.free; 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; holeRAM(3); gibAus('Berechne ...',3); Zeit:=now; if xMaxwertes^[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, 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; 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; f: tMyStringList; threads, faktor1, faktor2: longint): boolean; var i,xMin,xMax,tMin,tMax: longint; s: string; fertig,konjugiert: boolean; datenOrdnung: tFFTDatenordnung; produktThreads: array of tProduktThread; Zeit: extended; bekannteBefehle: tMyStringList; 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; konjugiert:=false; datenOrdnung:=doRes; Zeit:=now; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); bekannteBefehle.free; exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if ausdehnungsParameterErkannt(sT,s,nil,bekannteBefehle,xMin,xMax,tMin,tMax) then continue; if istDasBefehl('konjugiert',s,bekannteBefehle,false) then begin konjugiert:=true; continue; end; if istDasBefehl('Datenordnung:',s,bekannteBefehle,true) then begin if not strToFftDo(datenOrdnung,s) then begin gibAus('^ berechneProdukt',3); bekannteBefehle.free; exit; end; continue; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht bei Multipliziere!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; until false; bekannteBefehle.free; if (datenOrdnung<>doRes) and ( (xMin<>0) or (tMin<>0) or (xMax<>_xSteps-1) or (tMax<>_tSiz-1) ) then begin gibAus('Datenordnung '+fftDoToStr(datenOrdnung)+' kann nicht gleichzeitig mit einem Koordinatenausschnitt bei einer Multiplikation verarbeitet werden!',3); exit; end; if konjugiert and not (datenOrdnung in [doResIms,doResSmi]) then begin gibAus('Bei einer Multiplikation kann Datenordnung '+fftDoToStr(datenOrdnung)+' nicht komplex konjugiert werden - ich brauche auch Imaginärteile!',3); exit; end; _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; holeRAM(3); gibAus('Berechne ...',3); Zeit:=now; setLength(produktThreads,threads); for i:=0 to length(produktThreads)-1 do if datenOrdnung = doRes then produktThreads[i]:= tProduktThread.create( wertes^[faktor1], wertes^[faktor2], self, round(i*_xSteps/threads), round((i+1)*_xSteps/threads-1), 0, _tSiz-1, xMin, tMin, datenOrdnung, konjugiert ) else // im Falle komplexen Inhalts müssen wir anders teilen produktThreads[i]:= tProduktThread.create( wertes^[faktor1], wertes^[faktor2], self, round(i*(_xSteps div 2 + 1)/threads), round((i+1)*(_xSteps div 2 + 1)/threads-1), 0, _tSiz div 2, xMin, tMin, datenOrdnung, konjugiert ); 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; f: tMyStringList; threads: longint; quelle: tWerte): boolean; var i: longint; s: string; wavelet: tWavelet; fertig: boolean; korrelThreads: array of tKorrelThread; Zeit,pvFehler: extended; bekannteBefehle: tMyStringList; begin result:=false; warteAufBeendigungDesLeseThreads; genauigkeit:=gExtended; wavelet:=tWavelet.create(knownValues); 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; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); bekannteBefehle.free; exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if istDasBefehl('freq:',s,bekannteBefehle,true) then begin wavelet.freq:=1/kont2diskFak('t',1/exprToFloat(sT,s)); continue; end; if istDasBefehl('tfwhm:',s,bekannteBefehle,true) then begin wavelet.tfwhm:=round(kont2diskFak('t',exprToFloat(sT,s))); continue; end; if istDasBefehl('Wavelettyp:',s,bekannteBefehle,true) then begin if not wavelet.setzeTyp(s) then exit; continue; end; if istDasBefehl('mit FFT',s,bekannteBefehle,false) then begin wavelet.mitFFT:=true; continue; end; if istDasBefehl('ohne FFT',s,bekannteBefehle,false) then begin wavelet.mitFFT:=false; continue; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht bei Berechnung einer Korrelation!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; until false; bekannteBefehle.free; 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; 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; warn: tWarnStufe); begin ermittleMinMaxDichten(sT,threads,0,_xSteps-1,0,_tSiz-1,symmetrisch,warn); end; function tWerte.ermittleMinMaxDichten(sT: boolean; f: tMyStringList; threads: longint; symmetrisch: boolean; warn: tWarnStufe = wsLasch): boolean; var s: string; bekannteBefehle: tMyStringList; xMin,xMax,tMin,tMax: longint; begin result:=false; warteAufBeendigungDesLeseThreads; xMin:=0; xMax:=_xSteps-1; tMin:=0; tMax:=_tSiz-1; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); bekannteBefehle.free; exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if ausdehnungsParameterErkannt(sT,s,nil,bekannteBefehle,xMin,xMax,tMin,tMax) then continue; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht beim Ermitteln von Minimum und Maximum!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; until false; bekannteBefehle.free; ermittleMinMaxDichten(sT,threads,xMin,xMax,tMin,tMax,symmetrisch,warn); result:=true; end; procedure tWerte.ermittleMinMaxDichten(sT: boolean; threads,xMin,xMax,tMin,tMax: longint; symmetrisch: boolean; warn: tWarnStufe); var i,j,maI,miI: 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; if xMax DTs[i].minDichte then begin _minW:=DTs[i].minDichte; _minP:=DTs[i].minPos; miI:=i; end; DTs[i].free; end; if warn = wsStreng then begin if DTs[maI].mehrereMaxima then fehler('Das Maximum ist nicht eindeutig!'); if DTs[miI].mehrereMinima then fehler('Das Minimum ist nicht eindeutig!'); for i:=0 to length(DTs)-1 do begin if (i<>maI) and (DTs[i].maxDichte=_maxW) then fehler('Das Maximum ist nicht eindeutig!'); if (i<>miI) and (DTs[i].minDichte=_minW) then fehler('Das Minimum ist nicht eindeutig!'); end; end; gibAus('... sie sind '+myFloatToStr(_maxW)+' ('+tInt64PointToStr(_maxP)+') und '+myFloatToStr(_minW)+' ('+tInt64PointToStr(_minP)+'). '+timetostr(now-Zeit),3); if symmetrisch then begin _minW:=min(_minW,-_maxW); _maxW:=max(_maxW,-_minW); gibAus('Jetzt sind sie '+myFloatToStr(_maxW)+' und '+myFloatToStr(_minW)+'. '+timetostr(now-Zeit),3); end; end; procedure tWerte.gleicheMinMaxDichtenAn(sT: boolean; f: tMyStringList; symmetrisch: boolean); var i: longint; s: string; Zeit: extended; vgWs: array of tWerte; begin setLength(vgWs,0); repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); exit; end; if s='Ende' then break; setLength(vgWs,length(vgWs)+1); vgWs[length(vgWs)-1]:=wertes^[findeWerte(s,nil,wertes,konturen,false)]; until false; if sT then begin if _minW>=_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; fen: tFenster; hg: tExtendedArray; out pvFehler: extended; warn: tWarnStufe): boolean; var fftThreads: array of tFFTThread; i,fftTSiz: int64; fertig: boolean; begin result:=false; if (vor in [doAlleResIms,doAlleResSmi]) xor (nach in [doAlleResIms,doAlleResSmi]) then begin gibAus('Eine FFT kann nicht von voll-komplex zu halb-komplex oder umgekehrt transformieren - das muss außerhalb erledigt werden ('+fftDoToStr(vor)+' -> '+fftDoToStr(nach)+')!',3); exit; end; if (vor in [doGetrennt]) or (nach in [doGetrennt]) then begin gibAus('tWerte.fft kann nicht mit getrenntem Input oder Output umgehen!',3); exit; end; fftTSiz:=_tSiz div (1+byte(vor in [doAlleResIms,doAlleResSmi])); if senkrecht then begin if assigned(fen) and (length(fen.werte)<>fftTSiz) then fen.berechneWerte(fftTSiz); if threads>_xSteps then threads:=_xSteps; end else begin if assigned(fen) and (length(fen.werte)<>_xSteps) then fen.berechneWerte(_xSteps); if threads>fftTSiz then threads:=fftTSiz; end; setLength(fftThreads,threads); if senkrecht then begin fftThreads[0]:= tFFTThread.create( self, 0, round(_xSteps/threads-1), senkrecht, invers, vor, nach, fen, hg); 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, hg); end else begin fftThreads[0]:= tFFTThread.create( self, 0, round(fftTSiz/threads-1), senkrecht, invers, vor, nach, fen, hg); for i:=1 to threads-1 do fftThreads[i]:= tFFTThread.create( self, round(fftTSiz/threads*i), round(fftTSiz/threads*(i+1)-1), senkrecht, invers, fftThreads[0].algo, fen, hg); 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; procedure tWerte.initFuerGauszFit(sT: boolean; daten: tWerte; senkrecht: boolean; adLaenge: longint; adStart,adStop: extended); begin transformationen:=tFitTransformation.create(daten.transformationen,senkrecht,adLaenge,adStart,adStop); _xSteps:=transformationen.xSteps; _tSiz:=transformationen.tSiz; genauigkeit:=gExtended; if not sT then holeRAM(3); end; function tWerte.fitteGausze(sT: boolean; f: tMyStringList; threads: longint): boolean; var Zeit: extended; senkrecht,fertig: boolean; s: string; i,iterDim: longint; ampl,br,posi,ueberl,hint: tWerte; maxBreite,maxVerschiebung,fensterBreite: extended; posiMitten: tExtendedArray; gauszFitThreads: array of tGauszFitThread; bekannteBefehle: tMyStringList; begin result:=false; Zeit:=now; if not sT then gibAus('Gauße fitten ...',3); ampl:=nil; br:=nil; posi:=nil; ueberl:=nil; hint:=nil; senkrecht:=true; maxBreite:=-1; maxVerschiebung:=-1; fensterBreite:=-1; setLength(posiMitten,0); bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if istDasBefehl('senkrecht',s,bekannteBefehle,false) then begin senkrecht:=true; continue; end; if istDasBefehl('waagerecht',s,bekannteBefehle,false) then begin senkrecht:=false; continue; end; if istDasBefehl('Amplituden:',s,bekannteBefehle,true) then begin i:=findeWerte(s,f,wertes,konturen,true); if i<0 then exit; if assigned(ampl) then begin gibAus('Habe bereits ein Ziel für die Amplituden beim Fitten eines Gaußes!',3); exit; end; ampl:=wertes^[i]; continue; end; if istDasBefehl('Breiten:',s,bekannteBefehle,true) then begin i:=findeWerte(s,f,wertes,konturen,true); if i<0 then exit; if assigned(br) then begin gibAus('Habe bereits ein Ziel für die Breiten beim Fitten eines Gaußes!',3); exit; end; br:=wertes^[i]; continue; end; if istDasBefehl('Positionen:',s,bekannteBefehle,true) then begin i:=findeWerte(s,f,wertes,konturen,true); if i<0 then exit; if assigned(posi) then begin gibAus('Habe bereits ein Ziel für die Positionen beim Fitten eines Gaußes!',3); exit; end; posi:=wertes^[i]; continue; end; if istDasBefehl('Überlapp:',s,bekannteBefehle,true) then begin i:=findeWerte(s,f,wertes,konturen,true); if i<0 then exit; if assigned(ueberl) then begin gibAus('Habe bereits ein Ziel für den Überlapp beim Fitten eines Gaußes!',3); exit; end; ueberl:=wertes^[i]; continue; end; if istDasBefehl('Hintergrund:',s,bekannteBefehle,true) then begin i:=findeWerte(s,f,wertes,konturen,true); if i<0 then exit; if assigned(hint) then begin gibAus('Habe bereits ein Ziel für den Hintergrund beim Fitten eines Gaußes!',3); exit; end; hint:=wertes^[i]; continue; end; if istDasBefehl('Maximalverschiebung:',s,bekannteBefehle,true) then begin maxVerschiebung:=kont2diskFak(senkrecht,exprToFloat(sT,s)); continue; end; if istDasBefehl('Maximalbreite:',s,bekannteBefehle,true) then begin maxBreite:=kont2diskFak(senkrecht,exprToFloat(sT,s)); continue; end; if istDasBefehl('Fensterbreite:',s,bekannteBefehle,true) then begin fensterBreite:=kont2diskFak(senkrecht,exprToFloat(sT,s)); continue; end; if istDasBefehl('Positionsbereichsmitten:',s,bekannteBefehle,true) then begin while s<>'' do fuegeSortiertHinzu(kont2disk(senkrecht,exprToFloat(sT,erstesArgument(s))),posiMitten); continue; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht beim Fitten eines Gaußes!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; until false; bekannteBefehle.free; if (2*maxVerschiebung>fensterBreite) or ((maxVerschiebung<0) and (fensterBreite>0)) then maxVerschiebung:=fensterBreite/2; if length(posiMitten)=0 then begin gibAus('Es sind keine Gauße zu fitten! Was soll das?',3); exit; end; if not (assigned(ampl) or assigned(br) or assigned(posi) or assigned(ueberl) or assigned(hint)) then begin gibAus('Es sind keine Parameter des Gaußes zu speichern! Was soll das?',3); exit; end; if assigned(ampl) then ampl.initFuerGauszFit(sT,self,senkrecht,length(posiMitten),posiMitten[0],posiMitten[length(posiMitten)-1]); if assigned(br) then br.initFuerGauszFit(sT,self,senkrecht,length(posiMitten),posiMitten[0],posiMitten[length(posiMitten)-1]); if assigned(posi) then posi.initFuerGauszFit(sT,self,senkrecht,length(posiMitten),posiMitten[0],posiMitten[length(posiMitten)-1]); if assigned(ueberl) then ueberl.initFuerGauszFit(sT,self,senkrecht,length(posiMitten),posiMitten[0],posiMitten[length(posiMitten)-1]); if assigned(hint) then hint.initFuerGauszFit(sT,self,senkrecht,length(posiMitten),posiMitten[0],posiMitten[length(posiMitten)-1]); if senkrecht then iterDim:=_xSteps else iterDim:=_tSiz; if threads > iterDim then threads:=iterDim; if sT then begin result:=true; exit; end; setLength(gauszFitThreads,threads); for i:=0 to threads-1 do gauszFitThreads[i]:= tGauszFitThread.create( self, ampl, br, posi, ueberl, hint, round(i*iterDim/threads), round((i+1)*iterDim/threads)-1, senkrecht, fensterBreite, maxBreite, maxVerschiebung, posiMitten ); repeat sleep(10); fertig:=true; for i:=0 to threads-1 do fertig:=fertig and gauszFitThreads[i].fertig; until fertig; for i:=0 to threads-1 do gauszFitThreads[i].free; gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.fitte2dGausze(sT: boolean; f: tMyStringList): boolean; var bekannteBefehle: tMyStringList; Zeit,minVerbesserung,minSchritt: extended; anzahl,i,j: longint; schritte,maximalSamples,maxSchritte: int64; s,datei: string; pDatei: textFile; parameter: tExtendedArray; residuenBerechnen: boolean; begin result:=false; if not sT then gibAus('2d-Gauße fitten ...',3); bekannteBefehle:=tMyStringList.create; Zeit:=now; anzahl:=1; datei:=''; minSchritt:=-1; minVerbesserung:=-1; maxSchritte:=-1; residuenBerechnen:=false; maximalSamples:=256; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if istDasBefehl('Anzahl:',s,bekannteBefehle,true) then begin anzahl:=round(exprToFloat(sT,s)); continue; end; if istDasBefehl('maximale Sampleanzahl:',s,bekannteBefehle,true) then begin maximalSamples:=round(sqrt(exprToFloat(sT,s))); continue; end; if istDasBefehl('Residuen berechnen',s,bekannteBefehle,false) then begin residuenBerechnen:=true; continue; end; if istDasBefehl('Datei:',s,bekannteBefehle,true) then begin if datei<>'' then begin gibAus('Habe bereits eine Zieldatei beim Fitten eines 2d-Gaußes!',3); bekannteBefehle.free; exit; end; datei:=s; continue; end; if istDasBefehl('minimale Verbesserung:',s,bekannteBefehle,true) then begin minVerbesserung:=exprToFloat(sT,s); continue; end; if istDasBefehl('minimale Schrittlänge:',s,bekannteBefehle,true) then begin minSchritt:=exprToFloat(sT,s); continue; end; if istDasBefehl('maximale Schrittanzahl:',s,bekannteBefehle,true) then begin maxSchritte:=round(exprToFloat(sT,s)); continue; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht beim Fitten eines 2d-Gaußes!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; until false; bekannteBefehle.free; if (minSchritt<0) and (minVerbesserung<0) and (maxSchritte<0) then begin gibAus('Kein Abbruchkriterium für 2dGaußfit angegeben!',3); exit end; if datei='' then begin gibAus('Keine Datei zum 2dGauße-Fitten angegeben!',3); exit; end; if sT then begin result:=true; exit; end; case genauigkeit of gSingle: schritte:=sWerte.gauszFit2d(anzahl,maximalSamples,minVerbesserung,minSchritt,maxSchritte,parameter); gDouble: schritte:=dWerte.gauszFit2d(anzahl,maximalSamples,minVerbesserung,minSchritt,maxSchritte,parameter); gExtended: schritte:=eWerte.gauszFit2d(anzahl,maximalSamples,minVerbesserung,minSchritt,maxSchritte,parameter); end{of case}; gibAus('... das waren '+intToStr(schritte)+' Schritte, Parameter speichern ...',3); assignFile(pDatei,datei); rewrite(pDatei); writeln(pDatei,myFloatToStr(parameter[0])); for i:=0 to anzahl-1 do begin for j:=0 to 5 do begin if j>0 then write(pDatei,' '); write(pDatei,myFloatToStr(parameter[1+6*i+j])); end; writeln(pDatei); end; closeFile(pDatei); if residuenBerechnen then begin gibAus('... Residuen berechnen ...',3); case genauigkeit of gSingle: sWerte.gausz2dSubtrahieren(parameter); gDouble: dWerte.gausz2dSubtrahieren(parameter); gExtended: eWerte.gausz2dSubtrahieren(parameter); end{of case}; end; gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.faktorisiere(sT: boolean; f: tMyStringList): boolean; var bekannteBefehle: tMyStringList; Zeit,tmpE,nullteSpektrometerordnung: extended; anzahl,i,j: longint; s,aDatei,iDatei,tDatei: string; pDatei: textFile; lineOut,tmpEA: tExtendedArray; maxima,maxima2: tLongintArray; toepfe: tIntPointArray; formen: array of tExtendedArray; residuenBerechnen,auszenHorizontal: boolean; begin result:=false; if not sT then gibAus('faktorisiere ...',3); bekannteBefehle:=tMyStringList.create; Zeit:=now; anzahl:=-1; aDatei:=''; iDatei:=''; tDatei:=''; residuenBerechnen:=false; auszenHorizontal:=false; nullteSpektrometerordnung:=nan; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if istDasBefehl('Anzahl:',s,bekannteBefehle,true) then begin anzahl:=round(exprToFloat(sT,s)); continue; end; if istDasBefehl('nullte Spektrometerordnung:',s,bekannteBefehle,true) then begin if not isNaN(nullteSpektrometerordnung) then begin gibAus('Habe bereits eine nullte Spektrometerordnung beim Faktorisieren!',3); bekannteBefehle.free; exit; end; nullteSpektrometerordnung:=exprToFloat(sT,s); continue; end; if istDasBefehl('Topf-Datei:',s,bekannteBefehle,true) then begin if tDatei<>'' then begin gibAus('Habe bereits eine Datei mit den Töpfen beim Faktorisieren!',3); bekannteBefehle.free; exit; end; tDatei:=s; continue; end; if istDasBefehl('Residuen berechnen',s,bekannteBefehle,false) then begin residuenBerechnen:=true; continue; end; if istDasBefehl('äußere Datei:',s,bekannteBefehle,true) then begin if aDatei<>'' then begin gibAus('Habe bereits eine äußere Zieldatei beim Faktorisieren!',3); bekannteBefehle.free; exit; end; aDatei:=s; continue; end; if istDasBefehl('innere Datei:',s,bekannteBefehle,true) then begin if iDatei<>'' then begin gibAus('Habe bereits eine innere Zieldatei beim Faktorisieren!',3); bekannteBefehle.free; exit; end; iDatei:=s; continue; end; if istDasBefehl('äußere Dimension:',s,bekannteBefehle,true) then begin if s='horizontal' then auszenHorizontal:=true else if s='vertikal' then auszenHorizontal:=false else begin gibAus(''''+s+''' ist keine gültige äußere Dimension beim Faktorisieren - ich kenne nur ''horizontal'' und ''vertikal''!',3); bekannteBefehle.free; exit end; continue; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht beim Faktorisieren!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; until false; bekannteBefehle.free; if (aDatei='') and (iDatei='') and (tDatei='') and not residuenBerechnen then begin gibAus('Keine Ausgaben beim Faktorisieren!',3); exit; end; if (anzahl=-1) and (tDatei='') then begin gibAus('Keine Anzahl und keine Datei mit Töpfen beim Faktorisieren!',3); exit; end; if sT then begin result:=true; exit; end; case genauigkeit of gSingle: lineOut:=sWerte.integriereZuLineOut(not auszenHorizontal,true); gDouble: lineOut:=dWerte.integriereZuLineOut(not auszenHorizontal,true); gExtended: lineOut:=eWerte.integriereZuLineOut(not auszenHorizontal,true); end{of case}; if anzahl<>-1 then begin setLength(maxima,0); i:=0; for j:=0 to length(lineOut)-1 do if ((j=0) or (lineOut[j]>lineOut[j-1])) and ((j=length(lineOut)-1) or (lineOut[j]>lineOut[j+1])) then begin if length(maxima)<=i then setLength(maxima,i+128); maxima[i]:=j; inc(i); end; setLength(maxima,i); sortiereNachDominanz(maxima,lineOut,nullteSpektrometerordnung); setLength(maxima,anzahl); setLength(maxima2,anzahl); setLength(tmpEA,anzahl); for i:=0 to length(tmpEA)-1 do begin tmpEA[i]:=maxima[i]; maxima2[i]:=maxima[i]; maxima[i]:=i; end; sortiereNachWert(maxima,tmpEA,false); setLength(tmpEA,0); setLength(toepfe,anzahl); for i:=0 to length(toepfe)-1 do begin if i>0 then toepfe[length(toepfe)-1-i]['y']:=(maxima2[maxima[i-1]]+maxima2[maxima[i]]) div 2 else if auszenHorizontal then toepfe[length(toepfe)-1-i]['y']:=_xSteps-1 else toepfe[length(toepfe)-1-i]['y']:=_tSiz-1; if i'' then begin assignFile(pDatei,tDatei); rewrite(pDatei); writeln(pDatei,length(toepfe)); for i:=0 to length(toepfe)-1 do writeln(pDatei,tIntPointToStr(toepfe[i])); closeFile(pDatei); end; end else if tDatei<>'' then begin assignFile(pDatei,tDatei); reset(pDatei); readln(pDatei,i); setLength(toepfe,i); for i:=0 to length(toepfe)-1 do begin readln(pDatei,s); toepfe[i]:=strToTIntPoint(s); end; closeFile(pDatei); end; case genauigkeit of gSingle: sWerte.integriereTopfweise(auszenHorizontal,true,toepfe,formen); gDouble: dWerte.integriereTopfweise(auszenHorizontal,true,toepfe,formen); gExtended: eWerte.integriereTopfweise(auszenHorizontal,true,toepfe,formen); end{of case}; // normieren for i:=0 to length(toepfe)-1 do begin tmpE:=0; for j:=toepfe[i]['x'] to toepfe[i]['y'] do tmpE:=tmpE + lineOut[j]; if tmpE = 0 then continue; tmpE:=1/tmpE; for j:=0 to length(formen[i])-1 do formen[i,j]:=formen[i,j] * tmpE; end; if aDatei<>'' then begin gibAus('... speichere äußere Dimension ...',3); assignFile(pDatei,aDatei); rewrite(pDatei); writeln(pDatei,'# Topf, Koordinate der äußeren Dimension, Integral'); if auszenHorizontal then begin for i:=0 to length(toepfe)-1 do for j:=toepfe[i]['x'] to toepfe[i]['y'] do writeln( pDatei, intToStr(i) + #9 + myFloatToStr(transformationen.positionAufAchseZuWert(lOben,j/_xSteps)) + #9 + myFloatToStr(lineOut[j]) ); end else for i:=0 to length(toepfe)-1 do for j:=toepfe[i]['x'] to toepfe[i]['y'] do writeln( pDatei, intToStr(i) + #9 + myFloatToStr(transformationen.positionAufAchseZuWert(lLinks,j/_tSiz)) + #9 + myFloatToStr(lineOut[j]) ); closeFile(pDatei); end; if iDatei<>'' then begin gibAus('... speichere innere Dimension ...',3); assignFile(pDatei,iDatei); rewrite(pDatei); writeln(pDatei,'# Topf, Koordinate der inneren Dimension, Integral'); if auszenHorizontal then begin for i:=0 to length(toepfe)-1 do for j:=0 to length(formen[i])-1 do writeln( pDatei, intToStr(i) + #9 + myFloatToStr(transformationen.positionAufAchseZuWert(lLinks,j/_tSiz)) + #9 + myFloatToStr(formen[i][j]) ); end else for i:=0 to length(toepfe)-1 do for j:=0 to length(formen[i])-1 do writeln( pDatei, intToStr(i) + #9 + myFloatToStr(transformationen.positionAufAchseZuWert(lOben,j/_xSteps)) + #9 + myFloatToStr(formen[i][j]) ); closeFile(pDatei); end; if residuenBerechnen then begin gibAus('... Residuen berechnen ...',3); case genauigkeit of gSingle: sWerte.produktSubtrahieren(auszenHorizontal,toepfe,lineOut,formen); gDouble: dWerte.produktSubtrahieren(auszenHorizontal,toepfe,lineOut,formen); gExtended: eWerte.produktSubtrahieren(auszenHorizontal,toepfe,lineOut,formen); end{of case}; end; gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.berechneZeitfrequenzanalyse(sT: boolean; f: tMyStringList; threads: longint; quelle: tWerte; warn: tWarnStufe): boolean; var i,tMin,tMax,qlen: longint; Zeit,pvFehler,total: extended; wavelet: tGauszFenster; fenster: tSin2Fenster; s: string; senkrecht,rundeAuf2: boolean; tmpW: tExtendedArray; bekannteBefehle: tMyStringList; begin result:=false; if not ((quelle._xSteps<>1) xor (quelle._tSiz<>1)) then begin gibAus('Eine Zeitfrequenzanalyse geht nur auf eindimensionalen Daten! ('+intToStr(quelle._xSteps)+'x'+intToStr(quelle._tSiz)+')',3); exit; end; warteAufBeendigungDesLeseThreads; senkrecht:=quelle._tSiz<>1; tMin:=0; rundeAuf2:=false; if senkrecht then tMax:=quelle._tSiz-1 else tMax:=quelle._xSteps-1; Zeit:=now; wavelet:=tGauszFenster.create; fenster:=tSin2Fenster.create; genauigkeit:=gExtended; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); wavelet.free; fenster.free; exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if istDasBefehl('Breite:',s,bekannteBefehle,true) then begin wavelet.breite:=quelle.kont2diskFak(senkrecht,quelle.exprToFloat(sT,s)); wavelet.aktiv:=true; continue; end; if istDasBefehl('Rand:',s,bekannteBefehle,true) then begin fenster.rand:=round(quelle.kont2diskFak(senkrecht,quelle.exprToFloat(sT,s))); fenster.aktiv:=true; continue; end; if istDasBefehl('nicht auf Zweierpotenz runden',s,bekannteBefehle,false) then begin rundeAuf2:=false; continue; end; if istDasBefehl('auf Zweierpotenz runden',s,bekannteBefehle,false) then begin rundeAuf2:=true; continue; end; if not senkrecht then begin if istDasBefehl('tMin:',s,bekannteBefehle,true) or istDasBefehl('yMin:',s,bekannteBefehle,true) then begin tMin:=round(quelle.kont2disk('t',quelle.exprToFloat(sT,s))); continue; end; if istDasBefehl('tMax:',s,bekannteBefehle,true) or istDasBefehl('yMax:',s,bekannteBefehle,true) then begin tMax:=round(quelle.kont2disk('t',quelle.exprToFloat(sT,s))); continue; end; end; if senkrecht then begin if istDasBefehl('xMin:',s,bekannteBefehle,true) then begin tMin:=round(quelle.kont2disk('x',quelle.exprToFloat(sT,s))); continue; end; if istDasBefehl('xMax:',s,bekannteBefehle,true) then begin tMax:=round(quelle.kont2disk('x',quelle.exprToFloat(sT,s))); continue; end; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht bei Erstellung einer Zeitfrequenzanalyse!'#10'Ich kenne:'#10+bekannteBefehle.text,3); wavelet.free; fenster.free; bekannteBefehle.free; exit; until false; bekannteBefehle.free; if senkrecht then qlen:=quelle._tSiz else qlen:=quelle._xSteps; tMin:=max(tMin,0); tMax:=min(tMax,qlen-1); _xSteps:=tMax+1-tMin; if rundeAuf2 then begin _xSteps:=round(power(2,round(ln(_xSteps)/ln(2)))); if _xSteps>qlen then _xSteps:=_xSteps div 2; tMax:=(tMin+tMax+_xSteps) div 2; tMin:=tMax+1-_xSteps; if tMin<0 then begin tMin:=0; tMax:=_xSteps-1; end; if tMax>=qlen then begin tMax:=qlen-1; tMin:=tMax+1-_xSteps; end; if tMin<0 then begin gibAus('Das Fenster passt nicht in die Werte - das sollte nicht passieren können! ('+ intToStr(tMin)+'..'+ intToStr(tMax)+': '+ intToStr(qlen)+' ('+ intToStr(quelle._xSteps)+'x'+ intToStr(quelle._tSiz)+'))',3); wavelet.free; fenster.free; exit; end; end; _tSiz:=_xSteps; if wavelet.breite>_xSteps then begin gibAus('Die angegebene Breite ist größer als die Anzahl der Werte! ('+ floattostrtrunc(wavelet.breite,2,true)+'>='+ intToStr(_xSteps)+')',3); wavelet.free; fenster.free; exit; end; if fenster.aktiv then fenster.breite:=qlen-fenster.rand else begin fenster.breite:=qlen+1; fenster.rand:=0; end; fenster.berechneWerte(qlen,true); if senkrecht then transformationen:=tKoordinatenAusschnitt.create(quelle.transformationen,0,0,tMin,tMax) else transformationen:=tKoordinatenAusschnitt.create(quelle.transformationen,tMin,tMax,0,0); transformationen:=tDiagonaleAgglomeration.create(transformationen); if not sT then begin total:=0; tMin:=tMin - _xSteps div 2; while tMin<0 do tMin:=tMin+qlen; holeRAM(3); setLength(tmpW,2*_xSteps-1); gibAus('kopiere Inhalt ...',3); case quelle.genauigkeit of gSingle: for i:=0 to 2*_xSteps-2 do tmpW[i]:=quelle.sWerte.werte[(i+tMin) mod qlen] * fenster.werte[(i+tMin) mod qlen]; gDouble: for i:=0 to 2*_xSteps-2 do tmpW[i]:=quelle.dWerte.werte[(i+tMin) mod qlen] * fenster.werte[(i+tMin) mod qlen]; gExtended: for i:=0 to 2*_xSteps-2 do tmpW[i]:=quelle.eWerte.werte[(i+tMin) mod qlen] * fenster.werte[(i+tMin) mod qlen]; end{of case}; for i:=0 to _xSteps-1 do move(tmpW[i],eWerte.werte[i*_xSteps],_xSteps*sizeOf(extended)); for i:=0 to length(eWerte.werte)-1 do total:=total+sqr(eWerte.werte[i]); gibAus('... fertig ('+floatToStr(total)+'), berechne Fouriertransformation ...',3); if not fft(threads,senkrecht,false,doRes,doBetrQdr,wavelet,nil,pvFehler,warn) then begin gibAus('Es traten Fehler auf!',3); wavelet.free; fenster.free; exit; end; total:=0; for i:=0 to length(eWerte.werte)-1 do total:=total+sqr(eWerte.werte[i]); gibAus(' (Parseval-Fehler = '+floatToStr(pvFehler)+') -> '+floatToStr(total),3); end; transformationen:=tFFTTransformation.create(transformationen,not senkrecht,senkrecht,false,false); if senkrecht then // die zweite Hälfte der Werte ist redundant _tSiz:=_tSiz div 2 + 1 else _xSteps:=_xSteps div 2 + 1; transformationen:=tKoordinatenAusschnitt.create(transformationen,0,_xSteps-1,0,_tSiz-1); if not sT then eWerte.holeRAM(3); gibAus('... fertig '+timetostr(now-Zeit),3); wavelet.free; fenster.free; result:=true; end; function tWerte.berechneVerzerrung(sT: boolean; f: tMyStringList; threads: longint; 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; bekannteBefehle: tMyStringList; 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); bekannteBefehle.free; 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; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); aufraeumen; exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if quelle.dichtenParameterErkannt(sT,s,bekannteBefehle,threads,0,_xSteps-1,0,_tSiz-1) then continue; if istDasBefehl('Threadanzahl:',s,bekannteBefehle,true) then begin threads:=strToInt(s); continue; end; if istDasBefehl('Epsilon:',s,bekannteBefehle,true) then begin epsilon:=exprToFloat(sT,s); continue; end; if istDasBefehl('Abbildung:',s,bekannteBefehle,true) 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 istDasBefehl('Nachbearbeitung:',s,bekannteBefehle,true) then begin if not liesTWerteTransformationen(sT,s,f,@exprToFloat,Nachbearbeitung) then begin aufraeumen; exit; end; inc(nachAnz); continue; end; if istDasBefehl('Vorbearbeitung:',s,bekannteBefehle,true) then begin if not liesTWerteTransformationen(sT,s,f,@exprToFloat,Vorbearbeitung) then begin aufraeumen; exit; end; inc(vorAnz); continue; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht bei Erstellung einer Verzerrung!'#10'Ich kenne:'#10+bekannteBefehle.text,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; 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.berechneLambdaZuOmegaVerzerrung(sT: boolean; f: tMyStringList; threads: longint; quelle: tWerte): boolean; var i: longint; Zeit: extended; verzerrLOThreads: array of tVerzerrLOThread; fertig: boolean; s: string; bekannteBefehle: tMyStringList; procedure aufraeumen; var ii: longint; begin for ii:=0 to length(verzerrLOThreads)-1 do if assigned(verzerrLOThreads[ii]) then verzerrLOThreads[ii].free; setLength(verzerrLOThreads,0); bekannteBefehle.free; end; begin result:=false; warteAufBeendigungDesLeseThreads; gibAus('lambda-zu-omega-Verzerrung berechnen ... ',3); Zeit:=now; genauigkeit:=gExtended; // c nm eV h transformationen:=tLambdaZuOmegaTransformation.create(299792458/1e-9/1.6021766208e-19*6.626070040e-34); // nm -> eV transformationen.fuegeVorgaengerHinzu(quelle.transformationen); bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); aufraeumen; exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if quelle.dichtenParameterErkannt(sT,s,bekannteBefehle,threads,0,_xSteps-1,0,_tSiz-1) then continue; if istDasBefehl('Threadanzahl:',s,bekannteBefehle,true) then begin threads:=strToInt(s); continue; end; if istDasBefehl('horizontal',s,bekannteBefehle,false) then begin (transformationen as tLambdaZuOmegaTransformation).horizontal:=true; continue; end; if istDasBefehl('vertikal',s,bekannteBefehle,false) then begin (transformationen as tLambdaZuOmegaTransformation).vertikal:=true; continue; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht bei Erstellung einer lambda-zu-omega-Verzerrung!'#10'Ich kenne:'#10+bekannteBefehle.text,3); aufraeumen; exit; until false; _xSteps:=quelle._xSteps; _tSiz:=quelle._tSiz; if not sT then begin holeRAM(3); gibAus('Threads starten',3); setLength(verzerrLOThreads,threads); for i:=0 to length(verzerrLOThreads)-1 do verzerrLOThreads[i]:= tVerzerrLOThread.create( quelle, self, round(i/length(verzerrLOThreads)*_xSteps), round((i+1)/length(verzerrLOThreads)*_xSteps-1), 0, _tSiz-1, (transformationen as tLambdaZuOmegaTransformation).verhaeltnisHorizontal, (transformationen as tLambdaZuOmegaTransformation).verhaeltnisVertikal); repeat fertig:=true; for i:=0 to length(verzerrLOThreads)-1 do fertig:=fertig and verzerrLOThreads[i].fertig; if not fertig then sleep(10); until fertig; end; aufraeumen; gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.entferneArtefakte(sT: boolean; f: tMyStringList; threads: longint): boolean; var Zeit,epsilon: extended; hintergrund: tExtendedArray; fensters: array[boolean] of tFenster; s: string; b,heiszePixel,fertig: boolean; hintergrundAbziehen,haDummy: tHintergrundAbzugsArt; fensterThreads: array of tFensterThread; i: int64; bekannteBefehle: tMyStringList; heiszPixelSchwellen: array[0..2] of extended; begin result:=false; Zeit:=now; if not sT then gibAus('Artefakte entfernen ...',3); for b:=false to true do begin fensters[b]:=tSin2Fenster.create; (fensters[b] as tSin2Fenster).breite:=_tSiz; end; hintergrundAbziehen.art:=haaKeine; setLength(hintergrundAbziehen.parameter,0); setLength(hintergrund,0); heiszPixelSchwellen[0]:=-1; heiszPixelSchwellen[1]:=-infinity; heiszPixelSchwellen[2]:=infinity; heiszePixel:=false; epsilon:=1e-9; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); for b:=false to true do fensters[b].free; exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; bekannteBefehle.add('''x-Fenster: ...'''); bekannteBefehle.add('''t-Fenster: ...'''); if (pos('-Fenster:',s)=2) and (s[1] in ['x','t']) then begin b:=s[1]='t'; if fensters[b].aktiv then begin gibAus('Das Fenster in '+s[1]+'-Richtung war zum Entfernen der Artefakte bereits aktiviert!',3); bekannteBefehle.free; exit; end; delete(s,1,pos(':',s)); s:=trim(s); if b then (fensters[b] as tSin2Fenster).rand:=round(kont2diskFak('t',exprToFloat(sT,s))) else (fensters[b] as tSin2Fenster).rand:=round(kont2diskFak('x',exprToFloat(sT,s))); fensters[b].aktiv:=true; continue; end; if istDasBefehl('epsilon:',s,bekannteBefehle,true) then begin epsilon:=exprToFloat(sT,s); continue; end; if istDasBefehl('durch horizontalen Verlauf teilen:',s,bekannteBefehle,true) then begin if not stringToTHintergrundAbzugsArt(s,sT,knownValues,@callBackGetValue,haDummy) then begin bekannteBefehle.free; exit; end; if not (haDummy.art in [haaVertikaleMittel,haaVertikaleMedianMittel]) then begin haDummy.art:=haaVertikaleMittel; setLength(haDummy.parameter,2); haDummy.parameter[0]:=3; haDummy.parameter[1]:=3.141; gibAus('Syntaxfehler beim Entfernen von Artefakten - erwartet: "durch horizontalen Verlauf teilen: '+tHintergrundAbzugsArtToStr(haDummy)+'"',3); haDummy.art:=haaVertikaleMedianMittel; setLength(haDummy.parameter,3); haDummy.parameter[0]:=3; haDummy.parameter[1]:=3.141; haDummy.parameter[2]:=1e-3; gibAus('oder: "durch horizontalen Verlauf teilen: '+tHintergrundAbzugsArtToStr(haDummy)+'"',3); bekannteBefehle.free; exit; end; if fensters[false].aktiv then begin gibAus('Beim Entfernen von Artefakten kann ich nicht gleichzeitig in x Fenstern und durch einen horizontalen Verlauf teilen!',3); bekannteBefehle.free; exit; end; fensters[false].free; fensters[false]:=tVerlaufTeilFenster.create(haDummy,epsilon); fensters[false].aktiv:=true; continue; end; if istDasBefehl('Hintergrund abziehen:',s,bekannteBefehle,true) then begin if not stringToTHintergrundAbzugsArt(s,sT,knownValues,@callBackGetValue,hintergrundAbziehen) then begin bekannteBefehle.free; exit; end; continue; end; if istDasBefehl('heiße Pixel',s,bekannteBefehle,true) then begin heiszePixel:=true; for i:=0 to 2 do begin heiszPixelSchwellen[i]:=exprToFloat(sT,erstesArgument(s,',')); if s='' then break; end; if s='' then continue; gibAus('Zu viele Argumente für "heiße Pixel" - erwartet: relative Schwelle, absolutes Minimum, absolutes Maximum',3); bekannteBefehle.free; exit; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht beim Entfernen von Artefakten!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; for b:=false to true do fensters[b].free; exit; until false; bekannteBefehle.free; if not ermittleHintergrund(sT,threads,hintergrundAbziehen,hintergrund) then exit; if fensters[false] is tVerlaufTeilFenster then begin if (fensters[false] as tVerlaufTeilFenster).tRand<0 then begin haDummy.art:=haaVertikaleMittel; setLength(haDummy.parameter,2); haDummy.parameter[0]:=kont2disk('t',(fensters[false] as tVerlaufTeilFenster).tMin); haDummy.parameter[1]:=kont2disk('t',(fensters[false] as tVerlaufTeilFenster).tMax); end else begin haDummy.art:=haaVertikaleMedianMittel; setLength(haDummy.parameter,3); haDummy.parameter[0]:=kont2disk('t',(fensters[false] as tVerlaufTeilFenster).tMin); haDummy.parameter[1]:=kont2disk('t',(fensters[false] as tVerlaufTeilFenster).tMax); haDummy.parameter[2]:=kont2disk('t',(fensters[false] as tVerlaufTeilFenster).tRand); end; if not ermittleHintergrund(sT,threads,haDummy,fensters[false].werte) then exit; for i:=0 to length(fensters[false].werte)-1 do if abs(fensters[false].werte[i])>epsilon then fensters[false].werte[i]:=1/fensters[false].werte[i] else if fensters[false].werte[i]<0 then fensters[false].werte[i]:=-1/epsilon else fensters[false].werte[i]:=1/epsilon; end; if sT then begin for b:=false to true do fensters[b].free; result:=true; exit; end; if (hintergrundAbziehen.art<>haaKeine) or fensters[false].aktiv or fensters[true].aktiv then begin gibAus('Fenster-Threads starten',3); setLength(fensterThreads,threads); for i:=0 to length(fensterThreads)-1 do fensterThreads[i]:= tFensterThread.create( self, round(i/length(fensterThreads)*_xSteps), round((i+1)/length(fensterThreads)*_xSteps-1), 0, _tSiz-1, fensters[false], fensters[true], hintergrund); repeat fertig:=true; for i:=0 to length(fensterThreads)-1 do fertig:=fertig and fensterThreads[i].fertig; if not fertig then sleep(10); until fertig; for i:=0 to length(fensterThreads)-1 do fensterThreads[i].free; end; if heiszePixel then case genauigkeit of gSingle: sWerte.entferneHeiszePixel(heiszPixelSchwellen[0],heiszPixelSchwellen[1],heiszPixelSchwellen[2]); gDouble: dWerte.entferneHeiszePixel(heiszPixelSchwellen[0],heiszPixelSchwellen[1],heiszPixelSchwellen[2]); gExtended: eWerte.entferneHeiszePixel(heiszPixelSchwellen[0],heiszPixelSchwellen[1],heiszPixelSchwellen[2]); end{of case}; gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.entferneNullteOrdnung(sT: boolean; f: tMyStringList; threads: longint): boolean; var Zeit: extended; vertikal: boolean; fenster: tFenster; s: string; i: int64; fertig: boolean; fensterThreads: array of tFensterThread; bekannteBefehle: tMyStringList; begin result:=false; Zeit:=now; if not sT then gibAus('Artefakte entfernen ...',3); fenster:=tSin2Fenster.create; fenster.aktiv:=false; vertikal:=false; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); fenster.free; exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if istDasBefehl('horizontal',s,bekannteBefehle,false) then begin vertikal:=false; continue; end; if istDasBefehl('vertikal',s,bekannteBefehle,false) then begin vertikal:=true; continue; end; if istDasBefehl('Gauß:',s,bekannteBefehle,true) then begin if fenster.aktiv then begin gibAus('entferneNullteOrdnung kann nur ein Fester anwenden!',3); exit; end; fenster.free; fenster:=tGauszFenster.create; (fenster as tGauszFenster).breite:=exprToFloat(sT,s); fenster.aktiv:=true; fenster.invers:=true; continue; end; if istDasBefehl('Sin²:',s,bekannteBefehle,true) then begin if fenster.aktiv then begin gibAus('entferneNullteOrdnung kann nur ein Fester anwenden!',3); exit; end; fenster.free; fenster:=tSin2Fenster.create; (fenster as tSin2Fenster).breite:=round(kont2diskFak(vertikal,exprToFloat(sT,erstesArgument(s)))); (fenster as tSin2Fenster).rand:=round(kont2diskFak(vertikal,exprToFloat(sT,s))); fenster.aktiv:=true; fenster.invers:=true; continue; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht beim Entfernen der nullten Ordnung!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; fenster.free; exit; until false; bekannteBefehle.free; if not fenster.aktiv then begin gibAus('entferneNullteOrdnung benötigt ein Fester!',3); fenster.free; exit; end; if sT then begin fenster.free; result:=true; exit; end; if vertikal then fenster.berechneWerte(_tSiz) else fenster.berechneWerte(_xSteps); gibAus('Fenster-Threads starten',3); setLength(fensterThreads,threads); for i:=0 to length(fensterThreads)-1 do if vertikal then fensterThreads[i]:= tFensterThread.create( self, round(i/length(fensterThreads)*_xSteps), round((i+1)/length(fensterThreads)*_xSteps-1), 0, _tSiz-1, nil, fenster, nil) else fensterThreads[i]:= tFensterThread.create( self, round(i/length(fensterThreads)*_xSteps), round((i+1)/length(fensterThreads)*_xSteps-1), 0, _tSiz-1, fenster, nil, nil); repeat fertig:=true; for i:=0 to length(fensterThreads)-1 do fertig:=fertig and fensterThreads[i].fertig; if not fertig then sleep(10); until fertig; for i:=0 to length(fensterThreads)-1 do fensterThreads[i].free; gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.extrahiereEinhuellende(sT: boolean; f: tMyStringList; threads: longint; warn: tWarnStufe): boolean; var Zeit,pvFehler,xFak,yFak: extended; hintergrund: tExtendedArray; fensters: array[boolean] of tSin2Fenster; s: string; b: boolean; hintergrundAbziehen: tHintergrundAbzugsArt; betraege: tWerte; bekannteBefehle: tMyStringList; begin result:=false; Zeit:=now; if not sT then gibAus('Einhüllende extrahieren ...',3); for b:=false to true do fensters[b]:=tSin2Fenster.create; hintergrundAbziehen.art:=haaKeine; setLength(hintergrundAbziehen.parameter,0); setLength(hintergrund,0); xFak:=1; yFak:=1; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); for b:=false to true do fensters[b].free; exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; bekannteBefehle.add('''x-Fenster: ...'''); bekannteBefehle.add('''t-Fenster: ...'''); 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 istDasBefehl('Hintergrund abziehen:',s,bekannteBefehle,true) then begin if not stringToTHintergrundAbzugsArt(s,sT,knownValues,@callBackGetValue,hintergrundAbziehen) then exit; continue; end; if istDasBefehl('Abstandsmetrik',s,bekannteBefehle,true) then begin xFak:=kont2diskFak('x',exprToFloat(sT,erstesArgument(s))); yFak:=kont2diskFak('t',exprToFloat(sT,s)); continue; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht beim Extrahieren der Einhüllenden!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; until false; bekannteBefehle.free; fensters[true].breite:=_tSiz-fensters[true].breite; fensters[false].breite:=_xSteps-fensters[false].breite; if not ermittleHintergrund(sT,threads,hintergrundAbziehen,hintergrund) then exit; if sT then begin for b:=false to true do fensters[b].free; result:=true; exit; end; gibAus('berechne t-FFT ...',3); if not fft(threads,true,false,doRes,doResSmi,fensters[true],hintergrund,pvFehler,warn) then begin gibAus('Es traten Fehler auf!',3); exit; end; gibAus(' (Parseval-Fehler = '+floatToStr(pvFehler)+')',3); gibAus('berechne x-FFT ...',3); if not fft(threads,false,false,doRes,doResSmi,fensters[false],nil,pvFehler,warn) then begin gibAus('Es traten Fehler auf!',3); exit; end; gibAus(' (Parseval-Fehler = '+floatToStr(pvFehler)+')',3); for b:=false to true do fensters[b].free; gibAus('spektrale Beträge ermitteln',3); betraege:=tWerte.create(self,0,_xSteps-1); betraege.fft2dNachbearbeitung(threads,doBetrQdr,false); betraege.wertAusUmgebungMitteln(_xSteps div 2, _tSiz div 2); // irgendwie sammelt sich hier Rauschen (?) an gibAus('hohe Frequenzen filtern',3); case genauigkeit of gSingle: sWerte.kantenFilter(betraege.sWerte,xFak,yFak,kfTiefpass); gDouble: dWerte.kantenFilter(betraege.dWerte,xFak,yFak,kfTiefpass); gExtended: eWerte.kantenFilter(betraege.eWerte,xFak,yFak,kfTiefpass); end{of case}; betraege.free; gibAus('berechne inverse x-FFT ...',3); if not fft(threads,false,true,doResSmi,doRes,nil,nil,pvFehler,wsLasch) then begin gibAus('Es traten Fehler auf!',3); exit; end; gibAus(' (Parseval-Fehler = '+floatToStr(pvFehler)+')',3); gibAus('berechne inverse t-FFT ...',3); if not fft(threads,true,true,doResSmi,doBetr,nil,hintergrund,pvFehler,warn) then begin gibAus('Es traten Fehler auf!',3); exit; end; gibAus(' (Parseval-Fehler = '+floatToStr(pvFehler)+')',3); gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.extrahierePhase(sT: boolean; f: tMyStringList; threads: longint; warn: tWarnStufe): boolean; var Zeit,pvFehler,xFak,yFak: extended; fensters: array[boolean] of tSin2Fenster; s: string; b: boolean; entspringen: tEntspringModus; bekannteBefehle: tMyStringList; maxPos: tInt64Point; betraege: tWerte; i: longint; begin result:=false; Zeit:=now; if not sT then gibAus('Phase extrahieren ...',3); for b:=false to true do fensters[b]:=tSin2Fenster.create; if not istKomplex then begin gibAus('Ich kann nur aus komplexen Werten die Phase ermitteln!',3); exit; end; xFak:=1; yFak:=1; entspringen.modus:=emKein; setLength(entspringen.parameter,0); bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); bekannteBefehle.free; for b:=false to true do fensters[b].free; exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; bekannteBefehle.add('''x-Fenster: ...'''); bekannteBefehle.add('''t-Fenster: ...'''); 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 istDasBefehl('Abstandsmetrik',s,bekannteBefehle,true) then begin xFak:=kont2diskFak('x',exprToFloat(sT,erstesArgument(s))); yFak:=kont2diskFak('t',exprToFloat(sT,s)); continue; end; if istDasBefehl('entspringen:',s,bekannteBefehle,true) then begin if not strToTEntspringModus(s,sT,knownValues,@callBackGetValue,entspringen) then begin bekannteBefehle.free; for b:=false to true do fensters[b].free; exit; end; continue; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht beim Extrahieren der Phase!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; for b:=false to true do fensters[b].free; exit; until false; bekannteBefehle.free; fensters[true].breite:=_tSiz-fensters[true].breite; fensters[false].breite:=_xSteps-fensters[false].breite; if sT then begin for b:=false to true do fensters[b].free; result:=true; exit; end; gibAus('berechne t-FFT ...',3); if not fft(threads,true,false,doAlleResIms,doAlleResIms,fensters[true],nil,pvFehler,warn) then begin gibAus('Es traten Fehler auf!',3); exit; end; gibAus(' (Parseval-Fehler = '+floatToStr(pvFehler)+')',3); gibAus('berechne x-FFT ...',3); if not fft(threads,false,false,doAlleResIms,doAlleResIms,fensters[false],nil,pvFehler,warn) then begin gibAus('Es traten Fehler auf!',3); exit; end; gibAus(' (Parseval-Fehler = '+floatToStr(pvFehler)+')',3); for b:=false to true do fensters[b].free; gibAus('spektrale Beträge ermitteln',3); betraege:=tWerte.create(self,0,_xSteps-1); betraege.fft2dNachbearbeitung(threads,doBetrQdr,false); gibAus('tiefe Frequenzen filtern',3); case genauigkeit of gSingle: sWerte.kantenFilter(betraege.sWerte,xFak,yFak,kfHochpass,true,maxPos); gDouble: dWerte.kantenFilter(betraege.dWerte,xFak,yFak,kfHochpass,true,maxPos); gExtended: eWerte.kantenFilter(betraege.eWerte,xFak,yFak,kfHochpass,true,maxPos); end{of case}; betraege.free; gibAus('zentrieren ('+tInt64PointToStr(maxPos)+')',3); verschiebe(threads,maxPos); gibAus('berechne inverse x-FFT ...',3); if not fft(threads,false,true,doAlleResIms,doAlleResIms,nil,nil,pvFehler,wsLasch) then begin gibAus('Es traten Fehler auf!',3); exit; end; gibAus(' (Parseval-Fehler = '+floatToStr(pvFehler)+')',3); gibAus('berechne inverse t-FFT ...',3); if not fft(threads,true,true,doAlleResIms,doAlleResIms,nil,nil,pvFehler,warn) then begin gibAus('Es traten Fehler auf!',3); exit; end; gibAus(' (Parseval-Fehler = '+floatToStr(pvFehler)+')',3); gibAus('Phasenwinkel ermitteln ...',3); ermittlePhasenWinkel(threads); if entspringen.modus<>emKein then begin case entspringen.modus of emHorizontal: for i:=0 to 1 do entspringen.parameter[i]:= kont2disk('x',entspringen.parameter[i]); emVertikal: for i:=0 to 1 do entspringen.parameter[i]:= kont2disk('y',entspringen.parameter[i]); end{of case}; gibAus('entspringen ...',3); entspringe(threads,entspringen); end; gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.extrahiereKanten(sT: boolean; f: tMyStringList; threads: longint): boolean; var Zeit: extended; s: string; i: longint; exponent: int64; senkrecht,fertig: boolean; bekannteBefehle: tMyStringList; kantenExtraktionsThreads: array of tKantenExtraktionsThread; begin result:=false; Zeit:=now; if not sT then gibAus('Kanten extrahieren ...',3); senkrecht:=false; exponent:=1; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if istDasBefehl('horizontal',s,bekannteBefehle,false) then begin senkrecht:=false; continue; end; if istDasBefehl('vertikal',s,bekannteBefehle,false) then begin senkrecht:=true; continue; end; if istDasBefehl('Exponent:',s,bekannteBefehle,true) then begin exponent:=round(exprToFloat(sT,s)); continue; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht beim Extrahieren der Kanten!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; until false; bekannteBefehle.free; if exponent<0 then begin gibAus('Ein negativer Exponent ('+floatToStr(exponent)+') ist beim Extrahieren der Kanten nicht erlaubt!',3); exit; end; if sT then begin result:=true; exit; end; gibAus('Kantenextraktionsthreads starten',3); setLength(kantenExtraktionsThreads,threads); if senkrecht then begin for i:=0 to length(kantenExtraktionsThreads)-1 do kantenExtraktionsThreads[i]:= tKantenExtraktionsThread.create( self, round(i/length(kantenExtraktionsThreads)*_xSteps), round((i+1)/length(kantenExtraktionsThreads)*_xSteps-1), 0, _tSiz-1, senkrecht, exponent); end else begin for i:=0 to length(kantenExtraktionsThreads)-1 do kantenExtraktionsThreads[i]:= tKantenExtraktionsThread.create( self, 0, _xSteps-1, round(i/length(kantenExtraktionsThreads)*_tSiz), round((i+1)/length(kantenExtraktionsThreads)*_tSiz-1), senkrecht, exponent); end; repeat fertig:=true; for i:=0 to length(kantenExtraktionsThreads)-1 do fertig:=fertig and kantenExtraktionsThreads[i].fertig; if not fertig then sleep(10); until fertig; gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.skaliere(sT: boolean; f: tMyStringList; threads: longint): boolean; var bekannteBefehle: tMyStringList; s,speichernAls: string; skalierung: array['x'..'z'] of string; nullen: array['x'..'y'] of boolean; c: char; skalierungsThreads: array of tSkalierungsThread; i: longint; fertig: boolean; begin result:=false; bekannteBefehle:=tMyStringList.create; for c:='x' to 'z' do skalierung[c]:='1'; for c:='x' to 'y' do nullen[c]:=false; speichernAls:=''; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if istDasBefehl('Parameter speichern als',s,bekannteBefehle,true) then begin if speichernAls<>'' then begin gibAus('Ich soll die Skalierungs-Parameter schon als '''+speichernAls+''' speichern!',3); exit; end; speichernAls:=s; continue; end; for c:='x' to 'z' do begin if istDasBefehl(c+':',s,bekannteBefehle,true) then begin if skalierung[c]<>'1' then begin gibAus('Ich kann nicht mehrere '+c+'-Skalierungen gleichzeitig anwenden!',3); bekannteBefehle.free; exit; end; skalierung[c]:=s; s:=''; break; end; end; for c:='x' to 'y' do if istDasBefehl(c+'0',s,bekannteBefehle,false) then begin nullen[c]:=true; s:=''; break; end; if s='' then continue; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht beim Skalieren!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; until false; if (skalierung['x']<>'1') or (skalierung['y']<>'1') or nullen['x'] or nullen['y'] then begin if speichernAls<>'' then begin knownValues.add(speichernAls+'.x0',_xStart); knownValues.add(speichernAls+'.y0',_tStart); end; transformationen:=tLineareAchsenVerzerrTransformation.create(transformationen); with transformationen as tLineareAchsenVerzerrTransformation do for c:='x' to 'y' do begin // die Reihenfolge ist wichtig: offset[c]:=-byte(nullen[c]) * achsen[c,'x']; // zuerst der Offset, fak[c]:=abs(exprToFloat(sT,skalierung[c])); // dann der Faktor! knownValues.add(speichernAls+'.'+c+'Faktor',fak[c]); end; end; if skalierung['z']<>'1' then begin if sT then begin knownValues.add('x',_xStart); knownValues.add('y',_tStart); exprToFloat(sT,skalierung['z']); knownValues.rem('x'); knownValues.rem('y'); end else begin setLength(skalierungsThreads,threads); for i:=0 to length(skalierungsThreads)-1 do skalierungsThreads[i]:= tSkalierungsThread.create( self, round(i*_tSiz/length(skalierungsThreads)), round((i+1)*_tSiz/length(skalierungsThreads))-1, skalierung['z'] ); repeat sleep(10); fertig:=true; for i:=0 to length(skalierungsThreads)-1 do fertig:=skalierungsThreads[i].fertig and fertig; until fertig; end; end; result:=true; end; function tWerte.nullenEinfuegen(sT: boolean; f: tMyStringList): boolean; var bekannteBefehle: tMyStringList; wo: array['x'..'y'] of boolean; rtg: char; s: string; begin result:=false; for rtg:='x' to 'y' do wo[rtg]:=false; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; rtg:=' '; if istDasBefehl('horizontal:',s,bekannteBefehle,true) then rtg:='x' else if istDasBefehl('vertikal:',s,bekannteBefehle,true) then rtg:='y'; if rtg in ['x','y'] then begin if wo[rtg] then begin gibAus('Ich kann nur ein Mal pro Richtung Nullen einfügen!',3); bekannteBefehle.free; exit; end; bekannteBefehle.clear; if istDasBefehl('egal wo',s,bekannteBefehle,false) or istDasBefehl('plus',s,bekannteBefehle,false) then begin wo[rtg]:=true; continue; end; bekannteBefehle.sort; gibAus('Unbekannte Lage der Nullen '''+s+'''!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht beim Einfügen von Nullen!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; until false; bekannteBefehle.free; if not (wo['x'] or wo['y']) then begin result:=true; exit; end; transformationen:=tGroeszenVerdopplungsTransformation.create(transformationen,wo['x'],wo['y']); if wo['x'] then _xSteps:=_xSteps*2; if wo['y'] then _tSiz:=_tSiz*2; if sT then begin result:=true; exit; end; holeRAM(3); case genauigkeit of gSingle: sWerte.nullenEinfuegen(false,_xSteps div (1+byte(wo['x'])),_tSiz div (1+byte(wo['y']))); gDouble: dWerte.nullenEinfuegen(false,_xSteps div (1+byte(wo['x'])),_tSiz div (1+byte(wo['y']))); gExtended: eWerte.nullenEinfuegen(false,_xSteps div (1+byte(wo['x'])),_tSiz div (1+byte(wo['y']))); end{of case}; result:=true; end; function tWerte.macheKomplex(sT: boolean; f: tMyStringList; threads: longint): boolean; var bekannteBefehle: tMyStringList; komplexMachModus: tKomplexMachModus; kmThreads: array of tKomplexMachThread; s: string; i: longint; fertig: boolean; begin result:=false; if istKomplex then begin gibAus('Werte '''+bezeichner+''' sind bereits komplex!',3); exit; end; komplexMachModus:=kmmImNull; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if istDasBefehl('rein reell',s,bekannteBefehle,false) then begin komplexMachModus:=kmmImNull; continue; end; if istDasBefehl('rein imaginär',s,bekannteBefehle,false) then begin komplexMachModus:=kmmReNull; continue; end; if istDasBefehl('zufällige Phase',s,bekannteBefehle,false) then begin komplexMachModus:=kmmPhZuf; continue; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht beim Komplexmachen!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; until false; bekannteBefehle.free; istKomplex:=true; if sT then begin result:=true; exit; end; holeRAM(3); setLength(kmThreads,threads); for i:=0 to length(kmThreads)-1 do kmThreads[i]:=tKomplexMachThread.create( self, round(i/threads*(_tSiz div 2)), round((i+1)/threads*(_tSiz div 2))-1, komplexMachModus, random(high(longword)) ); repeat fertig:=true; for i:=0 to length(kmThreads)-1 do fertig:=fertig and kmThreads[i].fertig; if not fertig then sleep(10); until fertig; for i:=0 to length(kmThreads)-1 do kmThreads[i].free; result:=true; end; function tWerte.berechneIntegral(sT: boolean; f: tMyStringList; threads: longint; quelle: tWerte): boolean; var i,tMin,tMax,xMin,xMax: longint; Zeit: extended; s: string; rtg: tIntegrationsRichtung; intThreads: array of tIntegralThread; fertig: boolean; bekannteBefehle: tMyStringList; begin result:=false; warteAufBeendigungDesLeseThreads; Zeit:=now; tMin:=0; tMax:=quelle._tSiz-1; xMin:=0; xMax:=quelle._xSteps-1; genauigkeit:=gExtended; rtg:=irHorizontal; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); bekannteBefehle.free; exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if istDasBefehl('Threadanzahl:',s,bekannteBefehle,true) then begin threads:=strToInt(s); continue; end; if ausdehnungsParameterErkannt(sT,s,quelle,bekannteBefehle,xMin,xMax,tMin,tMax) then continue; if istDasBefehl('Richtung:',s,bekannteBefehle,true) then begin bekannteBefehle.clear; if istDasBefehl('waagerecht',s,bekannteBefehle,false) then begin rtg:=irHorizontal; continue; end; if istDasBefehl('einfall',s,bekannteBefehle,false) then begin rtg:=irEinfall; continue; end; if istDasBefehl('ausfall',s,bekannteBefehle,false) then begin rtg:=irAusfall; continue; end; bekannteBefehle.sort; gibAus('Verstehe Richtung '''+s+''' nicht bei Berechnung eines Integrals!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht bei Berechnung eines Integrals!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; until false; bekannteBefehle.free; if xMax out, // FFT2 in -> out, // Ende (= Benutzervorgabe) fensters: array[boolean] of tSin2Fenster; s: string; b,spiegeln,invers,horizontealZentrieren: boolean; bekannteBefehle: tMyStringList; begin result:=false; warteAufBeendigungDesLeseThreads; Zeit:=now; if istKomplex then begin dos[0]:=doAlleResIms; dos[4]:=doAlleResIms; end else begin dos[0]:=doRes; dos[4]:=doBetrQdr; end; for b:=false to true do fensters[b]:=tSin2Fenster.create; spiegeln:=false; invers:=false; horizontealZentrieren:=false; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); for b:=false to true do fensters[b].free; bekannteBefehle.free; exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if istDasBefehl('Nachbereitung:',s,bekannteBefehle,true) then begin if not strToFftDo(dos[4],s) then begin for b:=false to true do fensters[b].free; bekannteBefehle.free; exit; end; continue; end; if istDasBefehl('Eingangsordnung:',s,bekannteBefehle,true) then begin if not strToFftDo(dos[0],s) then begin for b:=false to true do fensters[b].free; bekannteBefehle.free; exit; end; continue; end; bekannteBefehle.add('''x-Fenster: ...'''); bekannteBefehle.add('''t-Fenster: ...'''); if (pos('-Fenster:',s)=2) and (s[1] in ['x','t']) then begin b:=s[1]='t'; erstesArgument(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 istDasBefehl('x-Spiegelung',s,bekannteBefehle,false) then begin spiegeln:=true; continue; end; if istDasBefehl('invers',s,bekannteBefehle,false) then begin invers:=true; continue; end; if istDasBefehl('anschließend horizontal zentrieren',s,bekannteBefehle,false) then begin horizontealZentrieren:=true; continue; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht bei Erstellung einer zweidimensionalen FFT!'#10'Ich kenne:'#10+bekannteBefehle.text,3); for b:=false to true do fensters[b].free; bekannteBefehle.free; exit; until false; bekannteBefehle.free; fensters[true].breite:=_tSiz-fensters[true].breite; fensters[false].breite:=_xSteps-fensters[false].breite; if odd(_tSiz) then begin gibAus('Eine 2d-FFT braucht eine gerade Anzahl an Werten, '+intToStr(_tSiz)+' ist aber ungerade (man könnte das aber auch noch implementieren)!',3); for b:=false to true do fensters[b].free; exit; end; if odd(_xSteps) then begin gibAus('Eine 2d-FFT braucht eine gerade Anzahl an Werten, '+intToStr(_xSteps)+' ist aber ungerade (man könnte das aber auch noch implementieren)!',3); for b:=false to true do fensters[b].free; exit; end; if istKomplex xor (dos[4] in [doAlleResIms, doAlleResSmi]) then begin gibAus('Eine 2d-FFT gibt genau dann alle Real- und Imaginärteile aus, wenn die Eingabe komplex ist!',3); exit; end; if invers and horizontealZentrieren then begin gibAus('Eine inverse 2d-FFT kann nicht anschließend die Werte horizontal zentrieren!',3); exit; end; if (not (dos[4] in [doBetr,doBetrQdr])) and horizontealZentrieren then begin gibAus('Eine 2d-FFT mit Nachbereitung '+fftDoToStr(dos[4])+' kann anschließend nicht die Werte horizontal zentrieren!',3); exit; end; if istKomplex then begin if dos[0]<>doAlleResIms then begin gibAus('Eine vollkomplexe 2d-FFT kann nicht auf die Eingangsordnung '+fftDoToStr(dos[0])+' angewendet werden!',3); exit; end; dos[1]:=doAlleResIms; dos[2]:=doAlleResIms; dos[3]:=dos[4]; end else if invers then begin if dos[4]<>doRes then begin gibAus('Momentan kann eine (halbkomplexe,) inverse 2d-FFT keine Nachbereitung '+fftDoToStr(dos[4])+' erzeugen!',3); exit; end; dos[2]:=dos[0]; dos[1]:=dos[4]; dos[3]:=dos[4]; end else begin dos[2]:=dos[0]; if dos[4]=doResIms then begin dos[1]:=doResIms; dos[3]:=doResIms; end else begin dos[1]:=doResSmi; dos[3]:=doResSmi; end; end; if sT then begin result:=true; for b:=false to true do fensters[b].free; exit; end; transformationen:=tFFTTransformation.create(transformationen,true,true,horizontealZentrieren,false); 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,invers,dos[0],dos[1],fensters[true],nil,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,invers,dos[2],dos[3],fensters[false],nil,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); if (dos[3]<>dos[4]) or horizontealZentrieren then fft2dNachbearbeitung(threads,dos[4],horizontealZentrieren); gibAus('... fertig! '+timetostr(now-Zeit),3); for b:=false to true do fensters[b].free; result:=true; end; function tWerte.berechneAutokorrelation2d(sT: boolean; f: tMyStringList; threads: longint; warn: tWarnStufe): boolean; var Zeit,pvFehler: extended; i: longint; s: string; b,fertig: boolean; fftRichtungen: array[boolean] of char; gespiegelt: array[boolean] of boolean; bekannteBefehle: tMyStringList; TTs: array of tTauschThread; begin result:=false; warteAufBeendigungDesLeseThreads; Zeit:=now; if istKomplex then begin gibAus('Eine 2d-Autokorrelation braucht (momentan) reelle Werte!',3); exit; end; for b:=false to true do gespiegelt[b]:=false; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); bekannteBefehle.free; exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if istDasBefehl('horizontal gespiegelt',s,bekannteBefehle,false) then begin gespiegelt[false]:=true; continue; end; if istDasBefehl('vertikal gespiegelt',s,bekannteBefehle,false) then begin gespiegelt[true]:=true; continue; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht bei Erstellung einer zweidimensionalen Autokorrelation!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; until false; bekannteBefehle.free; transformationen:=tAK2dTransformation.create(transformationen,gespiegelt[false],gespiegelt[true]); _xSteps:=_xSteps*2; _tSiz:=_tSiz*2; if sT then begin result:=true; exit; end; holeRAM(3); case genauigkeit of gSingle: sWerte.nullenEinfuegen(false,_xSteps div 2,_tSiz div 2); gDouble: dWerte.nullenEinfuegen(false,_xSteps div 2,_tSiz div 2); gExtended: eWerte.nullenEinfuegen(false,_xSteps div 2,_tSiz div 2); end{of case}; // sonst transformieren wir Zeilen, die nur Nullen beinhalten, in der 1. inversen FFT if not gespiegelt[true] and gespiegelt[false] then begin fftRichtungen[false]:='x'; fftRichtungen[true]:='t'; end else begin fftRichtungen[false]:='t'; fftRichtungen[true]:='x'; end; for b:=false to true do begin gibAus('berechne '+fftRichtungen[b]+'-FFT ...',3); if not fft(threads,fftRichtungen[b]='t',false,doRes,doResSmi,nil,nil,pvFehler,warn) then begin gibAus('Es traten Fehler auf!',3); exit; end; gibAus(' (Parseval-Fehler = '+floatToStr(pvFehler)+')',3); gibAus('... fertig! '+timetostr(now-Zeit),3); end; gibAus('Quadrieren ...',3); fft2dQuadrieren(threads,not gespiegelt[false],not gespiegelt[true]); gibAus('... fertig! '+timetostr(now-Zeit),3); for b:=true downto false do begin gibAus('berechne inverse '+fftRichtungen[b]+'-FFT ...',3); if not fft(threads,fftRichtungen[b]='t',true,doResSmi,doRes,nil,nil,pvFehler,warn) then begin gibAus('Es traten Fehler auf!',3); exit; end; gibAus(' (Parseval-Fehler = '+floatToStr(pvFehler)+')',3); gibAus('... fertig! '+timetostr(now-Zeit),3); end; setLength(TTs,threads); for b:=false to true do if not gespiegelt[b] then begin for i:=0 to length(TTs)-1 do if b then TTs[i]:=tTauschThread.create( round(i*_xSteps/length(TTs)), round((i+1)*_xSteps/length(TTs))-1, true, self) else TTs[i]:=tTauschThread.create( round(i*_tSiz/length(TTs)), round((i+1)*_tSiz/length(TTs))-1, false, self); repeat sleep(10); fertig:=true; for i:=0 to length(TTs)-1 do fertig:=fertig and TTs[i].fertig; until fertig; for i:=0 to length(TTs)-1 do TTs[i].free; end; result:=true; end; function tWerte.berechneRadonTransformation(sT: boolean; f: tMyStringList; threads: longint; quelle: tWerte; warn: tWarnStufe): boolean; var Zeit,pvFehler: extended; winkelSchritte: int64; s: string; bekannteBefehle: tMyStringList; i: longint; fertig: boolean; hilfsWerte: tWerte; radonTransformationsLineOutThreads: array of tRadonTransformationsLineOutThread; begin result:=false; warteAufBeendigungDesLeseThreads; Zeit:=now; winkelSchritte:=180; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); bekannteBefehle.free; exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if istDasBefehl('Winkelschritte:',s,bekannteBefehle,true) then begin winkelSchritte:=round(exprToFloat(sT,s)); continue; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht bei Erstellung einer Radon-Transformation!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; until false; bekannteBefehle.free; if istKomplex then begin gibAus('Ich kann keine Radontransformation von voll-komplexen Werte machen!',3); exit end; if quelle.disk2kontFak('x',1) <> quelle.disk2kontFak('y',1) then gibAus('Warnung: dx ('+floatToStr(quelle.disk2kontFak('x',1))+') und dy ('+floatToStr(quelle.disk2kontFak('y',1))+') unterscheiden sich (um '+floatToStr(abs(quelle.disk2kontFak('x',1)-quelle.disk2kontFak('y',1)))+') bei Radontransformation - die Achsen verlaufen nicht linear!',3); if not sT then begin gibAus('kopiere Werte für Radon-Transformation ...',3); hilfsWerte:=tWerte.create(quelle,gExtended); // quelle zu hilfsWerte kopieren ... // ... und quadratisch ergänzen: Kantenlänge >= 2*Diagonale von quelle + 1 hilfsWerte.transformationen:=tRTVorbereitungsTransformation.create(quelle.transformationen); hilfsWerte._xSteps:=hilfsWerte.transformationen.tSiz; hilfsWerte._tSiz:=hilfsWerte.transformationen.xSteps; hilfsWerte.holeRAM(3); hilfsWerte.eWerte.nullenEinfuegen(true,quelle._xSteps,quelle._tSiz); gibAus('berechne t-FFT für Radon-Transformation ...',3); if not hilfsWerte.fft(threads,true,false,doRes,doResSmi,nil,nil,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 für Radon-Transformation ...',3); if not hilfsWerte.fft(threads,false,false,doRes,doResSmi,nil,nil,pvFehler,warn) then begin gibAus('Es traten Fehler auf!',3); exit; end; gibAus(' (Parseval-Fehler = '+floatToStr(pvFehler)+')',3); gibAus('... fertig! '+timetostr(now-Zeit),3); hilfsWerte.transformationen:=tFFTTransformation.create(hilfsWerte.transformationen,true,true,false,false); transformationen:=tRTLineOutTransformation.create(hilfsWerte.transformationen,winkelSchritte); _xSteps:=transformationen.xSteps; _tSiz:=transformationen.tSiz; holeRAM(3); gibAus('Lineouts für Radon-Transformation extrahieren ...',3); setLength(radonTransformationsLineOutThreads,threads); for i:=0 to length(radonTransformationsLineOutThreads)-1 do radonTransformationsLineOutThreads[i]:=tRadonTransformationsLineOutThread.create( hilfsWerte, self, round(_xSteps/length(radonTransformationsLineOutThreads)*i), round(_xSteps/length(radonTransformationsLineOutThreads)*(i+1))-1 ); repeat fertig:=true; for i:=0 to length(radonTransformationsLineOutThreads)-1 do fertig:=radonTransformationsLineOutThreads[i].fertig and fertig; if not fertig then sleep(10); until fertig; gibAus('... fertig! '+timetostr(now-Zeit),3); hilfsWerte.free; gibAus('berechne inverse t-FFT für Radon-Transformation ...',3); if not fft(threads,true,true,doResSmi,doRes,nil,nil,pvFehler,warn) then begin gibAus('Es traten Fehler auf!',3); exit; end; gibAus(' (Parseval-Fehler = '+floatToStr(pvFehler)+')',3); gibAus('... fertig! '+timetostr(now-Zeit),3); transformationen:=tFFTTransformation.create(transformationen,false,true,false,true); // eigentlich invers! end else begin transformationen:=tRTVorbereitungsTransformation.create(quelle.transformationen); transformationen:=tFFTTransformation.create(transformationen,true,true,false,false); transformationen:=tRTLineOutTransformation.create(transformationen,winkelSchritte); transformationen:=tFFTTransformation.create(transformationen,false,true,false,true); end; result:=true; end; function tWerte.erzeugeLinearesBild(sT: boolean; var f: tMyStringList; threads: longint): boolean; var s,t,datei,achsenDatei: 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: tPalettenArray; nachbearbeitungen: tTransformationArray; Ausschnitt: tTransformation; bilderThreads: array of tBilderThread; fertig,rahmen,modulo,etwasGezeichnet: boolean; img: file; achsen: array of tAchse; fontRenderer: tFontRenderer; beschriftungen: array of tBeschriftung; verwKonturen: array of tZuZeichnendeKontur; musterKontur: tZuZeichnendeKontur; quellen: tWerteArray; bekannteBefehle: tMyStringList; 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; bekannteBefehle.free; end; begin result:=false; warteAufBeendigungDesLeseThreads; Zeit:=now; if not sT then gibAus('erzeuge lineares Bild aus '+bezeichner+' ...',3); datei:=''; achsenDatei:=''; xZoom:=1; yZoom:=1; modulo:=false; 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; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende in '''+paramstr(1)+'''!',3); aufraeumen; exit; end; bekannteBefehle.clear; if istDasBefehl('Datei:',s,bekannteBefehle,true) then begin datei:=s; continue; end; if istDasBefehl('exportiere Achsen nach:',s,bekannteBefehle,true) then begin achsenDatei:=s; continue; end; if istDasBefehl('Vergrößerung:',s,bekannteBefehle,true) then begin xZoom:=exprToFloat(sT,s); yZoom:=exprToFloat(sT,s); continue; end; if istDasBefehl('x-Vergrößerung:',s,bekannteBefehle,true) then begin xZoom:=exprToFloat(sT,s); continue; end; if istDasBefehl('t-Vergrößerung:',s,bekannteBefehle,true) then begin yZoom:=exprToFloat(sT,s); continue; end; if self.dichtenParameterErkannt(sT,s,bekannteBefehle,threads,xMin,xMax,tMin,tMax) then continue; if ausdehnungsParameterErkannt(sT,s,nil,bekannteBefehle,xMin,xMax,tMin,tMax) then continue; if istDasBefehl('modulo',s,bekannteBefehle,false) then begin modulo:=true; continue; end; if istDasBefehl('Palette:',s,bekannteBefehle,true) then begin if s[1] in ['0'..'9'] then i:=strToInt(erstesArgument(s)) else i:=0; while i>=length(paletten) do begin setLength(paletten,length(paletten)+1); paletten[length(paletten)-1]:=nil; end; if not findePalette(paletten[i],s) then begin gibAus('Kenne Palette '''+s+''' nicht!'#10'Ich kenne nur:'#10+dumpPalettenNamen,3); aufraeumen; exit; end; continue; end; if istDasBefehl('Schriftgröße:',s,bekannteBefehle,true) then begin schriftgroesze:=strToInt(s); continue; end; if istDasBefehl('Rahmen',s,bekannteBefehle,false) then begin rahmen:=true; continue; end; if istDasBefehl('Nachbearbeitung:',s,bekannteBefehle,true) 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); t:=erstesArgument(s); i:=findeKontur(t,nil,wertes,konturen,false); if (i<0) or (i>=length(konturen^)) then begin bekannteBefehle.sort; gibAus('Die Kontur '''+t+''' gibt es nicht!'#10'Ansonsten kenne ich noch die Befehle:'#10+bekannteBefehle.text,3); aufraeumen; exit; end; verwKonturen[length(verwKonturen)-1]:=tZuZeichnendeKontur.create(musterKontur,konturen^[i]); end; until false; continue; end; if istDasBefehl('Daten:',s,bekannteBefehle,true) 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; if xMax'' then exportiereAchsen(achsenDatei,Ausschnitt.achsen,breite,hoehe); 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; if miW>maW then begin wert:=miW; miW:=maW; maW:=wert; 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:=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,threads); 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,modulo,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 etwasGezeichnet:=verwKonturen[i].leerIstInOrdnung; for j:=0 to length(bilderThreads)-1 do bilderThreads[j].initAnzahlensFuerKontur; for j:=0 to length(verwKonturen[i].kontur.orte)-1 do begin xp0:=(transformationen.wertZuPositionAufAchse(lUnten,verwKonturen[i].kontur.orte[j]['x'],false)*_xSteps-xMin)*xZoom; tp0:=(transformationen.wertZuPositionAufAchse(lLinks,verwKonturen[i].kontur.orte[j]['y'],false)*_tSiz-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; if not etwasGezeichnet then begin gibAus('erzeugeLinearesBild: Für Kontur '''+verwKonturen[i].kontur.bezeichner+''' wurden keine Punkte innerhalb des aktuellen Rahmens von '''+bezeichner+''' gezeichnet.',3); exit; 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; f: tMyStringList): boolean; var datei,s,separator: string; outF: textFile; i,j: longint; xMin,xMax,tMin,tMax: longint; Zeit: extended; mitKoordinaten: byte; bekannteBefehle: tMyStringList; 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:=','; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende in '''+paramstr(1)+'''!',3); bekannteBefehle.free; exit; end; bekannteBefehle.clear; if istDasBefehl('Datei:',s,bekannteBefehle,true) then begin datei:=s; continue; end; if ausdehnungsParameterErkannt(sT,s,nil,bekannteBefehle,xMin,xMax,tMin,tMax) then continue; if istDasBefehl('Koordinaten einfügen',s,bekannteBefehle,false) then begin if (_xSteps=1) or (_tSiz=1) then begin mitKoordinaten:=byte(_xSteps=1)*2 + byte(_tSiz=1); continue; end; gibAus('Kann Koordinaten nicht in mehrdimensionale Daten einfügen!',3); bekannteBefehle.free; exit; end; if istDasBefehl('Separator:',s,bekannteBefehle,true) then begin if s='Leerzeichen' then begin separator:=' '; continue; end; if s='Tab' then begin separator:=#9; continue; end; separator:=s; continue; end; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht bei Erzeugung einer Ascii-Datei!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; until false; bekannteBefehle.free; 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; f: tMyStringList): boolean; var ab: t2x2Extended; linienIntegral: tLinienIntegral; datei,s,skalierung: string; fOut: textFile; bekannteBefehle: tMyStringList; Zeit,entspringen, letzterWert,verschiebung, tmp: extended; tmpPoint: tExtPoint; i,schritte: longint; integriere,iWaag, auszerhalbInOrdnung: boolean; tmpValues: tKnownValues; 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; ab['x']:=extPoint(0,0); ab['y']:=extPoint(_xSteps-1,_tSiz-1); linienIntegral.von:=extPoint(0,0); linienIntegral.schritt:=extPoint(0,0); linienIntegral.schritte:=0; auszerhalbInOrdnung:=false; skalierung:='1'; verschiebung:=0; datei:=''; integriere:=false; iWaag:=false; entspringen:=-1; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende in '''+paramstr(1)+'''!',3); bekannteBefehle.free; exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if istDasBefehl('Datei:',s,bekannteBefehle,true) then begin datei:=s; continue; end; if istDasBefehl('Skalierung:',s,bekannteBefehle,true) then begin if skalierung<>'1' then begin gibAus('Ich soll den Lineout bereits mittels '''+skalierung+''' skalieren!',3); exit; end; skalierung:=s; continue; end; if istDasBefehl('Verschiebung:',s,bekannteBefehle,true) then begin if verschiebung<>0 then begin gibAus('Ich soll den Lineout bereits um '''+myFloatToStr(verschiebung)+''' verschieben!',3); exit; end; verschiebung:=exprToFloat(sT,s); continue; end; if istDasBefehl('integriere waagerecht',s,bekannteBefehle,false) then begin if integriere then begin gibAus('Ich kann bei einem Lineout nur in einer Richtung integrieren!',3); bekannteBefehle.free; exit; end; integriere:=true; iWaag:=true; continue; end; if istDasBefehl('integriere senkrecht',s,bekannteBefehle,false) then begin if integriere then begin gibAus('Ich kann bei einem Lineout nur in einer Richtung integrieren!',3); bekannteBefehle.free; exit; end; integriere:=true; iWaag:=false; continue; end; if istDasBefehl('integriere entlang:',s,bekannteBefehle,true) then begin tmp:=exprToFloat(sT,erstesArgument(s,',')); tmpPoint:=extPoint(cos(tmp),sin(tmp)); tmp:=kont2diskFak('x',exprToFloat(sT,erstesArgument(s,','))); linienIntegral.von:=-tmp*tmpPoint; tmp:=kont2diskFak('x',exprToFloat(sT,s)); linienIntegral.schritt:=tmp*tmpPoint; linienIntegral.schritte:=ceil(max( abs( (linienIntegral.schritt['x']-linienIntegral.von['x'])/(_xStop-_xStart)*(_xSteps-1) ), abs( (linienIntegral.schritt['y']-linienIntegral.von['y'])/(_tStop-_tStart)*(_tSiz-1) ) )); linienIntegral.schritt:= (1/linienIntegral.schritte)*linienIntegral.schritt; continue; end; if istDasBefehl('Aufpunkt und Richtung:',s,bekannteBefehle,true) then begin tmp:=kont2disk('x',exprToFloat(sT,erstesArgument(s,','))); tmpPoint:=extPoint(tmp,kont2disk('y',exprToFloat(sT,erstesArgument(s,',')))); if sT then tmpPoint:=extPoint(_xSteps/2,_tSiz/2); tmp:=exprToFloat(sT,s); ab['x']:= naechsterSchnittpunkt( gerade( tmpPoint, extPoint(-cos(tmp),-sin(tmp)) ), diskRand ); ab['y']:= naechsterSchnittpunkt( gerade( tmpPoint, extPoint(cos(tmp),sin(tmp)) ), diskRand ); continue; end; if istDasBefehl('von',s,bekannteBefehle,true) then begin ab['x','x']:=kont2disk('x',exprToFloat(sT,erstesArgument(s,';'))); ab['x','y']:=kont2disk('y',exprToFloat(sT,s)); continue; end; if istDasBefehl('bis',s,bekannteBefehle,true) then begin ab['y','x']:=kont2disk('x',exprToFloat(sT,erstesArgument(s,';'))); ab['y','y']:=kont2disk('y',exprToFloat(sT,s)); continue; end; if istDasBefehl('entspringen',s,bekannteBefehle,true) then begin entspringen:=exprToFloat(sT,s); continue; end; if istDasBefehl('außerhalb ist in Ordnung',s,bekannteBefehle,false) then begin auszerhalbInOrdnung:=true; continue; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht bei Erzeugung eines Lineouts!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; until false; bekannteBefehle.free; if datei='' then begin gibAus('Keine Ausgabedatei für den Lineout angegeben!',3); exit; end; if integriere and auszerhalbInOrdnung then begin gibAus('Kann nicht integrierten Lineout erzeugen, bei dem "außerhalb ist in Ordnung" gesetzt ist!',3); exit; end; if not sT then begin assignFile(fOut,datei); rewrite(fOut); end; letzterWert:=nan; if integriere then begin if linienIntegral.schritte<>0 then begin gibAus('Ich kann einen Lineout nicht zwei Mal integrieren!',3); exit; end; if verschiebung<>0 then begin gibAus('Ich kann einen Lineout (noch) nicht gleichzeitig verschieben und integrieren!',3); exit; end; if skalierung<>'1' then begin gibAus('Ich kann einen Lineout (noch) nicht gleichzeitig skalieren und integrieren!',3); exit; end; if not sT then begin if iWaag then begin if ab['y','y']>ab['x','y'] then begin for i:=round(ab['x','y']) to round(ab['y','y']) do schreibeWertIntegriert(fOut,i,iWaag,letzterWert,entspringen); end else for i:=round(ab['x','y']) downto round(ab['y','y']) do schreibeWertIntegriert(fOut,i,iWaag,letzterWert,entspringen); end else if ab['y','x']>ab['x','x'] then begin for i:=round(ab['x','x']) to round(ab['y','x']) do schreibeWertIntegriert(fOut,i,iWaag,letzterWert,entspringen); end else for i:=round(ab['x','x']) downto round(ab['y','x']) do schreibeWertIntegriert(fOut,i,iWaag,letzterWert,entspringen); end; end else begin schritte:= round(max( abs(ab['y','y']-ab['x','y']), abs(ab['y','x']-ab['x','x']) )); if schritte=0 then begin gibAus( 'Anfangs- und Endpunkt des Lineouts sind identisch ('+tExtPointToStr(ab['x'])+' .. '+tExtPointToStr(ab['y'])+ ' - die Bildabmessungen sind '+floatToStr(_xStart)+';'+floatToStr(_tStart)+' .. '+floatToStr(_xStop)+';'+floatToStr(_tStop)+')!', 3); exit; end; if (linienIntegral.schritte<>0) and (entspringen>=0) then begin gibAus('Ich kann nicht gleichzeitig entspringen und über eine Linie integrieren (das kann unbeabsichtigte Ergebnisse haben)!',3); exit; end; if not sT then begin tmpValues:=tKnownValues.create(knownValues); for i:=0 to schritte do schreibeWert(fOut,ab['x']+(i/schritte)*(ab['y']-ab['x']),letzterWert,entspringen,verschiebung,skalierung,linienIntegral,tmpValues,auszerhalbInOrdnung); tmpValues.clear; tmpValues.free; end; end; if not sT then begin closeFile(fOut); gibAus('... fertig '+timetostr(now-Zeit),3); end; 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; p: tExtPoint; var letzterWert: extended; entspringen,verschiebung: extended; skalierung: string; linienIntegral: tLinienIntegral; tmpValues: tKnownValues; auszerhalbInOrdnung: boolean); var tmp: extended; begin tmp:=transformationen.positionAufAchseZuWert(lOben,p['x']/_xSteps,not auszerhalbInOrdnung); if auszerhalbInOrdnung and ((tmp<_xStart) or (tmp>_xStop)) then exit; tmpValues.add('x',tmp); tmp:=transformationen.positionAufAchseZuWert(lLinks,p['y']/_tSiz,not auszerhalbInOrdnung); if auszerhalbInOrdnung and ((tmp<_tStart) or (tmp>_tStop)) then exit; tmpValues.add('y',tmp); case genauigkeit of gSingle: sWerte.schreibeWert(f,round(p['x']),round(p['y']),disk2kont(p),letzterWert,entspringen,verschiebung,skalierung,tmpValues,linienIntegral,@callBackGetValue); gDouble: dWerte.schreibeWert(f,round(p['x']),round(p['y']),disk2kont(p),letzterWert,entspringen,verschiebung,skalierung,tmpValues,linienIntegral,@callBackGetValue); gExtended: eWerte.schreibeWert(f,round(p['x']),round(p['y']),disk2kont(p),letzterWert,entspringen,verschiebung,skalierung,tmpValues,linienIntegral,@callBackGetValue); 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.fuelleMitDummys(sT: boolean); var i,j: int64; begin genauigkeit:=gExtended; transformationen:=tKeineTransformation.create; transformationen.xStart:=-1; transformationen.xStop:=1; transformationen.tStart:=-1; transformationen.tStop:=1; _xSteps:=129; _tSiz:=129; transformationen.xSteps:=_xSteps; transformationen.tSiz:=_tSiz; if sT then exit; holeRAM(3); for j:=0 to _tSiz-1 do for i:=0 to _xSteps-1 do eWerte.werte[i+j*_xSteps]:= 1/(1+sqr(i-110)/9+sqr(j-110)/9) + 1/(1+sqr(i-60)/9+sqr(j-80)/9); end; procedure tWerte.verschiebe(threads: longint; richtung: tInt64Point); var einheitsZelle: tInt64Point; teilRichtung: char; verschiebeThreads: array of tVerschiebeThread; i: longint; fertig: boolean; begin while richtung['x']<0 do richtung['x']:=richtung['x'] + _xSteps; while richtung['x']>=_xSteps do richtung['x']:=richtung['x'] - _xSteps; while richtung['y']<0 do richtung['y']:=richtung['y'] + (_tSiz div (1+byte(istKomplex))); while richtung['y']>=(_tSiz div (1+byte(istKomplex))) do richtung['y']:=richtung['y'] - (_tSiz div (1+byte(istKomplex))); einheitsZelle:=berechneEinheitsZelle(richtung,int64Point(_xSteps,_tSiz div (1+byte(istKomplex)))); teilRichtung:=char(ord('x')+byte(einheitsZelle['y']>einheitsZelle['x'])); if einheitsZelle[teilRichtung]'' then begin outF:=tMyStringList.create; if fileExists(datei) then outF.loadFromFile(datei); if ueberschreiben then outF.grep('^'+escapeStringToRegex(identifizierer + separator,rtFpc),true); s:=identifizierer + separator; if indizes then s:=s+ intToStr(_zDP['x']-_xSteps*byte(toroidal and (_zDP['x']*2>=_xSteps))) + separator + intToStr(_zDP['y']-_tSiz*byte(toroidal and (_zDP['y']*2>=_tSiz))) + separator + intToStr(_xSteps) + separator + intToStr(_tSiz) + separator else s:=s+ myFloatToStr(transformationen.positionAufAchseZuWert(lUnten,_zDP['x']/_xSteps) - (_xStop-_xStart) * (1 + 1/(_xSteps-1)) * byte(toroidal and (_zDP['x']*2>=_xSteps)) ) + separator + myFloatToStr(transformationen.positionAufAchseZuWert(lLinks,_zDP['y']/_tSiz) - (_tStop-_tStart) * (1 + 1/(_tSiz-1)) * byte(toroidal and (_zDP['y']*2>=_tSiz)) ) + separator + myFloatToStr((_xStop-_xStart) * (1 + 1/(_xSteps-1))) + separator + myFloatToStr((_tStop-_tStart) * (1 + 1/(_tSiz-1))) + separator; case genauigkeit of gSingle: s:=s+ myFloatToStr(sWerte.werte[_zDP['x'] + _zDP['y']*_xSteps]); gDouble: s:=s+ myFloatToStr(dWerte.werte[_zDP['x'] + _zDP['y']*_xSteps]); gExtended: s:=s+ myFloatToStr(eWerte.werte[_zDP['x'] + _zDP['y']*_xSteps]); end{of case}; outF.add(s); outF.saveToFile(datei); end; gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.findeMaximum(sT: boolean; f: tMyStringList; threads: longint; warn: tWarnStufe): boolean; var datei,s,separator,identifizierer: string; outF: tMyStringList; xMin,xMax,tMin,tMax: longint; toroidal,indizes,ueberschreiben: boolean; Zeit: extended; bekannteBefehle: tMyStringList; begin result:=false; warteAufBeendigungDesLeseThreads; Zeit:=now; gibAus('finde Maximum ...',3); datei:=''; xMin:=0; xMax:=_xSteps-1; tMin:=0; tMax:=_tSiz-1; separator:=','; bekannteBefehle:=tMyStringList.create; toroidal:=false; indizes:=false; ueberschreiben:=false; identifizierer:=bezeichner; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende in '''+paramstr(1)+'''!',3); bekannteBefehle.free; exit; end; bekannteBefehle.clear; if istDasBefehl('Datei:',s,bekannteBefehle,true) then begin datei:=s; continue; end; if ausdehnungsParameterErkannt(sT,s,nil,bekannteBefehle,xMin,xMax,tMin,tMax) then continue; if istDasBefehl('toroidal',s,bekannteBefehle,false) then begin toroidal:=true; continue; end; if istDasBefehl('Indizes speichern',s,bekannteBefehle,false) then begin indizes:=true; continue; end; if istDasBefehl('alte Werte überschreiben',s,bekannteBefehle,false) then begin ueberschreiben:=true; continue; end; if istDasBefehl('Separator:',s,bekannteBefehle,true) then begin if s='Leerzeichen' then begin separator:=' '; continue; end; if s='Tab' then begin separator:=#9; continue; end; separator:=s; continue; end; if istDasBefehl('Identifizierer:',s,bekannteBefehle,true) then begin identifizierer:=s; continue; end; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht beim Finden eines Maximums!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; until false; bekannteBefehle.free; ermittleMinMaxDichten(sT,threads,xMin,xMax,tMin,tMax,false,warn); if sT then begin result:=true; exit; end; outF:=tMyStringList.create; if fileExists(datei) then outF.loadFromFile(datei); if ueberschreiben then outF.grep('^'+escapeStringToRegex(identifizierer + separator,rtFpc),true); s:=identifizierer + separator; if indizes then s:=s+ intToStr(_maxP['x']-_xSteps*byte(toroidal and (_maxP['x']*2>=_xSteps))) + separator + intToStr(_maxP['y']-_tSiz*byte(toroidal and (_maxP['y']*2>=_tSiz))) + separator + intToStr(_xSteps) + separator + intToStr(_tSiz) + separator else s:=s+ myFloatToStr(transformationen.positionAufAchseZuWert(lUnten,_maxP['x']/_xSteps) - (_xStop-_xStart) * (1 + 1/(_xSteps-1)) * byte(toroidal and (_maxP['x']*2>=_xSteps)) ) + separator + myFloatToStr(transformationen.positionAufAchseZuWert(lLinks,_maxP['y']/_tSiz) - (_tStop-_tStart) * (1 + 1/(_tSiz-1)) * byte(toroidal and (_maxP['y']*2>=_tSiz)) ) + separator + myFloatToStr((_xStop-_xStart) * (1 + 1/(_xSteps-1))) + separator + myFloatToStr((_tStop-_tStart) * (1 + 1/(_tSiz-1))) + separator; case genauigkeit of gSingle: s:=s+ myFloatToStr(sWerte.werte[_maxP['x'] + _maxP['y']*_xSteps]); gDouble: s:=s+ myFloatToStr(dWerte.werte[_maxP['x'] + _maxP['y']*_xSteps]); gExtended: s:=s+ myFloatToStr(eWerte.werte[_maxP['x'] + _maxP['y']*_xSteps]); end{of case}; outF.add(s); outF.saveToFile(datei); gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; 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) or (sWerte.params<>dWerte.params) then result:='!! '+result; end; function tWerte.knownValues: tKnownValues; begin case genauigkeit of gSingle: result:=sWerte.params.knownValues; gDouble: result:=sWerte.params.knownValues; gExtended: result:=sWerte.params.knownValues; end; end; procedure tWerte.beendeLeseThreadWennFertig; begin if assigned(leseThread) and leseThread.fertig then begin leseThread.free; leseThread:=nil; end; end; function tWerte.kontRand: tGeradenArray; var i: longint; begin setLength(result,4); for i:=0 to 3 do result[i]:= gerade( extPoint( byte(i in [1,2])*_xStop + byte(i in [0,3])*_xStart, byte(i in [2,3])*_tStop + byte(i in [0,1])*_tStart ), extPoint( byte(odd(i+1)), byte(odd(i)) ) ); end; function tWerte.diskRand: tGeradenArray; var i: longint; begin setLength(result,4); for i:=0 to 3 do result[i]:= gerade( extPoint( byte(i in [1,2])*(_xSteps-1), byte(i in [2,3])*(_tSiz-1) ), extPoint( byte(odd(i+1)), byte(odd(i)) ) ); end; // tZuZeichnendeKontur ********************************************************* constructor tZuZeichnendeKontur.create; begin inherited create; farbe:=rgb($00,$00,$00); deckKraft:=1; dicke:=1; kontur:=nil; leerIstInOrdnung:=false; end; constructor tZuZeichnendeKontur.create(original: tZuZeichnendeKontur; kont: tKontur); begin inherited create; farbe:=original.farbe; deckKraft:=original.deckKraft; dicke:=original.dicke; kontur:=kont; leerIstInOrdnung:=original.leerIstInOrdnung; end; destructor tZuZeichnendeKontur.destroy; begin kontur:=nil; inherited destroy; end; // tLogThread ****************************************************************** constructor tLogThread.create; begin inherited create(true); raisedException:=nil; freeonterminate:=false; fertig:=false; erfolg:=true; end; destructor tLogThread.destroy; begin raisedException.free; if (not behalteLogs) and erfolg 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:=''; fehler('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; 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 max((tMa-tMi) div 10,1) = 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 max((tMa-tMi) div 10,1) = 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 max((tMa-tMi) div 10,1) = 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); 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; procedure tQuotientThread.stExecute; begin gibAus('Quotient-Berechnungsthread gestartet ...',1); case dend.genauigkeit of gSingle: case sor.genauigkeit of gSingle: // single / single quot.eWerte.quotioent(pTLLWerteSingle(@dend.sWerte),pTLLWerteSingle(@sor.sWerte),xMi,xMa,xOf,tMi,tMa,tOf,eps); gDouble: // single / double quot.eWerte.quotioent(pTLLWerteSingle(@dend.sWerte),pTLLWerteDouble(@sor.dWerte),xMi,xMa,xOf,tMi,tMa,tOf,eps); gExtended: // single / extended quot.eWerte.quotioent(pTLLWerteSingle(@dend.sWerte),pTLLWerteExtended(@sor.eWerte),xMi,xMa,xOf,tMi,tMa,tOf,eps); end{of case}; gDouble: case sor.genauigkeit of gSingle: // double / single quot.eWerte.quotioent(pTLLWerteDouble(@dend.dWerte),pTLLWerteSingle(@sor.sWerte),xMi,xMa,xOf,tMi,tMa,tOf,eps); gDouble: // double / double quot.eWerte.quotioent(pTLLWerteDouble(@dend.dWerte),pTLLWerteDouble(@sor.dWerte),xMi,xMa,xOf,tMi,tMa,tOf,eps); gExtended: // double / extended quot.eWerte.quotioent(pTLLWerteDouble(@dend.dWerte),pTLLWerteExtended(@sor.eWerte),xMi,xMa,xOf,tMi,tMa,tOf,eps); end{of case}; gExtended: case sor.genauigkeit of gSingle: // extended / single quot.eWerte.quotioent(pTLLWerteExtended(@dend.eWerte),pTLLWerteSingle(@sor.sWerte),xMi,xMa,xOf,tMi,tMa,tOf,eps); gDouble: // extended / double quot.eWerte.quotioent(pTLLWerteExtended(@dend.eWerte),pTLLWerteDouble(@sor.dWerte),xMi,xMa,xOf,tMi,tMa,tOf,eps); gExtended: // extended / extended quot.eWerte.quotioent(pTLLWerteExtended(@dend.eWerte),pTLLWerteExtended(@sor.eWerte),xMi,xMa,xOf,tMi,tMa,tOf,eps); end{of case}; end{of Case}; gibAus('... und fertig!',1); end; // tProduktThread ************************************************************* constructor tProduktThread.create(faktor1, faktor2, produkt: tWerte; xMin,xMax,tMin,tMax,xOff,tOff: longint; datenOrdnung: tFFTDatenordnung; konjugiert: boolean); begin inherited create; f1:=faktor1; f2:=faktor2; pro:=produkt; xMi:=xMin; xMa:=xMax; tMi:=tMin; tMa:=tMax; tOf:=tOff; xOf:=xOff; daO:=datenOrdnung; konj:=konjugiert; gibAus('Starte Produkt-Berechnungsthread!',1); suspended:=false; end; procedure tProduktThread.stExecute; begin gibAus('Produkt-Berechnungsthread gestartet ...',1); case f1.genauigkeit of gSingle: case f2.genauigkeit of gSingle: // single * single pro.eWerte.produkt(pTLLWerteSingle(@f1.sWerte),pTLLWerteSingle(@f2.sWerte),xMi,xMa,xOf,tMi,tMa,tOf,konj,daO); gDouble: // single * double pro.eWerte.produkt(pTLLWerteSingle(@f1.sWerte),pTLLWerteDouble(@f2.dWerte),xMi,xMa,xOf,tMi,tMa,tOf,konj,daO); gExtended: // single * extended pro.eWerte.produkt(pTLLWerteSingle(@f1.sWerte),pTLLWerteExtended(@f2.eWerte),xMi,xMa,xOf,tMi,tMa,tOf,konj,daO); end{of case}; gDouble: case f2.genauigkeit of gSingle: // double * single pro.eWerte.produkt(pTLLWerteDouble(@f1.dWerte),pTLLWerteSingle(@f2.sWerte),xMi,xMa,xOf,tMi,tMa,tOf,konj,daO); gDouble: // double * double pro.eWerte.produkt(pTLLWerteDouble(@f1.dWerte),pTLLWerteDouble(@f2.dWerte),xMi,xMa,xOf,tMi,tMa,tOf,konj,daO); gExtended: // double * extended pro.eWerte.produkt(pTLLWerteDouble(@f1.dWerte),pTLLWerteExtended(@f2.eWerte),xMi,xMa,xOf,tMi,tMa,tOf,konj,daO); end{of case}; gExtended: case f2.genauigkeit of gSingle: // extended * single pro.eWerte.produkt(pTLLWerteExtended(@f1.eWerte),pTLLWerteSingle(@f2.sWerte),xMi,xMa,xOf,tMi,tMa,tOf,konj,daO); gDouble: // extended * double pro.eWerte.produkt(pTLLWerteExtended(@f1.eWerte),pTLLWerteDouble(@f2.dWerte),xMi,xMa,xOf,tMi,tMa,tOf,konj,daO); gExtended: // extended * extended pro.eWerte.produkt(pTLLWerteExtended(@f1.eWerte),pTLLWerteExtended(@f2.eWerte),xMi,xMa,xOf,tMi,tMa,tOf,konj,daO); end{of case}; end{of Case}; gibAus('... und fertig!',1); end; // tBilderThread *************************************************************** constructor tBilderThread.create(i,maxThreads,iBreite,iHoehe,lO,oO,rO,uO: longint; const wes: tWerteArray; xMin,xMax,tMin,tMax: longint; xZoom,yZoom: extended; modulo: boolean; nachbearbeitungen: tTransformationArray; paletten: tPalettenArray; beschri: pTBeschriftungen; rm: boolean); var ii,anzKompl: longint; begin inherited create; beschr:=beschri; nummer:=i; mT:=maxThreads; wHoehe:=iHoehe; gesBreite:=iBreite; lOf:=lO; oOf:=oO; rOf:=rO; uOf:=uO; ws:=wes; xMi:=xMin; xMa:=xMax; tMi:=tMin; tMa:=tMax; xZ:=xZoom; yZ:=yZoom; mo:=modulo; nbs:=nachbearbeitungen; setLength(pals,length(paletten)); for ii:=0 to length(pals)-1 do pals[ii]:=paletten[ii]; rahmen:=rm; xPMi:=nummer*((gesBreite+lOf+rOf) div mT)-lOf; if nummer=mT-1 then xPMa:=gesBreite+rOf-1 // der letzte Thread bekommt den Rest else xPMa:=(nummer+1)*((gesBreite+lOf+rOf) div mT)-lOf-1; breite:=xPMa-xPMi+1; wBreite:=max(0,min(gesBreite,xPMa+1)-max(0,xPMi)); // wBreite:=max(gesBreite div mT,byte(nummer=mT-1)*(gesBreite-(gesBreite div mT)*(mT-1))); // breite:=wBreite+lOf*byte(nummer=0)+rOf*byte(nummer=mT-1); hoehe:=oOf+wHoehe+uOf; gibAus('Werte: '+intToStr(xMi)+'-'+intToStr(xMa)+'x'+intToStr(tMi)+'-'+intToStr(tMa)+' ('+intToStr(wBreite)+'), Pixel: '+intToStr(xPMi)+'-'+intToStr(xPMa)+' ('+intToStr(breite)+')',1); anzKompl:=0; for ii:=0 to length(wes)-1 do anzKompl:=anzKompl+1+byte(wes[ii].istKomplex); gibAus('Thread '+intToStr(nummer)+': hole ' +intToStr(round(((sizeOf(extended)+sizeOf(longint))*anzKompl*wHoehe*wBreite+ sizeOf(tRGB)*hoehe*breite)/1024/1024))+'MB RAM ...',1); setLength(istKomplex,length(wes)); setLength(wertes,length(wes)); setLength(anzahlens,length(wes)); for ii:=0 to length(wertes)-1 do begin istKomplex[ii]:=wes[ii].istKomplex; setLength(anzahlens[ii],wHoehe*wBreite); setLength(wertes[ii],(1+byte(wes[ii].istKomplex))*length(anzahlens[ii])); end; setLength(farben,hoehe*breite); gibAus('Thread '+intToStr(nummer)+' hat jetzt seinen Speicher.',1); end; destructor tBilderThread.destroy; var ii: longint; begin setLength(farben,0); for ii:=0 to length(wertes)-1 do setLength(wertes[ii],0); setLength(wertes,0); for ii:=0 to length(anzahlens)-1 do setLength(anzahlens[ii],0); setLength(anzahlens,0); inherited destroy; end; procedure tBilderThread.stExecute; var i,j,k: longint; wert: extended; b: boolean; frb: tRGB; begin gibAus('Thread '+intToStr(nummer)+' gestartet!',1); for i:=0 to length(ws)-1 do case ws[i].genauigkeit of gSingle: if not ws[i].sWerte.zuPixelWerten(wHoehe,wBreite,xPMi,xMi,tMi,xZ,yZ,mo,@wertes[i],@anzahlens[i]) then exit; gDouble: if not ws[i].dWerte.zuPixelWerten(wHoehe,wBreite,xPMi,xMi,tMi,xZ,yZ,mo,@wertes[i],@anzahlens[i]) then exit; gExtended: if not ws[i].eWerte.zuPixelWerten(wHoehe,wBreite,xPMi,xMi,tMi,xZ,yZ,mo,@wertes[i],@anzahlens[i]) then exit; end{of case}; for i:=0 to length(wertes)-1 do for j:=0 to length(anzahlens[i])-1 do if anzahlens[i,j]=0 then begin gibAus('Thread '+intToStr(nummer)+': keine Werte in ['+intToStr(i)+'] '+intToStr(j mod wBreite)+':'+intToStr(j div wBreite)+'!',1); exit; end; gibAus('Thread '+intToStr(nummer)+': Werte -> 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); 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; procedure tDichteThread.stExecute; begin gibAus('Dichtethread gestartet!',1); case w.genauigkeit of gSingle: w.sWerte.gibMinMaxDichten(minDichte,maxDichte,minPos,maxPos,mehrereMinima,mehrereMaxima,xMin,xMax,tMin,tMax); gDouble: w.dWerte.gibMinMaxDichten(minDichte,maxDichte,minPos,maxPos,mehrereMinima,mehrereMaxima,xMin,xMax,tMin,tMax); gExtended: w.eWerte.gibMinMaxDichten(minDichte,maxDichte,minPos,maxPos,mehrereMinima,mehrereMaxima,xMin,xMax,tMin,tMax); end{of case}; gibAus('Dichtethread fertig!',1); end; // tFFTThread ****************************************************************** constructor tFFTThread.create(werte: tWerte; sMin,sMax: longint; senkrecht,invers: boolean; const vor,nach: tFFTDatenordnung; fenster: tFenster; hintergrund: tExtendedArray); var tmpFFTAlgo: tFFTAlgorithmus; halberInput: boolean; begin halberInput:=vor in [doAlleResIms,doAlleResSmi]; if senkrecht then tmpFFTAlgo:=createFFTAlgorithmus(werte._tSiz div (1+byte(halberInput)),vor,nach) else tmpFFTAlgo:=createFFTAlgorithmus(werte._xSteps,vor,nach); create(werte,sMin,sMax,senkrecht,invers,tmpFFTAlgo,fenster,hintergrund); tmpFFTAlgo.free; end; constructor tFFTThread.create(werte: tWerte; sMin,sMax: longint; senkrecht,invers: boolean; algorithmus: tFFTAlgorithmus; fenster: tFenster; hintergrund: tExtendedArray); begin inherited create; pW:=werte; sMi:=sMin; sMa:=sMax; sen:=senkrecht; inv:=invers; algo:=createFFTAlgorithmus(algorithmus); fen:=fenster; hg:=hintergrund; erfolg:=false; gibAus('FFTthread kreiert ('+intToStr(pW._xSteps)+' x '+intToStr(pW._tSiz)+': '+intToStr(sMi)+' .. '+intToStr(sMa)+'): '+algo.className,3); suspended:=false; 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,hg,pvFehler); gDouble: erfolg:=pW.dWerte.fft(sMi,sMa,sen,inv,algo,fen,hg,pvFehler); gExtended: erfolg:=pW.eWerte.fft(sMi,sMa,sen,inv,algo,fen,hg,pvFehler); end{of case}; gibAus('... und fertig! ',1); 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; 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); 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; procedure tFFT2dNBThread.stExecute; begin gibAus('FFT2d-Nachbearbeitungsthread gestartet: '+intToStr(xMin)+'-'+intToStr(xMax)+' ...',1); if pW.istKomplex then case pW.genauigkeit of gSingle: pW.sWerte.fft2dNachbearbeitungKomplex(xMin,xMax,nB); gDouble: pW.dWerte.fft2dNachbearbeitungKomplex(xMin,xMax,nB); gExtended: pW.eWerte.fft2dNachbearbeitungKomplex(xMin,xMax,nB); end{of case} else 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); end; // tFFT2dQThread *************************************************************** constructor tFFT2dQThread.create(xMi,xMa: longint; pWerte: tWerte; hComplConj,vComplConj: boolean); begin inherited create; xMin:=xMi; xMax:=xMa; pW:=pWerte; hcc:=hComplConj; vcc:=vComplConj; gibAus('FFT2d-Quadrierthread kreiert: '+intToStr(xMin)+'-'+intToStr(xMax),1); suspended:=false; end; procedure tFFT2dQThread.stExecute; begin gibAus('FFT2d-Quadrierthread gestartet: '+intToStr(xMin)+'-'+intToStr(xMax)+' ...',1); if pW.istKomplex then fehler('tFFT2dNBThread kann (noch) nicht komplex!'); case pW.genauigkeit of gSingle: pW.sWerte.fft2dQuadrierenB(xMin,xMax,hcc,vcc); gDouble: pW.dWerte.fft2dQuadrierenB(xMin,xMax,hcc,vcc); gExtended: pW.eWerte.fft2dQuadrierenB(xMin,xMax,hcc,vcc); end{of case}; gibAus('... und fertig!',1); end; // tTauschThread *************************************************************** constructor tTauschThread.create(mi,ma: longint; ve: boolean; pWerte: tWerte); begin inherited create; min:=mi; max:=ma; vertikal:=ve; pW:=pWerte; gibAus('Tauschthread kreiert: '+char(ord('x')+byte(vertikal))+' '+intToStr(min)+'-'+intToStr(max),1); suspended:=false; end; procedure tTauschThread.stExecute; begin gibAus('Tauschthread gestartet: '+char(ord('x')+byte(vertikal))+' '+intToStr(min)+'-'+intToStr(max)+' ...',1); case pW.genauigkeit of gSingle: pW.sWerte.tausche(min,max,vertikal); gDouble: pW.dWerte.tausche(min,max,vertikal); gExtended: pW.eWerte.tausche(min,max,vertikal); end{of case}; gibAus('... und fertig!',1); end; // tGauszFitThread ************************************************************* constructor tGauszFitThread.create(daten,amplituden,breiten,positionen,ueberlappe,hintergruende: tWerte; von,bis: longint; senkrecht: boolean; fensterBreite,maxBreite,maxVerschiebung: extended; positionsMitten: tExtendedArray); begin inherited create; qu:=daten; if assigned(amplituden) then ampl:=@amplituden.eWerte else ampl:=nil; if assigned(breiten) then br:=@breiten.eWerte else br:=nil; if assigned(positionen) then posi:=@positionen.eWerte else posi:=nil; if assigned(ueberlappe) then ueberl:=@ueberlappe.eWerte else ueberl:=nil; if assigned(hintergruende) then hint:=@hintergruende.eWerte else hint:=nil; vo:=von; bi:=bis; senkr:=senkrecht; fenBr:=fensterBreite; maxBr:=maxBreite; maxVersch:=maxVerschiebung; posiMitten:=positionsMitten; gibAus('GaußFitThread kreiert: '+intToStr(von)+'-'+intToStr(bis),1); suspended:=false; end; procedure tGauszFitThread.stExecute; begin gibAus('GaußFitThread gestartet ...',1); case qu.genauigkeit of gSingle: qu.sWerte.gauszFit(ampl,br,posi,ueberl,hint,vo,bi,senkr,fenBr,maxBr,maxVersch,posiMitten); gDouble: qu.dWerte.gauszFit(ampl,br,posi,ueberl,hint,vo,bi,senkr,fenBr,maxBr,maxVersch,posiMitten); gExtended: qu.eWerte.gauszFit(ampl,br,posi,ueberl,hint,vo,bi,senkr,fenBr,maxBr,maxVersch,posiMitten); end{of case}; gibAus('... und fertig',1); 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; procedure tKorrelThread.stExecute; var i,j,k,hl: longint; sus,suc,tmp,pvF: extended; in0,out0: boolean; 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); gibAus('FFT berechnen ...',1); tmpFFTAlgo:=createFFTAlgorithmus(zi._tSiz,doRes,doResIms); zi.eWerte.fft(true,false,tmpFFTAlgo,nil,nil,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,nil,nil,pvF); pvFehler:=pvF+pvFehler; case wl.typ of wtSin2: begin // Das Sin²-Wavelet besteht eigntlich aus zwei! tmpW.eWerte.fft(true,true,tmpFFTAlgo,nil,nil,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); 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; f: tMyStringList; w: pTWerteArray; mT: longint): boolean; var s,xMi,xMa,tMi,tMa,dX,dT: string; i,j,k: longint; tmp: extended; tmpPoint: tExtPoint; bekannteBefehle: tMyStringList; begin result:=false; gibAus('Kontur erzeugen ...',1); xMi:='-1e9'; xMa:='1e9'; tMi:='-1e9'; tMa:='1e9'; dX:='1'; dT:='1'; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende in '''+paramstr(1)+'''!',3); bekannteBefehle.free; exit; end; if istDasBefehl('Datei:',s,bekannteBefehle,true) then begin if length(orte)>0 then begin gibAus('Diese Kontur hat schon Werte!',3); bekannteBefehle.free; exit; end; if not liesVonDatei(sT,s,exprToFloat(sT,xMi,nil),exprToFloat(sT,xMa,nil),exprToFloat(sT,tMi,nil),exprToFloat(sT,tMa,nil)) then begin bekannteBefehle.free; exit; end; continue; end; if istDasBefehl('Werte:',s,bekannteBefehle,true) then begin if length(orte)>0 then begin gibAus('Diese Kontur hat schon Werte!',3); bekannteBefehle.free; exit; end; if not erzeugeAusWerten(sT,s,w,mT,xMi,xMa,tMi,tMa) then begin bekannteBefehle.free; exit; end; continue; end; if istDasBefehl('xMin:',s,bekannteBefehle,true) then begin xMi:=s; continue; end; if istDasBefehl('xMax:',s,bekannteBefehle,true) then begin xMa:=s; continue; end; if istDasBefehl('tMin:',s,bekannteBefehle,true) then begin tMi:=s; continue; end; if istDasBefehl('tMax:',s,bekannteBefehle,true) then begin tMa:=s; continue; end; if istDasBefehl('dX:',s,bekannteBefehle,true) then begin dX:=s; continue; end; if istDasBefehl('dY:',s,bekannteBefehle,true) or istDasBefehl('dT:',s,bekannteBefehle,true) then begin dT:=s; continue; end; if istDasBefehl('reduziere nach',s,bekannteBefehle,true) then begin if not sT then if not sortiereNachY(mT) then begin bekannteBefehle.free; exit; end; bekannteBefehle.clear; if istDasBefehl('rechts',s,bekannteBefehle,false) 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 istDasBefehl('links',s,bekannteBefehle,false) 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:=min(w^[i]._xSteps-1,max(1,w^[i].kont2disk('x',w^[i].exprToFloat(sT,_xmin)))); if _xmax='' then xMa:=w^[i]._xSteps-1 else xMa:=min(w^[i]._xSteps-1,max(1,w^[i].kont2disk('x',w^[i].exprToFloat(sT,_xmax)))); if _tmin='' then tMi:=1 else tMi:=min(w^[i]._tSiz-1,max(1,w^[i].kont2disk('t',w^[i].exprToFloat(sT,_tmin)))); if _tmax='' then tMa:=w^[i]._tSiz-1 else tMa:=min(w^[i]._tSiz-1,max(1,w^[i].kont2disk('x',w^[i].exprToFloat(sT,_tmax)))); if sT then begin result:=true; exit; end; if (tMi>=tMa) or (xMi>=xMa) then begin gibAus('Kaum Werte in '''+w^[i].bezeichner+''' um Kontur '''+bezeichner+''' daraus zu erzeugen ('+intToStr(xMi)+'-'+intToStr(xMa)+' x '+intToStr(tMi)+'-'+intToStr(tMa)+') von maximal '+intToStr(w^[i]._xSteps)+' x '+intToStr(w^[i]._tSiz),3); 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; if length(orte)=0 then begin gibAus('Fehler: erzeugte Kontur enthält keine Werte!',3); exit; 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(globaleWerte); 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 sortiereNachY(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; procedure tKontur.erzeugeAlsGerade(sT: boolean; von,bis: tExtPoint; dX,dT: extended); var i,anz: longestOrdinal; r: tExtPoint; begin if sT then begin setLength(orte,1); orte[0]:=0.5*(von+bis); exit; end; r:=von-bis; if abs(r['x']*dT) > abs(r['y']*dX) then // mehr Schritte in x-Richtung anz:=abs(round(r['x']/dX))+1 else anz:=abs(round(r['y']/dT))+1; setLength(orte,length(orte)+anz); for i:=0 to anz-1 do orte[length(orte)-1-i]:= bis + i/(anz-1) * r; end; function tKontur.sortiereNachY(mT: longint): boolean; begin result:=sortiereNachY(mT,0,length(orte)-1); end; function tKontur.sortiereNachY(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); exit; end; result:=true; exit; end; if mT<=1 then result:=sortiereNachY(mT,von,i-1) and sortiereNachY(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}; 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; 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.integriere(pTLLWerteSingle(@(qu.sWerte)),xMi,xMa,tMi,tMa,xOf,tOf,rtg); gDouble: zi.sWerte.integriere(pTLLWerteDouble(@(qu.dWerte)),xMi,xMa,tMi,tMa,xOf,tOf,rtg); gExtended: zi.sWerte.integriere(pTLLWerteExtended(@(qu.eWerte)),xMi,xMa,tMi,tMa,xOf,tOf,rtg); end{of case}; gDouble: case qu.genauigkeit of gSingle: zi.dWerte.integriere(pTLLWerteSingle(@(qu.sWerte)),xMi,xMa,tMi,tMa,xOf,tOf,rtg); gDouble: zi.dWerte.integriere(pTLLWerteDouble(@(qu.dWerte)),xMi,xMa,tMi,tMa,xOf,tOf,rtg); gExtended: zi.dWerte.integriere(pTLLWerteExtended(@(qu.eWerte)),xMi,xMa,tMi,tMa,xOf,tOf,rtg); end{of case}; gExtended: case qu.genauigkeit of gSingle: zi.eWerte.integriere(pTLLWerteSingle(@(qu.sWerte)),xMi,xMa,tMi,tMa,xOf,tOf,rtg); gDouble: zi.eWerte.integriere(pTLLWerteDouble(@(qu.dWerte)),xMi,xMa,tMi,tMa,xOf,tOf,rtg); gExtended: zi.eWerte.integriere(pTLLWerteExtended(@(qu.eWerte)),xMi,xMa,tMi,tMa,xOf,tOf,rtg); end{of case}; end{of case}; gibAus('... und fertig',1); 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; procedure tSortiereNachYThread.stExecute; begin gibAus('Sortierthread gestartet ('+intToStr(vo)+'-'+intToStr(bi)+') -> x'+intToStr(mT)+' ...',1); erfolg:=kont.sortiereNachY(mT,vo,bi); gibAus(' ... und fertig',1); end; // tBefehlThread *************************************************************** constructor tBefehlThread.create(sT: boolean; cmd: string; out erzeugungsErfolg: 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); erzeugungsErfolg:=false; exit; end; result:=erstesArgument(s,'"'); end else begin result:=shellExpand(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; end; var tokenListe: tMyStringList; s,t: string; begin if not sT then inherited create; erzeugungsErfolg:=cmd<>''; bg:=endetMit('&',cmd); tokenListe:=tMyStringList.create; while cmd<>'' do tokenListe.add(shellParseNextArg(cmd)); if not sT then p:=tProcess.create(nil); while (tokenListe.count>0) and (pos('=',tokenListe[0])>0) do begin t:=tokenListe[0]; tokenListe.delete(0); s:=erstesArgument(t,'=',false); t:=shellExpand(t); if not sT then begin if s='~PWD' then p.currentDirectory:=t else p.environment.add(s+'='+t); end; end; if not sT then begin p.options:=p.options + [poWaitOnExit]; p.executable:=tokenListe[0]; tokenListe.delete(0); p.parameters.text:=tokenListe.text; end; if not erzeugungsErfolg then begin if not sT then begin p.free; p:=nil; end; exit; end; if sT then exit; if (tokenListe.count>0) and (tokenListe.grepFirst('^$',true)='') then begin p.free; p:=nil; gibAus('Des Befehls zu expandierende Argumente hatten keine Treffer, er wird ignoriert.',3); exit; end; 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; 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)+#10+ p.executable+#10+ 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); 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; fehler('unbekannter InputDateiInfo-Typ ...'); 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); 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; 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; // tVerzerrLOThread ************************************************************ constructor tVerzerrLOThread.create(quelle,ziel: tWerte; xMin,xMax,tMin,tMax: longint; verhaeltnisHorizontal, verhaeltnisVertikal: extended); begin inherited create; qu:=quelle; zi:=ziel; xMi:=xMin; xMa:=xMax; tMi:=tMin; tMa:=tMax; verhHo:=verhaeltnisHorizontal; verhVe:=verhaeltnisVertikal; gibAus('VerzerrLOthread erzeugt: '+intToStr(xMin)+'-'+intToStr(xMax)+' '+intToStr(tMin)+'-'+intToStr(tMax),1); suspended:=false; end; procedure tVerzerrLOThread.stExecute; begin gibAus('VerzerrLOthread gestartet '+floatToStr(qu._minW)+' '+floatToStr(qu._maxW),1); case zi.genauigkeit of gSingle: case qu.genauigkeit of gSingle: zi.sWerte.kopiereLOVerzerrt(pTLLWerteSingle(@qu.sWerte),xMi,xMa,tMi,tMa,verhHo,verhVe); gDouble: zi.sWerte.kopiereLOVerzerrt(pTLLWerteDouble(@qu.dWerte),xMi,xMa,tMi,tMa,verhHo,verhVe); gExtended: zi.sWerte.kopiereLOVerzerrt(pTLLWerteExtended(@qu.eWerte),xMi,xMa,tMi,tMa,verhHo,verhVe); end{of case}; gDouble: case qu.genauigkeit of gSingle: zi.dWerte.kopiereLOVerzerrt(pTLLWerteSingle(@qu.sWerte),xMi,xMa,tMi,tMa,verhHo,verhVe); gDouble: zi.dWerte.kopiereLOVerzerrt(pTLLWerteDouble(@qu.dWerte),xMi,xMa,tMi,tMa,verhHo,verhVe); gExtended: zi.dWerte.kopiereLOVerzerrt(pTLLWerteExtended(@qu.eWerte),xMi,xMa,tMi,tMa,verhHo,verhVe); end{of case}; gExtended: case qu.genauigkeit of gSingle: zi.eWerte.kopiereLOVerzerrt(pTLLWerteSingle(@qu.sWerte),xMi,xMa,tMi,tMa,verhHo,verhVe); gDouble: zi.eWerte.kopiereLOVerzerrt(pTLLWerteDouble(@qu.dWerte),xMi,xMa,tMi,tMa,verhHo,verhVe); gExtended: zi.eWerte.kopiereLOVerzerrt(pTLLWerteExtended(@qu.eWerte),xMi,xMa,tMi,tMa,verhHo,verhVe); end{of case}; end{of case}; gibAus('VerzerrLOthread beendet',1); end; // tFensterThread ************************************************************** constructor tFensterThread.create(werte: tWerte; xMin,xMax,tMin,tMax: longint; fensterX,fensterT: tFenster; hintergrund: tExtendedArray); begin inherited create; we:=werte; xMi:=xMin; xMa:=xMax; tMi:=tMin; tMa:=tMax; xFen:=fensterX; tFen:=fensterT; hg:=hintergrund; if assigned(xFen) then if length(xFen.werte)<>werte._xSteps then xFen.berechneWerte(werte._xSteps); if assigned(tFen) then if length(tFen.werte)<>werte._tSiz then tFen.berechneWerte(werte._tSiz); gibAus('FensterThread erzeugt: '+intToStr(xMin)+'-'+intToStr(xMax)+' '+intToStr(tMin)+'-'+intToStr(tMax),1); suspended:=false; end; procedure tFensterThread.stExecute; var cleanUpX,cleanUpT: boolean; begin gibAus('FensterThread gestartet',1); cleanUpX:=not assigned(xFen); if cleanUpX then begin xFen:=tSin2Fenster.create; xFen.berechneWerte(we._xSteps); end; cleanUpT:=not assigned(tFen); if cleanUpT then begin tFen:=tSin2Fenster.create; tFen.berechneWerte(we._tSiz); end; case we.genauigkeit of gSingle: we.sWerte.fenstereWerte(xMi,xMa,tMi,tMa,xFen,tFen,hg); gDouble: we.dWerte.fenstereWerte(xMi,xMa,tMi,tMa,xFen,tFen,hg); gExtended: we.eWerte.fenstereWerte(xMi,xMa,tMi,tMa,xFen,tFen,hg); end{of case}; if cleanUpX then xFen.free; if cleanUpT then tFen.free; gibAus('FensterThread beendet',1); end; // tVerschiebeThread *********************************************************** constructor tVerschiebeThread.create(werte: tWerte; xMin,xMax,tMin,tMax: longint; richtung: tInt64Point); begin inherited create; we:=werte; xMi:=xMin; xMa:=xMax; tMi:=tMin; tMa:=tMax; rtg:=richtung; gibAus('VerschiebeThread erzeugt: '+intToStr(xMin)+'-'+intToStr(xMax)+' '+intToStr(tMin)+'-'+intToStr(tMax)+' '+tInt64PointToStr(richtung)+' '+intToStr(byte(we.istKomplex)),1); suspended:=false; end; procedure tVerschiebeThread.stExecute; begin gibAus('VerschiebeThread gestartet',1); case we.genauigkeit of gSingle: we.sWerte.verschiebe(rtg,xMi,xMa,tMi,tMa); gDouble: we.dWerte.verschiebe(rtg,xMi,xMa,tMi,tMa); gExtended: we.eWerte.verschiebe(rtg,xMi,xMa,tMi,tMa); end{of case}; gibAus('VerschiebeThread beendet',1); end; // tPhasenWinkelThread ********************************************************* constructor tPhasenWinkelThread.create(werte: tWerte; xMin,xMax: longint); begin inherited create; we:=werte; xMi:=xMin; xMa:=xMax; gibAus('PhasenWinkelThread erzeugt: '+intToStr(xMin)+'-'+intToStr(xMax),1); suspended:=false; end; procedure tPhasenWinkelThread.stExecute; begin gibAus('PhasenWinkelThread gestartet',1); case we.genauigkeit of gSingle: we.sWerte.ermittlePhasenWinkel(xMi,xMa); gDouble: we.dWerte.ermittlePhasenWinkel(xMi,xMa); gExtended: we.eWerte.ermittlePhasenWinkel(xMi,xMa); end{of case}; gibAus('PhasenWinkelThread beendet',1); end; // tEntspringThread ************************************************************ constructor tEntspringThread.create(werte: tWerte; min,max: longint; entspringModus: tEntspringModus); begin inherited create; we:=werte; mi:=min; ma:=max; em:=entspringModus; gibAus('EntspringThread erzeugt: '+intToStr(mi)+'-'+intToStr(ma)+' '+tEntspringModusToStr(em),1); suspended:=false; end; procedure tEntspringThread.stExecute; begin gibAus('EntspringThread gestartet',1); case we.genauigkeit of gSingle: we.sWerte.entspringe(mi,ma,em); gDouble: we.dWerte.entspringe(mi,ma,em); gExtended: we.eWerte.entspringe(mi,ma,em); end{of case}; gibAus('EntspringThread beendet',1); end; // tKomplexMachThread ********************************************************** constructor tKomplexMachThread.create(werte: tWerte; xMin,xMax: longint; komplexMachModus: tKomplexMachModus; randomSeed: longword); begin inherited create; we:=werte; xMi:=xMin; xMa:=xMax; kmm:=komplexMachModus; mT:=tMersenneTwister.create; mT.init(randomSeed); gibAus('KomplexMachThread erzeugt: '+intToStr(xMin)+'-'+intToStr(xMax),1); suspended:=false; end; procedure tKomplexMachThread.stExecute; begin gibAus('KomplexMachThread gestartet',1); case we.genauigkeit of gSingle: we.sWerte.macheKomplex(xMi,xMa,kmm,mT); gDouble: we.dWerte.macheKomplex(xMi,xMa,kmm,mT); gExtended: we.eWerte.macheKomplex(xMi,xMa,kmm,mT); end{of case}; gibAus('KomplexMachThread beendet',1); end; // tHintergrungIntegrationsThread ********************************************** constructor tHintergrungIntegrationsThread.create(werte: tWerte; xMin,xMax,tMin,tMax,tRand: longint; hintergrund: pTExtendedArray); begin inherited create; we:=werte; xMi:=xMin; xMa:=xMax; tMi:=tMin; tMa:=tMax; tRa:=tRand; hg:=hintergrund; suspended:=false; gibAus('HintergrungIntegrationsThread erzeugt: '+intToStr(xMin)+'-'+intToStr(xMax)+' '+intToStr(tMin)+'-'+intToStr(tMax)+' ('+intToStr(tRand)+')',1); end; procedure tHintergrungIntegrationsThread.stExecute; begin gibAus('HintergrungIntegrationsThread gestartet',1); case we.genauigkeit of gSingle: if tRa>0 then we.sWerte.integriereVertikalMitRand(xMi,xMa,tMi,tMa,tRa,hg) else we.sWerte.integriereVertikal(xMi,xMa,tMi,tMa,hg); gDouble: if tRa>0 then we.dWerte.integriereVertikalMitRand(xMi,xMa,tMi,tMa,tRa,hg) else we.dWerte.integriereVertikal(xMi,xMa,tMi,tMa,hg); gExtended: if tRa>0 then we.eWerte.integriereVertikalMitRand(xMi,xMa,tMi,tMa,tRa,hg) else we.eWerte.integriereVertikal(xMi,xMa,tMi,tMa,hg); end{of case}; gibAus('HintergrungIntegrationsThread beendet',1); end; // tKantenExtraktionsThread **************************************************** constructor tKantenExtraktionsThread.create(werte: tWerte; xMin,xMax,tMin,tMax: longint; vertikal: boolean; exponent: int64); begin inherited create; we:=werte; xMi:=xMin; xMa:=xMax; tMi:=tMin; tMa:=tMax; vert:=vertikal; expo:=exponent; suspended:=false; gibAus('KantenExtraktionsThread erzeugt: '+intToStr(xMin)+'-'+intToStr(xMax)+' '+intToStr(tMin)+'-'+intToStr(tMax),1); end; procedure tKantenExtraktionsThread.stExecute; begin gibAus('KantenExtraktionsThread gestartet',1); case we.genauigkeit of gSingle: we.sWerte.extrahiereKanten(xMi,xMa,tMi,tMa,vert,expo); gDouble: we.dWerte.extrahiereKanten(xMi,xMa,tMi,tMa,vert,expo); gExtended: we.eWerte.extrahiereKanten(xMi,xMa,tMi,tMa,vert,expo); end{of case}; gibAus('KantenExtraktionsThread beendet',1); end; // tSkalierungsThread ********************************************************** constructor tSkalierungsThread.create(werte: tWerte; tMin,tMax: longint; skalierung: string); begin inherited create; we:=werte; tMi:=tMin; tMa:=tMax; skal:=skalierung; kvs:=tKnownValues.create(we.knownValues); suspended:=false; gibAus('SkalierungsThread erzeugt: '+intToStr(tMi)+'-'+intToStr(tMa)+' '''+skal+'''',1); end; destructor tSkalierungsThread.destroy; begin kvs.clear; kvs.free; inherited destroy; end; procedure tSkalierungsThread.stExecute; begin gibAus('SkalierungsThread gestartet',1); case we.genauigkeit of gSingle: we.sWerte.skaliere(tMi,tMa,skal,we.transformationen,kvs,@we.callBackGetValue); gDouble: we.dWerte.skaliere(tMi,tMa,skal,we.transformationen,kvs,@we.callBackGetValue); gExtended: we.eWerte.skaliere(tMi,tMa,skal,we.transformationen,kvs,@we.callBackGetValue); end{of case}; gibAus('SkalierungsThread beendet',1); end; // tRadonTransformationsLineOutThread ****************************************** constructor tRadonTransformationsLineOutThread.create(quelle,ziel: tWerte; xMin,xMax: longint); begin inherited create; qu:=quelle; zi:=ziel; xMi:=xMin; xMa:=xMax; suspended:=false; gibAus('RadonTransformationsLineOutThread erzeugt: '+intToStr(xMi)+'-'+intToStr(xMa),1); end; procedure tRadonTransformationsLineOutThread.stExecute; begin gibAus('RadonTransformationsLineOutThread gestartet',1); case zi.genauigkeit of gSingle: case qu.genauigkeit of gSingle: zi.sWerte.radonTransformationsLineOut(xMi,xMa,pTLLWerteSingle(@qu.sWerte)); gDouble: zi.sWerte.radonTransformationsLineOut(xMi,xMa,pTLLWerteDouble(@qu.dWerte)); gExtended: zi.sWerte.radonTransformationsLineOut(xMi,xMa,pTLLWerteExtended(@qu.eWerte)); end{of case}; gDouble: case qu.genauigkeit of gSingle: zi.dWerte.radonTransformationsLineOut(xMi,xMa,pTLLWerteSingle(@qu.sWerte)); gDouble: zi.dWerte.radonTransformationsLineOut(xMi,xMa,pTLLWerteDouble(@qu.dWerte)); gExtended: zi.dWerte.radonTransformationsLineOut(xMi,xMa,pTLLWerteExtended(@qu.eWerte)); end{of case}; gExtended: case qu.genauigkeit of gSingle: zi.eWerte.radonTransformationsLineOut(xMi,xMa,pTLLWerteSingle(@qu.sWerte)); gDouble: zi.eWerte.radonTransformationsLineOut(xMi,xMa,pTLLWerteDouble(@qu.dWerte)); gExtended: zi.eWerte.radonTransformationsLineOut(xMi,xMa,pTLLWerteExtended(@qu.eWerte)); end{of case}; end{of case}; gibAus('RadonTransformationsLineOutThread beendet',1); end; // sonstiges ******************************************************************* function findePalette(out palette: tPalette; name: string): boolean; var i: longint; begin result:=true; for i:=0 to length(allePaletten)-1 do if allePaletten[i].name=name then begin palette:=allePaletten[i]; exit; end; palette:=nil; result:=false; end; function dumpPalettenNamen: string; var i: longint; begin result:=''; for i:=0 to length(allePaletten)-1 do result:=result+#10''''+allePaletten[i].name+''''; delete(result,1,1); end; procedure exportiereAchsen(achsenDatei: string; achsen: t2x2Extended; breite, hoehe: int64); var achsenDateiHandle: textFile; c: char; begin assignFile(achsenDateiHandle,achsenDatei); rewrite(achsenDateiHandle); for c:=char(ord('x')+byte(breite<=0)) to char(ord('y')-byte(hoehe<=0)) do begin writeln(achsenDateiHandle,c+'Start = '+myFloatToStr(achsen[c,'x'])); writeln(achsenDateiHandle,c+'Stopp = '+myFloatToStr(achsen[c,'y'])); end; if breite>0 then writeln(achsenDateiHandle,'xSteps = '+intToStr(breite)); if hoehe>0 then writeln(achsenDateiHandle,'ySteps = '+intToStr(hoehe)); closeFile(achsenDateiHandle); end; function erzeugeLegende(sT: boolean; f: tMyStringList; datei: string; qu: tWerte; minDichte,maxDichte: extended; nB: tTransformation; pal: tPalette): boolean; var s,achsenDatei: 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; bekannteBefehle: tMyStringList; begin result:=false; achsenDatei:=''; 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; bekannteBefehle:=tMyStringList.create; fontRenderer:=nil; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende in '''+paramstr(1)+'''!',3); bekannteBefehle.free; exit; end; bekannteBefehle.clear; if istDasBefehl('Ausrichtung:',s,bekannteBefehle,true) then begin waagerecht:=s='waagerecht'; if (s='waagerecht') or (s='senkrecht') then continue; gibAus(''''+s+''' ist keine gültige Ausrichtung!'#10'Ich kenne:'#10'''senkrecht'''#10'''waagerecht''',3); exit; end; if istDasBefehl('Breite:',s,bekannteBefehle,true) then begin breite:=strToInt(s); continue; end; if istDasBefehl('Höhe:',s,bekannteBefehle,true) then begin hoehe:=strToInt(s); continue; end; if istDasBefehl('Schriftgröße:',s,bekannteBefehle,true) then begin schriftgroesze:=strToInt(s); continue; end; if istDasBefehl('Farbe linear',s,bekannteBefehle,false) then begin lineareFarbe:=true; continue; end; if istDasBefehl('Werte linear',s,bekannteBefehle,false) then begin lineareFarbe:=false; continue; end; if istDasBefehl('Rahmen',s,bekannteBefehle,false) then begin rahmen:=true; continue; end; if istDasBefehl('keine Beschriftung',s,bekannteBefehle,false) then begin setLength(beschriftungsschritte,0); continue; end; if istDasBefehl('Beschriftung exportieren nach:',s,bekannteBefehle,true) then begin achsenDatei:=s; continue; end; if istDasBefehl('Beschriftungen:',s,bekannteBefehle,false) 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); bekannteBefehle.free; 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); bekannteBefehle.free; 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 istDasBefehl('Ende',s,bekannteBefehle,false) then break; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht bei Erzeugund der Legende!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; until false; bekannteBefehle.free; if sT then begin result:=true; exit; end; if length(beschriftungsschritte)>0 then begin 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 tmp'' then begin if waagerecht then exportiereAchsen(achsenDatei,_2x2Extended(minDichte,maxDichte,0,hoehe-1),breite,hoehe) else exportiereAchsen(achsenDatei,_2x2Extended(0,breite-1,minDichte,maxDichte),breite,hoehe); end; if lineareFarbe then for i:=0 to length(beschriftungen)-1 do beschriftungen[i].position:=nB.transformiereWert(beschriftungen[i].position); for i:=0 to length(beschriftungen)-1 do beschriftungen[i].position:=beschriftungen[i].position*(hoehe+byte(waagerecht)*(breite-hoehe)); lO:=byte(rahmen); rO:=byte(rahmen); oO:=byte(rahmen); uO:=byte(rahmen); for i:=0 to length(beschriftungen)-1 do begin lO:=max(lO,-beschriftungen[i].links); rO:=max(rO,1+beschriftungen[i].rechts-breite); oO:=max(oO,-beschriftungen[i].oben); uO:=max(uO,1+beschriftungen[i].unten-hoehe); end; if lO+oO+rO+uO>0 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]:=pal.wertZuFarbe(wert); 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 (inil then fontRenderer.free; result:=true; end; function findeWerte(s: string; f: tMyStringList; pws: pTWerteArray; kont: pTKonturenArray; darfErstellen: boolean): integer; var i: integer; istZahl: boolean; begin s:=trimAll(s); result:=length(pws^)*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(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 Kontur '''+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(f: tMyStringList): boolean; var s,name: string; palette,nPalette: tPalette; imPart: boolean; begin result:=false; palette:=tPalette.create; nPalette:=nil; name:=''; imPart:=false; 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; if startetMit('Imaginärteile:',s) then begin if imPart then begin gibAus('Ich hatte schon Imaginärteile für diese Palette gelesen!',3); exit; end; imPart:=true; continue; end; if palette.neuerWert(s,imPart) 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.farben[false])<2 then begin gibAus('Zu wenige Farben in der Palette '''+name+''', nämlich nur '+intToStr(length(palette.farben[false])),3); exit; end; if nPalette=nil then begin setLength(allePaletten,length(allePaletten)+1); allePaletten[length(allePaletten)-1]:=tPalette.create; nPalette:=allePaletten[length(allePaletten)-1]; end else gibAus('Überschreibe bereits vorhandene Palette '''+nPalette.name+'''.',3); nPalette.kopiereVon(palette); nPalette.name:=name; palette.free; 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 warteAufExterneBefehle; 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; function ermittleAnstieg(sT: boolean; s: string): boolean; var i,j: longint; name,datei: string; wert: extended; begin result:=false; name:=erstesArgument(s); if not startetMit('aus ',s) then begin gibAus('Syntaxfehler, erwarte: ''ermittle Anstieg $name aus $datei [1.Spalte,2.Spalte]''.',3); exit; end; datei:=erstesArgument(s); if not fileExists(datei) then begin gibAus('Datei '''+datei+''' existiert nicht um Werte für Anstiegsermittlung zu lesen!',3); exit; end; if s<>'' then begin if not startetMit('[',s) then begin gibAus('Syntaxfehler, erwarte: ''ermittle Anstieg $name aus $datei [1.Spalte,2.Spalte]''.',3); exit; end; i:=strToInt(erstesArgument(s,',')); j:=strToInt(erstesArgument(s,']')); if s<>'' then begin gibAus('Syntaxfehler, erwarte: ''ermittle Anstieg $name aus $datei [1.Spalte,2.Spalte]''.',3); exit; end; end else begin i:=0; j:=1; end; if sT then begin // Wir brauchen einen sinnvollen Wert zum Syntaxtest, aber dann müssen wir // ihn später nicht noch einmal berechnen. wert:=matheunit.ermittleAnstieg(shellExpand(datei),i,j); globaleWerte.add(name,wert); end; result:=true; end; function ermittleMittelwert(sT: boolean; s: string): boolean; var i,j: longint; name,datei: string; wert: extended; begin result:=false; name:=erstesArgument(s); if not startetMit('aus ',s) then begin gibAus('Syntaxfehler, erwarte: ''ermittle Mittelwert $name aus $datei [Wertespalte [Gewichtespalte]]''.',3); exit; end; datei:=erstesArgument(s); if not fileExists(datei) then begin gibAus('Datei '''+datei+''' existiert nicht um Werte für Mittelwertermittlung zu lesen!',3); exit; end; try if s='' then i:=0 else i:=strToInt(erstesArgument(s)); if s='' then j:=-1 else j:=strToInt(s); except gibAus('Syntaxfehler, erwarte: ''ermittle Mittelwert $name aus $datei [Wertespalte [Gewichtespalte]]''.',3); exit; end; if sT then begin // Wir brauchen einen sinnvollen Wert zum Syntaxtest, aber dann müssen wir // ihn später nicht noch einmal berechnen. wert:=matheunit.ermittleMittelwert(shellExpand(datei),i,j); globaleWerte.add(name,wert); end; result:=true; end; function liesWert(sT: boolean; s: string): boolean; var i: longint; name,datei: string; wert: extended; sl: tMyStringList; begin result:=false; name:=erstesArgument(s); if not startetMit('aus ',s) then begin gibAus('Syntaxfehler, erwarte: ''lies Wert $name aus $datei $spalte $identifikation''.',3); exit; end; datei:=erstesArgument(s); if not fileExists(datei) then begin gibAus('Datei '''+datei+''' existiert nicht um Wert zu lesen!',3); exit; end; try i:=strToInt(erstesArgument(s)); except gibAus('Syntaxfehler, erwarte: ''lies Wert $name aus $datei $spalte $identifikation''.',3); exit; end; if sT then begin // Wir brauchen einen sinnvollen Wert zum Syntaxtest, aber dann müssen wir // ihn später nicht noch einmal einlesen. sl:=tMyStringList.create; sl.loadFromFile(datei); sl.grep('^'+escapeStringToRegex(s+',',rtFpc)); if sl.count<>1 then begin gibAus('Datei '''+datei+''' beinhaltet Zeile mit Identifikation '''+s+''' nicht genau ein Mal, sondern '+intToStr(sl.count)+' Mal.',3); exit; end; s:=sl[0]; while i>0 do begin erstesArgument(s,','); dec(i); end; wert:=strToFloat(erstesArgument(s,',')); globaleWerte.add(name,wert); sl.free; end; result:=true; end; var i: longint; initialization fileMode := fmOpenRead; globaleWerte:=tKnownValues.create(nil); setLength(externeBefehle,0); setLength(allePaletten,10); for i:=0 to length(allePaletten)-1 do allePaletten[i]:=tPalette.create; allePaletten[0].name:='Graustufen'; allePaletten[0].neuerWert(rgb($ff,$ff,$ff),false); allePaletten[0].neuerWert(rgb($00,$00,$00),false); allePaletten[1].name:='invertierte Graustufen'; allePaletten[1].neuerWert(rgb($00,$00,$00),false); allePaletten[1].neuerWert(rgb($ff,$ff,$ff),false); allePaletten[2].name:='Regenbogen'; allePaletten[2].neuerWert(rgb($00,$00,$ff),false); allePaletten[2].neuerWert(rgb($00,$ff,$ff),false); allePaletten[2].neuerWert(rgb($00,$ff,$00),false); allePaletten[2].neuerWert(rgb($ff,$ff,$00),false); allePaletten[2].neuerWert(rgb($ff,$00,$00),false); allePaletten[2].neuerWert(rgb($00,$00,$00),false); allePaletten[3].name:='invertierter Regenbogen'; allePaletten[3].neuerWert(rgb($00,$00,$00),false); allePaletten[3].neuerWert(rgb($ff,$00,$00),false); allePaletten[3].neuerWert(rgb($ff,$ff,$00),false); allePaletten[3].neuerWert(rgb($00,$ff,$00),false); allePaletten[3].neuerWert(rgb($00,$ff,$ff),false); allePaletten[3].neuerWert(rgb($00,$00,$ff),false); allePaletten[4].name:='Jet-Regenbogen'; allePaletten[4].neuerWert(rgb($ff,$00,$00),false); allePaletten[4].neuerWert(rgb($ff,$ff,$00),false); allePaletten[4].neuerWert(rgb($00,$ff,$00),false); allePaletten[4].neuerWert(rgb($00,$ff,$ff),false); allePaletten[4].neuerWert(rgb($00,$00,$ff),false); allePaletten[5].name:='erweiterter Regenbogen'; allePaletten[5].neuerWert(rgb($ff,$ff,$ff),false); allePaletten[5].neuerWert(rgb($00,$00,$ff),false); allePaletten[5].neuerWert(rgb($00,$ff,$ff),false); allePaletten[5].neuerWert(rgb($00,$ff,$00),false); allePaletten[5].neuerWert(rgb($ff,$ff,$00),false); allePaletten[5].neuerWert(rgb($ff,$00,$00),false); allePaletten[5].neuerWert(rgb($ff,$00,$ff),false); allePaletten[5].neuerWert(rgb($00,$00,$00),false); allePaletten[6].name:='komplexer Martin'; allePaletten[6].neuerWert(rgb($00,$00,$ff),false); allePaletten[6].neuerWert(rgb($ff,$00,$00),false); allePaletten[6].neuerWert(rgb($00,$ff,$00),true); allePaletten[6].neuerWert(rgb($00,$00,$00),true); allePaletten[7].name:='invertierter komplexer Martin'; allePaletten[7].neuerWert(rgb($ff,$00,$00),false); allePaletten[7].neuerWert(rgb($00,$00,$ff),false); allePaletten[7].neuerWert(rgb($00,$00,$00),true); allePaletten[7].neuerWert(rgb($00,$ff,$00),true); allePaletten[8].name:='zyklischer Regenbogen'; allePaletten[8].neuerWert(rgb($00,$00,$ff),false); allePaletten[8].neuerWert(rgb($00,$ff,$ff),false); allePaletten[8].neuerWert(rgb($00,$ff,$00),false); allePaletten[8].neuerWert(rgb($ff,$ff,$00),false); allePaletten[8].neuerWert(rgb($ff,$00,$00),false); allePaletten[8].neuerWert(rgb($ff,$00,$ff),false); allePaletten[8].neuerWert(rgb($00,$00,$ff),false); allePaletten[9].name:='rotblau'; allePaletten[9].neuerWert(rgb($00,$00,$ff),false); allePaletten[9].neuerWert(rgb($ff,$ff,$ff),false); allePaletten[9].neuerWert(rgb($ff,$00,$00),false); finalization globaleWerte.free; for i:=0 to length(allePaletten)-1 do allePaletten[i].free; setLength(allePaletten,0); end.