unit typenunit; {$mode objfpc}{$H+} interface uses sysutils, agg_2D, FPimage, agg_basics, classes, math, mystringlistunit, lowlevelunit, matheunit; const speicherHappen = 32768; // Anzahl an mit einem Mal zu reservierender Arrayzellen myInf = 1e12; feldGroeszenNamen: array[0..9] of string = ('FP','FM','GP','GM','EX','DENS_E','DENS_I','JX','JY','JZ'); // verbosity: longint = 0; type tExtraInfos = class; tGausz2dParameter = record xx,yy,x0,y0,a,e: extended; // exp ( -(xx^2 * cos(a)^2 + yy^2 * sin(a)^2) * (X-x0)^2 - (yy^2 * cos(a)^2 + xx^2 * sin(a)^2) * (Y-y0)^2 + 2(xx^2 - yy^2) * cos(a)sin(a) * (X-x0) * (Y-y0) + e) end; tGausz2dParameterArray = array of tGausz2dParameter; tKomplexMachModus = (kmmReNull,kmmImNull,kmmPhZuf); tLowLevelHintergrundAbzugsArt = (haaKeine,haaRandDurchschnitt,haaRandMinimum,haaRandPerzentil,haaMinimum,haaVertikaleMittel,haaVertikaleMedianMittel); tHintergrundAbzugsArt = record art: tLowLevelHintergrundAbzugsArt; parameter: tExtendedArray; end; tIntegrationsRichtung = (irHorizontal,irEinfall,irAusfall); tLowLevelEntspringModus = (emKein,emHorizontal,emVertikal); tEntspringModus = record modus: tLowLevelEntspringModus; parameter: tExtendedArray; end; tGenerischeInputDateiInfo = class // nur zum Vererben gedacht, nie selbst instanziieren! name,fehlerBehebungsKommando: string; gamma,groeszenFaktor, tStart,tStop,xStart,xStop: extended; genauigkeit: tGenauigkeit; xSteps,tSiz,t0Abs: longint; params: tExtraInfos; constructor create(vorlage: tGenerischeInputDateiInfo); overload; constructor create; overload; destructor destroy; override; function xMin: longint; function xMax: longint; function tMin: longint; function tMax: longint; function dumpParams: string; dynamic; end; tPhaseSpaceInputDateiInfo = class (tGenerischeInputDateiInfo) constructor create(vorlage: tGenerischeInputDateiInfo); overload; constructor create; overload; destructor destroy; override; end; tSpaceTimeInputDateiInfo = class (tGenerischeInputDateiInfo) constructor create(vorlage: tGenerischeInputDateiInfo); overload; constructor create; overload; destructor destroy; override; end; tTraceInputDateiInfo = class (tGenerischeInputDateiInfo) spurNummer,feldNummer: longint; constructor create(vorlage: tGenerischeInputDateiInfo); overload; constructor create; overload; destructor destroy; override; function dumpParams: string; override; end; tSergeyInputDateiInfo = class (tGenerischeInputDateiInfo) feldNummer: longint; constructor create(vorlage: tGenerischeInputDateiInfo); overload; constructor create; overload; destructor destroy; override; function dumpParams: string; override; end; tPipeInputDateiInfo = class (tGenerischeInputDateiInfo) analysator: string; bytesPerSample: longint; Kodierung: tKodierung; constructor create(vorlage: tGenerischeInputDateiInfo); overload; constructor create; overload; destructor destroy; override; function executable: string; function parametersText: string; function analysatorExecutable: string; function analysatorParametersText: string; function dumpParams: string; override; end; tAndorInputDateiInfo = class (tGenerischeInputDateiInfo) temperatur,belichtungsZeit, zyklusZeit,akkumulierteZyklusZeit, zyklusStapelZeit,pixelAusleseZeit, verstaerkungADW: extended; akkumulierteZyklen,datenStart, hintergrundStart: int64; detektorTyp,dateiName,xAchsenTitel, yAchsenTitel,datenTypTitel: string; detektorGroesze,bildBereichStapel, rahmenToepfe: tIntPoint; bildBereich,rahmenBereich: t2x2Longint; shutterZeit: tExtPoint; xAchse: array[0..2] of extended; hatHintergrund,istHintergrund: boolean; constructor create(vorlage: tGenerischeInputDateiInfo); overload; constructor create; overload; destructor destroy; override; function detectorSkipLines: int64; function detectorSkipLines2: int64; procedure berechneXStop; // aus xStart, xSteps und xAchse[0..2]; function dumpParams: string; override; end; tGenerischeInputDateiInfoArray = specialize tArray; tInputDateiInfoVorlagen = class private _name,_fehlerBehebungsKommando: string; _gamma,_groeszenFaktor, _tStart,_tStop,_xStart,_xStop: extended; _genauigkeit: tGenauigkeit; _tSiz,_xSteps,_spurNummer,_t0abs, _bytesPerSample,_feldNummer: longint; _analysator: string; _Kodierung: tKodierung; _istHintergrung: boolean; _params: tExtraInfos; procedure wFehlerbehebungskommando(f: string); procedure wName(n: string); procedure wGamma(g: extended); procedure wTStart(t: extended); procedure wTStop(t: extended); procedure wXStart(x: extended); procedure wXStop(x: extended); procedure wGroeszenFaktor(g: extended); procedure wGenauigkeit(g: tGenauigkeit); procedure wTSiz(t: longint); procedure wXSteps(x: longint); procedure wT0Abs(t: longint); procedure wSpurNummer(s: longint); procedure wFeldNummer(f: longint); procedure wAnalysator(a: string); procedure wBytesPerSample(b: longint); procedure wKodierung(k: tKodierung); procedure wIstHintergrund(ih: boolean); procedure wParams(p: tExtraInfos); public phaseSpaceVorlage: tPhaseSpaceInputDateiInfo; spaceTimeVorlage: tSpaceTimeInputDateiInfo; traceVorlage: tTraceInputDateiInfo; sergeyVorlage: tSergeyInputDateiInfo; pipeVorlage: tPipeInputDateiInfo; andorVorlage: tAndorInputDateiInfo; property fehlerBehebungsKommando: string read _fehlerBehebungsKommando write wFehlerbehebungskommando; property name: string read _name write wName; property gamma: extended read _gamma write wGamma; property tStart: extended read _tStart write wTStart; property tStop: extended read _tStop write wTStop; property xStart: extended read _xStart write wXStart; property xStop: extended read _xStop write wXStop; property t0Abs: longint read _t0abs write wT0Abs; property groeszenFaktor: extended read _groeszenFaktor write wGroeszenFaktor; property genauigkeit: tGenauigkeit read _genauigkeit write wGenauigkeit; property spurNummer: longint read _spurNummer write wSpurNummer; property feldNummer: longint read _feldNummer write wFeldNummer; property analysator: string read _analysator write wAnalysator; property bytesPerSample: longint read _bytesPerSample write wBytesPerSample; property tSiz: longint read _tSiz write wTSiz; property xSteps: longint read _xSteps write wXSteps; property Kodierung: tKodierung read _Kodierung write wKodierung; property istHintergrund: boolean read _istHintergrung write wIstHintergrund; property params: tExtraInfos read _params write wParams; function genauigkeitFromStr(s: string): boolean; function fehlerBehebungsProgramm: string; function fehlerBehebungsParameter: string; constructor create; destructor destroy; override; end; tLLBild = record farben: tRGBArray; breite, hoehe: longint; end; tFontRenderer = class private agg: agg2D_ptr; public constructor create(schriftgroesze: longint); destructor destroy; override; function rendere(s: string): tLLBild; end; pTBeschriftungen = ^tBeschriftungen; tLage = (lLinks,lOben,lRechts,lUnten); tFenster = class procedure testeFensterDurchschnitt(schlussBeiWenigInhalt: boolean); public aktiv,invers: boolean; werte: tExtendedArray; constructor create; destructor destroy; override; procedure berechneWerte(anzWerte: longint; schlussBeiWenigInhalt: boolean = false); virtual; abstract; overload; function dumpParams: string; dynamic; end; tSin2Fenster = class(tFenster) breite,rand: longint; constructor create; procedure berechneWerte(anzWerte: longint; schlussBeiWenigInhalt: boolean = false); override; overload; function dumpParams: string; override; end; tGauszFenster = class(tFenster) breite: extended; constructor create; procedure berechneWerte(anzWerte: longint; schlussBeiWenigInhalt: boolean = false); override; overload; function dumpParams: string; override; end; tVerlaufTeilFenster = class(tFenster) eps,tMin,tMax,tRand: extended; constructor create; constructor create(verlauf: tHintergrundAbzugsArt; epsilon: extended); procedure berechneWerte(anzWerte: longint; schlussBeiWenigInhalt: boolean = false); override; overload; function dumpParams: string; override; end; tBeschriftung = class private _inhalt: string; procedure wInhalt(s: string); public lage: tLage; fontRend: tFontRenderer; bBreite,bHoehe: longint; rahmen: boolean; position: extended; bild: tLLBild; property inhalt: string read _inhalt write wInhalt; constructor create; destructor destroy; override; function strich: longint; function links: longint; function oben: longint; function rechts: longint; function unten: longint; end; tBeschriftungen = array of tBeschriftung; tWaveletTyp = (wtSin2,wtFrequenzfenster); tTransformation = class; tExtraInfos = class private _transformationen: tTransformation; procedure wTransformationen(tr: tTransformation); public maxW,minW,np,beta: extended; maxP,minP,zDP: tInt64Point; tSiz,xSteps,tSiz_,xSteps_: longint; istKomplex: boolean; knownValues: tKnownValues; constructor create(globaleWerte: tKnownValues); overload; constructor create(original: tExtraInfos); destructor destroy; override; function xStart: extended; function xStop: extended; function tStart: extended; function tStop: extended; procedure refreshKnownValues; property transformationen: tTransformation read _transformationen write wTransformationen; end; tTransformationArray = array of tTransformation; tTransformation = class // eine generische Transformation von Werten oder Koordinaten // selbst nicht zum Instanziieren gedacht private vorgaenger,nachfolger: tTransformationArray; inXSTS,outXSTS: tIntPoint; inAchsen,outAchsen: t2x2Extended; inWMia,outWMia: tExtPoint; inPMia,outPMia: t2x2Int64; inZDP,outZDP: tInt64Point; wmiaExplizit: boolean; // wMia wurde explizit gesetzt _anzZugehoerigerDaten: longint; procedure testeAuszerhalb(input, koordinaten: boolean; p: tExtPoint); overload; inline; procedure testeAuszerhalb(input, koordinaten: boolean; l: tLage; x: extended); overload; inline; procedure holeInfosVonVorgaengern; virtual; procedure aktualisiereAchsen; virtual; procedure aktualisiereXsTs; virtual; procedure aktualisiereWmia; virtual; function transformiereKoordinatenEinzeln(const p: tExtPoint; auszerhalbIstFehler: boolean = true): tExtPoint; virtual; // wie ändert sich die Position eines Punktes (Paradebeispiel: bei Spiegelung: x -> xSteps-1-x) // ist für p veranwortlich? function transformiereKoordinatenEinzelnInvers(const p: tExtPoint; auszerhalbIstFehler: boolean = true): tExtPoint; virtual; // und die inverse Funktion function transformiereAchseEinzeln(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; virtual; // wie ändert sich der Wert der Achse bei der Transformation (Paradebeispiel: bei lambdaZuOmega: x -> 2*pi*c/x) function transformiereAchseEinzelnInvers(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; virtual; // und die inverse Funktion function transformiereWertEinzeln(const x: extended): extended; virtual; // wie ändert sich ein Wert function rXStart: extended; procedure wXStart(x: extended); function rXStop: extended; procedure wXStop(x: extended); function rTStart: extended; procedure wTStart(t: extended); function rTStop: extended; procedure wTStop(t: extended); function rWMin: extended; procedure wWMin(w: extended); function rWMax: extended; procedure wWMax(w: extended); function rPMin: tInt64Point; procedure wPMin(p: tInt64Point); function rPMax: tInt64Point; procedure wPMax(p: tInt64Point); function rZDP: tInt64Point; procedure wZDP(p: tInt64Point); function rXSteps: longint; procedure wXSteps(x: longint); function rTSiz: longint; procedure wTSiz(t: longint); public constructor create; destructor destroy; override; procedure fuegeNachfolgerHinzu(tr: tTransformation); procedure loescheNachfolger(tr: tTransformation); procedure fuegeVorgaengerHinzu(tr: tTransformation); procedure loescheVorgaenger(tr: tTransformation); function wirdGebraucht: boolean; procedure aktualisiereAlles; // (inkl. Informieren der Nachfolger) function ersetzeAnfangDurch(tr: tTransformation): boolean; function beliebigerVorgaenger: tTransformation; function werBrauchtDas: string; procedure erhoeheZugehoerigkeitsanzahl; procedure verringereZugehoerigkeitsanzahl; property achsen: t2x2Extended read outAchsen; // wie lauten xStart,xStop,tStart,tStop? function transformiereKoordinaten(const p: tExtPoint; const tiefe: longint = -1): tExtPoint; overload; function transformiereKoordinaten(const x,y: longint; const tiefe: longint = -1): tExtPoint; overload; function transformiereKoordinatenInvers(const p: tExtPoint; const tiefe: longint = -1): tExtPoint; function wertZuPositionAufAchse(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; virtual; function positionAufAchseZuWert(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; virtual; function transformiereWert(const x: extended; const tiefe: longint = -1): extended; property xStepsTSiz: tIntPoint read outXSTS; property wMia: tExtPoint read outWMia; property pMia: t2x2Int64 read outPMia; function dumpParams: string; virtual; overload; function dumpParams(tiefe: longint): string; overload; property xStart: extended read rXStart write wXStart; property xStop: extended read rXStop write wXStop; property tStart: extended read rTStart write wTStart; property tStop: extended read rTStop write wTStop; property wMin: extended read rWMin write wWMin; property wMax: extended read rWMax write wWMax; property pMin: tInt64Point read rPMin write wPMin; property pMax: tInt64Point read rPMax write wPMax; property zDP: tInt64Point read rZDP write wZDP; property xSteps: longint read rXSteps write wXSteps; property tSiz: longint read rTSiz write wTSiz; end; tKeineTransformation = class (tTransformation) // der Beginn einer Transformationskette, z.B. das Laden von Daten procedure holeInfosVonVorgaengern; override; function wertZuPositionAufAchse(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; override; function positionAufAchseZuWert(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; override; end; tIdentitaet = class (tTransformation) // nichts ändert sich constructor create(original: tTransformation); end; tUeberlagerung = class (tTransformation) // die Überlagerung mehrer gleichformatiger Daten, z.B. Linearkombination constructor create; procedure addKomponente(tr: tTransformation); end; tKoordinatenTransformation = class (tTransformation) // eine generische Transformation der Koordinaten // selbst nicht zum Instanziieren gedacht end; tFFTTransformation = class (tKoordinatenTransformation) // repräsentiert die Transformation der Koordinaten bei einer FFT horizontal,vertikal,horizontalZentrieren,vertikalZentrieren: boolean; constructor create; overload; constructor create(vorg: tTransformation; hor,ver,hZnt,vZnt: boolean); procedure aktualisiereAchsen; override; // keine Änderung der Positionen, der Werte(skalierung), der Ausdehnung function wertZuPositionAufAchse(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; override; function positionAufAchseZuWert(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; override; function dumpParams: string; override; end; tRTVorbereitungsTransformation = class (tKoordinatenTransformation) // repräsentiert die Transformation der Koordinaten zu Beginn einer Radontransformation constructor create; overload; constructor create(vorg: tTransformation); procedure aktualisiereAchsen; override; procedure aktualisiereXsTs; override; // keine Änderung der Positionen, der Werte(skalierung) function wertZuPositionAufAchse(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; override; function positionAufAchseZuWert(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; override; function dumpParams: string; override; end; tRTLineOutTransformation = class (tKoordinatenTransformation) // repräsentiert die Transformation der Koordinaten beim Lineout einer Radontransformation winkelSchritte: int64; constructor create; overload; constructor create(vorg: tTransformation; ws: int64); procedure aktualisiereAchsen; override; procedure aktualisiereXsTs; override; // keine Änderung der Positionen, der Werte(skalierung) function wertZuPositionAufAchse(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; override; function positionAufAchseZuWert(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; override; function dumpParams: string; override; end; tAK2dTransformation = class (tKoordinatenTransformation) // repräsentiert die Transformation der Koordinaten bei einer 2d-Autokorrelation spiegeln: array['x'..'y'] of boolean; constructor create; overload; constructor create(vorg: tTransformation; hoS,veS: boolean); procedure aktualisiereAchsen; override; procedure aktualisiereXsTs; override; // keine Änderung der Positionen, der Werte(skalierung), der Ausdehnung function wertZuPositionAufAchse(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; override; function positionAufAchseZuWert(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; override; function dumpParams: string; override; end; tSpiegelungsTransformation = class (tKoordinatenTransformation) // repräsentiert die horizontale Spiegelung der Koordinaten constructor create; constructor create(vorg: tTransformation); function transformiereKoordinatenEinzeln(const p: tExtPoint; auszerhalbIstFehler: boolean = true): tExtPoint; override; function transformiereKoordinatenEinzelnInvers(const p: tExtPoint; auszerhalbIstFehler: boolean = true): tExtPoint; override; // keine Änderung der Achsenbegrenzungen, der Werte(skalierung), der Ausdehnung function dumpParams: string; override; end; tKonkreteKoordinatenTransformation = class (tKoordinatenTransformation) private // eine konkrete Verzerrung der Koordinaten (linearer + logarithmischer + exponentieller Anteil) function findeLineareParameter(syntaxTest: boolean; auszenSkala: char; s: string; xScale,yScale: extended; var off,xl,yl: extended; ueberschreiben: boolean; etf: tExprToFloat): boolean; public lnInt, // Faktoren in den ln-Argumenten expExp, // Exponenten der Exponentialfunktionen lin: t2x2Extended; // Matrix-faktor des Affinanteils off, // Offset des Affinanteils lnFak, // Vorfaktoren der Logarithmen lnOff, // Offset der ln-Argumente expFak: tExtPoint; // Vorfaktoren der Exponentialfunktionen constructor create; function transformiereKoordinatenEinzeln(const p: tExtPoint; auszerhalbIstFehler: boolean = true): tExtPoint; override; function transformiereKoordinatenEinzelnInvers(const p: tExtPoint; auszerhalbIstFehler: boolean = true): tExtPoint; override; function initAbbildung(syntaxTest: boolean; s: string; xScale,yScale: extended; etf: tExprToFloat): boolean; function zielausdehnung: t2x2Longint; procedure aktualisiereXsTs; override; // keine Änderung der Achsenbegrenzungen, der Werte(skalierung) function dumpParams: string; override; end; tLineareAchsenVerzerrTransformation = class (tKoordinatenTransformation) private procedure aktualisiereAchsen; override; // keine Änderung der Punkt-Positionen function transformiereAchseEinzeln(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; override; function transformiereAchseEinzelnInvers(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; override; // keine Änderung der Werte public fak,offset: tExtPoint; constructor create(vg: tTransformation); function dumpParams: string; override; end; tGroeszenVerdopplungsTransformation = class (tKoordinatenTransformation) private _horizontal,_vertikal: boolean; procedure wHorizontal(h: boolean); procedure wVertikal(v: boolean); public constructor create(vorg: tTransformation; hor,ver: boolean); property horizontal: boolean read _horizontal write wHorizontal; property vertikal: boolean read _vertikal write wVertikal; procedure aktualisiereAchsen; override; procedure aktualisiereXsTs; override; // function transformiereKoordinatenEinzeln(const p: tExtPoint; auszerhalbIstFehler: boolean = true): tExtPoint; override; // das ist erst relevant, wenn // function transformiereKoordinatenEinzelnInvers(const p: tExtPoint; auszerhalbIstFehler: boolean = true): tExtPoint; override; // man _vorne_ Nullen anfügen kann! // keine Änderung der Werte(skalierung) function wertZuPositionAufAchse(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; override; function positionAufAchseZuWert(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; override; function dumpParams: string; override; end; tLambdaZuOmegaTransformation = class (tKoordinatenTransformation) private _faktor: extended; _horizontal,_vertikal: boolean; function transformiereAchseEinzeln(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; override; function transformiereAchseEinzelnInvers(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; override; procedure wHorizontal(h: boolean); procedure wVertikal(v: boolean); public constructor create; overload; constructor create(faktor: extended); overload; property horizontal: boolean read _horizontal write wHorizontal; property vertikal: boolean read _vertikal write wVertikal; function verhaeltnisHorizontal: extended; function verhaeltnisVertikal: extended; procedure aktualisiereAchsen; override; function transformiereKoordinatenEinzeln(const p: tExtPoint; auszerhalbIstFehler: boolean = true): tExtPoint; override; function transformiereKoordinatenEinzelnInvers(const p: tExtPoint; auszerhalbIstFehler: boolean = true): tExtPoint; override; // keine Änderung der Werte(skalierung), der Ausdehnung function dumpParams: string; override; end; tKoordinatenAusschnitt = class (tKoordinatenTransformation) gr: t2x2Longint; constructor create; overload; constructor create(vorg: tTransformation; xMin,xMax,tMin,tMax: longint); overload; procedure aktualisiereXsTs; override; procedure aktualisiereAchsen; override; function transformiereKoordinatenEinzeln(const p: tExtPoint; auszerhalbIstFehler: boolean = true): tExtPoint; override; function transformiereKoordinatenEinzelnInvers(const p: tExtPoint; auszerhalbIstFehler: boolean = true): tExtPoint; override; // keine Änderung der Werte(skalierung) function dumpParams: string; override; end; tFitTransformation = class(tKoordinatenTransformation) private _senkrecht: boolean; _adLaenge: longint; _adStao: tExtPoint; public constructor create(daten: tTransformation; senkrecht: boolean; adLaenge: longint; adStart,adStop: extended); procedure aktualisiereXsTs; override; procedure aktualisiereAchsen; override; // keine Änderung der Werte(skalierung) function wertZuPositionAufAchse(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; override; function positionAufAchseZuWert(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; override; function dumpParams: string; override; end; tAgglomeration = class (tKoordinatenTransformation) private _nullposition: extended; function rNullposition: extended; procedure wNullposition(n: extended); public schritt: extended; horizontal: boolean; constructor create; procedure holeInfosVonVorgaengern; override; procedure addKomponente(tr: tTransformation); procedure aktualisiereXsTs; override; procedure aktualisiereAchsen; override; // keine Änderung der Werte(skalierung) function wertZuPositionAufAchse(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; override; function positionAufAchseZuWert(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; override; property nullposition: extended read rNullposition write wNullposition; function dumpParams: string; override; end; tDiagonaleAgglomeration = class (tKoordinatenTransformation) function datenRichtung: char; inline; public constructor create(vorg: tTransformation); procedure holeInfosVonVorgaengern; override; procedure aktualisiereXsTs; override; procedure aktualisiereAchsen; override; // keine Änderung der Werte(skalierung) function wertZuPositionAufAchse(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; override; function positionAufAchseZuWert(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; override; function dumpParams: string; override; end; tBearbeitungstyp = (btUnbekannt,btKnick,btLog,btAbsLog,btAbs); tWerteTransformation = class (tTransformation) // eine generische Transformation der Werte // selbst nicht zum Instanziieren gedacht end; tWerteKnickTransformation = class (tWerteTransformation) // Werte knicken parameter: tExtendedArray; constructor create; overload; destructor destroy; override; function transformiereWertEinzeln(const x: extended): extended; override; // keine Änderung der Achsenbegrenzungen, der Positionen, der Ausdehnung function dumpParams: string; override; end; tWerteLogTransformation = class (tWerteTransformation) // Werte logarithmieren logMin: extended; constructor create; overload; function transformiereWertEinzeln(const x: extended): extended; override; // keine Änderung der Achsenbegrenzungen, der Positionen, der Ausdehnung function dumpParams: string; override; end; tWerteLogAbsTransformation = class (tWerteTransformation) // Wertebeträge logarithmieren logSkala: extended; constructor create; overload; function transformiereWertEinzeln(const x: extended): extended; override; // keine Änderung der Achsenbegrenzungen, der Positionen, der Ausdehnung function dumpParams: string; override; end; tWerteAbsTransformation = class (tWerteTransformation) // Werte betragen constructor create; function transformiereWertEinzeln(const x: extended): extended; override; // keine Änderung der Achsenbegrenzungen, der Positionen, der Ausdehnung function dumpParams: string; override; end; tLinienIntegral = record von,schritt: tExtPoint; schritte: longint; end; function liesTWerteTransformationen(sT: boolean; s: string; f: tMyStringList; etf: tExprToFloat; var tr: tTransformation): boolean; procedure zerstoereTransformationWennObsolet(tr: tTransformation); function dreheLagePositiv(l: tLage): tLage; inline; function stringToTHintergrundAbzugsArt(s: string; sT: boolean; kvs: tKnownValues; cbgv: tCallBackGetValue; out hintergrundAbzugsArt: tHintergrundAbzugsArt): boolean; function tHintergrundAbzugsArtToStr(hintergrundAbzugsArt: tHintergrundAbzugsArt): string; function strToTEntspringModus(s: string; sT: boolean; kvs: tKnownValues; cbgv: tCallBackGetValue; out entspringModus: tEntspringModus): boolean; function tEntspringModusToStr(entspringModus: tEntspringModus): string; const paralleleRichtung: array[tLage] of char = ('y','x','y','x'); senkrechteRichtung: array[tLage] of char = ('x','y','x','y'); implementation const lf = #13#10; // tGenerischeInputDateiInfo *************************************************** constructor tGenerischeInputDateiInfo.create(vorlage: tGenerischeInputDateiInfo); begin inherited create; fillChar(name,sizeOf(name),#0); name:=vorlage.name; fillChar(fehlerBehebungsKommando,sizeOf(fehlerBehebungsKommando),#0); fehlerBehebungsKommando:=vorlage.fehlerBehebungsKommando; gamma:=vorlage.gamma; groeszenFaktor:=vorlage.groeszenFaktor; genauigkeit:=vorlage.genauigkeit; tSiz:=vorlage.tSiz; xSteps:=vorlage.xSteps; tStart:=vorlage.tStart; tStop:=vorlage.tStop; xStart:=vorlage.xStart; xStop:=vorlage.xStop; params:=vorlage.params; t0Abs:=vorlage.t0Abs; end; constructor tGenerischeInputDateiInfo.create; begin inherited create; fillChar(name,sizeOf(name),#0); name:=''; fillChar(fehlerBehebungsKommando,sizeOf(fehlerBehebungsKommando),#0); fehlerBehebungsKommando:=''; gamma:=1; groeszenFaktor:=1; genauigkeit:=gSingle; tSiz:=-1; t0Abs:=-1; xSteps:=-1; tStart:=-myInf; tStop:=myInf; xStart:=-myInf; xStop:=myInf; params:=nil; end; destructor tGenerischeInputDateiInfo.destroy; begin name:=''; fehlerBehebungsKommando:=''; inherited destroy; end; function tGenerischeInputDateiInfo.xMin: longint; begin result:=0; if assigned(params) and (params.xSteps>1) and (xStart > params.xStart + result/(params.xSteps-1)*(params.xStop-params.xStart)) then result:=min(xSteps-1,round((xStart-params.xStart)/(params.xStop-params.xStart)/(params.xSteps-1))); end; function tGenerischeInputDateiInfo.xMax: longint; begin result:=xSteps-1; if assigned(params) and (params.xSteps>1) and (xStop < params.xStart + result/(params.xSteps-1)*(params.xStop-params.xStart)) then result:=max(0,round((xStop-params.xStart)/(params.xStop-params.xStart)/(params.xSteps-1))); end; function tGenerischeInputDateiInfo.tMin: longint; begin result:=t0Abs; if assigned(params) and (params.tSiz>1) and (tStart > params.tStart + result/(params.tSiz-1)*(params.tStop-params.tStart)) then result:=round((tStart-params.tStart)/(params.tStop-params.tStart)/(params.tSiz-1)); result:=min(tSiz-1,max(0,result-t0Abs)); end; function tGenerischeInputDateiInfo.tMax: longint; begin result:=t0Abs+tSiz-1; if assigned(params) and (params.tSiz>1) and (tStop < params.tStart + result/(params.tSiz-1)*(params.tStop-params.tStart)) then result:=round((tStop-params.tStart)/(params.tStop-params.tStart)/(params.tSiz-1)); result:=min(tSiz-1,max(0,result-t0Abs)); end; function tGenerischeInputDateiInfo.dumpParams: string; begin result:= className + ':' + lf + 'name: ''' + name + '''' + lf + 'fehlerBehebungsKommando: ''' + fehlerBehebungsKommando + '''' + lf + 'gamma: ' + floatToStr(gamma) + lf + 'groeszenFaktor: ' + floatToStr(groeszenFaktor) + lf + 'tStart: ' + floatToStr(tStart) + lf + 'tStop: ' + floatToStr(tStop) + lf + 'xStart: ' + floatToStr(xStart) + lf + 'xStop: ' + floatToStr(xStop) + lf + 'genauigkeit: ' + genToStr(genauigkeit) + lf + 'xSteps: ' + intToStr(xSteps) + lf + 'tSiz: ' + intToStr(tSiz) + lf + 't0Abs: ' + intToStr(t0Abs); // + lf + // params.dump; end; // tPhaseSpaceInputDateiInfo **************************************************** constructor tPhaseSpaceInputDateiInfo.create(vorlage: tGenerischeInputDateiInfo); begin inherited create(vorlage); end; constructor tPhaseSpaceInputDateiInfo.create; begin inherited create; end; destructor tPhaseSpaceInputDateiInfo.destroy; begin inherited destroy; end; // tSpaceTimeInputDateiInfo **************************************************** constructor tSpaceTimeInputDateiInfo.create(vorlage: tGenerischeInputDateiInfo); begin inherited create(vorlage); end; constructor tSpaceTimeInputDateiInfo.create; begin inherited create; end; destructor tSpaceTimeInputDateiInfo.destroy; begin inherited destroy; end; // tTraceInputDateiInfo ******************************************************** constructor tTraceInputDateiInfo.create(vorlage: tGenerischeInputDateiInfo); begin inherited create(vorlage); if vorlage is tTraceInputDateiInfo then begin spurNummer:=(vorlage as tTraceInputDateiInfo).spurNummer; feldNummer:=(vorlage as tTraceInputDateiInfo).feldNummer; end else begin spurNummer:=0; feldNummer:=0; end; end; constructor tTraceInputDateiInfo.create; begin inherited create; spurNummer:=0; feldNummer:=0; end; destructor tTraceInputDateiInfo.destroy; begin inherited destroy; end; function tTraceInputDateiInfo.dumpParams: string; begin result:= 'spurNummer: ' + intToStr(spurNummer) + lf + 'feldNummer: ' + intToStr(feldNummer) + lf + inherited dumpParams; end; // tSergeyInputDateiInfo ******************************************************* constructor tSergeyInputDateiInfo.create(vorlage: tGenerischeInputDateiInfo); begin inherited create(vorlage); if vorlage is tSergeyInputDateiInfo then feldNummer:=(vorlage as tSergeyInputDateiInfo).feldNummer else feldNummer:=0; end; constructor tSergeyInputDateiInfo.create; begin inherited create; feldNummer:=0; end; destructor tSergeyInputDateiInfo.destroy; begin inherited destroy; end; function tSergeyInputDateiInfo.dumpParams: string; begin result:= 'feldNummer: ' + intToStr(feldNummer) + lf + inherited dumpParams; end; // tPipeInputDateiInfo ********************************************************* constructor tPipeInputDateiInfo.create(vorlage: tGenerischeInputDateiInfo); begin inherited create(vorlage); fillChar(analysator,sizeOf(analysator),#0); if vorlage is tPipeInputDateiInfo then begin analysator:=(vorlage as tPipeInputDateiInfo).analysator; bytesPerSample:=(vorlage as tPipeInputDateiInfo).bytesPerSample; Kodierung:=(vorlage as tPipeInputDateiInfo).Kodierung; end else begin analysator:='/usr/bin/soxi -'; bytesPerSample:=-1; Kodierung:=kUnbekannt; end; end; constructor tPipeInputDateiInfo.create; begin inherited create; fillChar(analysator,sizeOf(analysator),#0); analysator:='/usr/bin/soxi -'; bytesPerSample:=-1; Kodierung:=kUnbekannt; end; destructor tPipeInputDateiInfo.destroy; begin analysator:=''; inherited destroy; end; function tPipeInputDateiInfo.executable: string; begin result:=leftStr(name,pos(' ',name+' ')-1); end; function tPipeInputDateiInfo.parametersText: string; begin result:=copy(name,pos(' ',name+' ')+1,length(name)); while pos(' ',result)>0 do result[pos(' ',result)]:=#13; end; function tPipeInputDateiInfo.analysatorExecutable: string; begin result:=leftStr(analysator,pos(' ',analysator+' ')-1); end; function tPipeInputDateiInfo.analysatorParametersText: string; begin result:=copy(analysator,pos(' ',analysator+' ')+1,length(analysator)); while pos(' ',result)>0 do result[pos(' ',result)]:=#13; end; function tPipeInputDateiInfo.dumpParams: string; begin result:= 'analysator: ''' + analysator + '''' + lf + 'bytesPerSample: ' + intToStr(bytesPerSample) + lf + 'Kodierung: ' + tKodierungToStr(Kodierung) + lf + inherited dumpParams; end; // tAndorInputDateiInfo ******************************************************* constructor tAndorInputDateiInfo.create(vorlage: tGenerischeInputDateiInfo); begin inherited create(vorlage); if vorlage is tAndorInputDateiInfo then begin temperatur:=(vorlage as tAndorInputDateiInfo).temperatur; belichtungsZeit:=(vorlage as tAndorInputDateiInfo).belichtungsZeit; zyklusZeit:=(vorlage as tAndorInputDateiInfo).zyklusZeit; akkumulierteZyklusZeit:=(vorlage as tAndorInputDateiInfo).akkumulierteZyklusZeit; akkumulierteZyklen:=(vorlage as tAndorInputDateiInfo).akkumulierteZyklen; zyklusStapelZeit:=(vorlage as tAndorInputDateiInfo).zyklusStapelZeit; pixelAusleseZeit:=(vorlage as tAndorInputDateiInfo).pixelAusleseZeit; verstaerkungADW:=(vorlage as tAndorInputDateiInfo).verstaerkungADW; detektorTyp:=(vorlage as tAndorInputDateiInfo).detektorTyp; dateiName:=(vorlage as tAndorInputDateiInfo).dateiName; detektorGroesze:=(vorlage as tAndorInputDateiInfo).detektorGroesze; shutterZeit:=(vorlage as tAndorInputDateiInfo).shutterZeit; xAchsenTitel:=(vorlage as tAndorInputDateiInfo).xAchsenTitel; yAchsenTitel:=(vorlage as tAndorInputDateiInfo).yAchsenTitel; datenTypTitel:=(vorlage as tAndorInputDateiInfo).datenTypTitel; bildBereichStapel:=(vorlage as tAndorInputDateiInfo).bildBereichStapel; rahmenToepfe:=(vorlage as tAndorInputDateiInfo).rahmenToepfe; bildBereich:=(vorlage as tAndorInputDateiInfo).bildBereich; rahmenBereich:=(vorlage as tAndorInputDateiInfo).rahmenBereich; hatHintergrund:=(vorlage as tAndorInputDateiInfo).hatHintergrund; istHintergrund:=(vorlage as tAndorInputDateiInfo).istHintergrund; end else begin temperatur:=0; belichtungsZeit:=0; zyklusZeit:=0; akkumulierteZyklusZeit:=0; akkumulierteZyklen:=0; zyklusStapelZeit:=0; pixelAusleseZeit:=0; verstaerkungADW:=1; detektorTyp:='unbekannt'; dateiName:=''; detektorGroesze:=intPoint(0,0); shutterZeit:=extPoint(0,0); xAchsenTitel:=''; yAchsenTitel:=''; datenTypTitel:=''; bildBereichStapel:=intPoint(0,0); rahmenToepfe:=intPoint(0,0); bildBereich:=_2x2Longint(0,0,0,0); rahmenBereich:=_2x2Longint(0,0,0,0); hatHintergrund:=false; istHintergrund:=false; end; end; constructor tAndorInputDateiInfo.create; begin inherited create; temperatur:=0; belichtungsZeit:=0; zyklusZeit:=0; akkumulierteZyklusZeit:=0; akkumulierteZyklen:=0; zyklusStapelZeit:=0; pixelAusleseZeit:=0; verstaerkungADW:=1; detektorTyp:='unbekannt'; dateiName:=''; detektorGroesze:=intPoint(0,0); shutterZeit:=extPoint(0,0); xAchsenTitel:=''; yAchsenTitel:=''; datenTypTitel:=''; bildBereichStapel:=intPoint(0,0); rahmenToepfe:=intPoint(0,0); bildBereich:=_2x2Longint(0,0,0,0); rahmenBereich:=_2x2Longint(0,0,0,0); hatHintergrund:=false; istHintergrund:=false; end; destructor tAndorInputDateiInfo.destroy; begin detektorTyp:=''; dateiName:=''; inherited destroy; end; function tAndorInputDateiInfo.detectorSkipLines: int64; begin result:=8; // 15; // woher stammt diese Zahl??? if pos('Luc',detektorTyp)>0 then result:=result+2; if (detektorTyp='DU920P_BR,DD') or (detektorTyp='DV436') then result:=result+10; if (detektorTyp='DV420') or (detektorTyp='DO940P_BN,9H') then result:=result+1; if detektorTyp='DO940P_BN,T2' then result:=result+2; end; function tAndorInputDateiInfo.detectorSkipLines2: int64; begin result:=6; if (detektorTyp='DV420') or (detektorTyp='DV436') or (detektorTyp='DO940P_BN,9H') then result:=result-1; if detektorTyp='DO940P_BN,T2' then result:=result-2; end; procedure tAndorInputDateiInfo.berechneXStop; var j: integer; begin xStop:=0; for j:=2 downto 0 do xStop:=(xStop + xAchse[j])*xSteps; xStop:=xStop+xStart; // der xStep-ste Punkt xStart:=xStart+(xStop-xStart)/xSteps; // der 1. Punkt (und nicht der 0.)! end; function tAndorInputDateiInfo.dumpParams: string; var i: longint; begin result:= 'temperatur: ' + floatToStr(temperatur) + lf + 'belichtungsZeit: ' + floatToStr(belichtungsZeit) + lf + 'zyklusZeit: ' + floatToStr(zyklusZeit) + lf + 'akkumulierteZyklusZeit: ' + floatToStr(akkumulierteZyklusZeit) + lf + 'zyklusStapelZeit: ' + floatToStr(zyklusStapelZeit) + lf + 'pixelAusleseZeit: ' + floatToStr(pixelAusleseZeit) + lf + 'verstaerkungADW: ' + floatToStr(verstaerkungADW) + lf + 'akkumulierteZyklen: ' + intToStr(akkumulierteZyklen) + lf + 'datenStart: ' + intToStr(datenStart) + lf + 'hintergrundStart: ' + intToStr(hintergrundStart) + lf + 'detektorTyp: ''' + detektorTyp + '''' + lf + 'dateiName: ''' + dateiName + '''' + lf + 'xAchsenTitel: ''' + xAchsenTitel + '''' + lf + 'yAchsenTitel: ''' + yAchsenTitel + '''' + lf + 'datenTypTitel: ''' + datenTypTitel + '''' + lf + 'detektorGroesze: ' + tIntPointToStr(detektorGroesze) + lf + 'bildBereichStapel: ' + tIntPointToStr(bildBereichStapel) + lf + 'rahmenToepfe: ' + tIntPointToStr(rahmenToepfe) + lf + 'bildBereich: ' + t2x2LongintToStr(bildBereich) + lf + 'rahmenBereich: ' + t2x2LongintToStr(rahmenBereich) + lf + 'shutterZeit: ' + tExtPointToStr(shutterZeit) + lf + 'xAchse:'; for i:=0 to 2 do result:=result + ' ' + floatToStr(xAchse[i]); if hatHintergrund then result:=result + lf + 'hat Hintergund'; if istHintergrund then result:=result + lf + 'ist Hintergund'; result:=result + lf + inherited dumpParams; end; // tInputDateiInfoVorlagen ***************************************************** constructor tInputDateiInfoVorlagen.create; begin inherited create; phaseSpaceVorlage:=tPhaseSpaceInputDateiInfo.create; spaceTimeVorlage:=tSpaceTimeInputDateiInfo.create; traceVorlage:=tTraceInputDateiInfo.create; sergeyVorlage:=tSergeyInputDateiInfo.create; pipeVorlage:=tPipeInputDateiInfo.create; andorVorlage:=tAndorInputDateiInfo.create; fillChar(_name,sizeOf(_name),#0); name:=spaceTimeVorlage.name; fillChar(_fehlerBehebungsKommando,sizeOf(_fehlerBehebungsKommando),#0); fehlerBehebungsKommando:=spaceTimeVorlage.fehlerBehebungsKommando; gamma:=spaceTimeVorlage.gamma; groeszenFaktor:=spaceTimeVorlage.groeszenFaktor; genauigkeit:=spaceTimeVorlage.genauigkeit; _tSiz:=spaceTimeVorlage.tSiz; _xSteps:=spaceTimeVorlage.xSteps; spurNummer:=traceVorlage.spurNummer; feldNummer:=traceVorlage.feldNummer; fillChar(_analysator,sizeOf(_analysator),#0); analysator:=pipeVorlage.analysator; _bytesPerSample:=pipeVorlage.bytesPerSample; _Kodierung:=pipeVorlage.Kodierung; _tStart:=spaceTimeVorlage.tStart; _tStop:=spaceTimeVorlage.tStop; _xStart:=spaceTimeVorlage.xStart; _xStop:=spaceTimeVorlage.xStop; _t0abs:=spaceTimeVorlage.t0Abs; _istHintergrung:=andorVorlage.istHintergrund; end; destructor tInputDateiInfoVorlagen.destroy; begin phaseSpaceVorlage.free; spaceTimeVorlage.free; traceVorlage.free; sergeyVorlage.free; pipeVorlage.free; andorVorlage.free; _name:=''; _fehlerBehebungsKommando:=''; _analysator:=''; inherited destroy; end; procedure tInputDateiInfoVorlagen.wFehlerbehebungskommando(f: string); begin _fehlerBehebungsKommando:=f; phaseSpaceVorlage.fehlerBehebungsKommando:=f; spaceTimeVorlage.fehlerBehebungsKommando:=f; traceVorlage.fehlerBehebungsKommando:=f; sergeyVorlage.fehlerBehebungsKommando:=f; pipeVorlage.fehlerBehebungsKommando:=f; andorVorlage.fehlerBehebungsKommando:=f; end; procedure tInputDateiInfoVorlagen.wName(n: string); begin _name:=n; phaseSpaceVorlage.name:=n; spaceTimeVorlage.name:=n; traceVorlage.name:=n; sergeyVorlage.name:=n; pipeVorlage.name:=n; andorVorlage.name:=n; end; procedure tInputDateiInfoVorlagen.wGamma(g: extended); begin _gamma:=g; phaseSpaceVorlage.gamma:=g; spaceTimeVorlage.gamma:=g; traceVorlage.gamma:=g; sergeyVorlage.gamma:=g; pipeVorlage.gamma:=g; end; procedure tInputDateiInfoVorlagen.wTStart(t: extended); begin _tStart:=t; phaseSpaceVorlage.tStart:=t; spaceTimeVorlage.tStart:=t; traceVorlage.tStart:=t; sergeyVorlage.tStart:=t; pipeVorlage.tStart:=t; andorVorlage.tStart:=t; end; procedure tInputDateiInfoVorlagen.wTStop(t: extended); begin _tStop:=t; phaseSpaceVorlage.tStop:=t; spaceTimeVorlage.tStop:=t; traceVorlage.tStop:=t; sergeyVorlage.tStop:=t; pipeVorlage.tStop:=t; andorVorlage.tStop:=t; end; procedure tInputDateiInfoVorlagen.wXStart(x: extended); begin _xStart:=x; phaseSpaceVorlage.xStart:=x; spaceTimeVorlage.xStart:=x; traceVorlage.xStart:=x; sergeyVorlage.xStart:=x; pipeVorlage.xStart:=x; andorVorlage.xStart:=x; end; procedure tInputDateiInfoVorlagen.wXStop(x: extended); begin _xStop:=x; phaseSpaceVorlage.xStop:=x; spaceTimeVorlage.xStop:=x; traceVorlage.xStop:=x; sergeyVorlage.xStop:=x; pipeVorlage.xStop:=x; andorVorlage.xStop:=x; end; procedure tInputDateiInfoVorlagen.wT0Abs(t: longint); begin _t0abs:=t; phaseSpaceVorlage.t0Abs:=t; spaceTimeVorlage.t0Abs:=t; traceVorlage.t0Abs:=t; sergeyVorlage.t0Abs:=t; pipeVorlage.t0Abs:=t; andorVorlage.t0Abs:=t; end; procedure tInputDateiInfoVorlagen.wGroeszenFaktor(g: extended); begin _groeszenFaktor:=g; phaseSpaceVorlage.groeszenFaktor:=g; spaceTimeVorlage.groeszenFaktor:=g; traceVorlage.groeszenFaktor:=g; sergeyVorlage.groeszenFaktor:=g; pipeVorlage.groeszenFaktor:=g; end; procedure tInputDateiInfoVorlagen.wGenauigkeit(g: tGenauigkeit); begin _genauigkeit:=g; phaseSpaceVorlage.genauigkeit:=g; spaceTimeVorlage.genauigkeit:=g; traceVorlage.genauigkeit:=g; sergeyVorlage.genauigkeit:=g; pipeVorlage.genauigkeit:=g; andorVorlage.genauigkeit:=g; end; procedure tInputDateiInfoVorlagen.wTSiz(t: longint); begin _tSiz:=t; phaseSpaceVorlage.tSiz:=t; spaceTimeVorlage.tSiz:=t; traceVorlage.tSiz:=t; sergeyVorlage.tSiz:=t; pipeVorlage.tSiz:=t; andorVorlage.tSiz:=t; end; procedure tInputDateiInfoVorlagen.wXSteps(x: longint); begin _xSteps:=x; phaseSpaceVorlage.xSteps:=x; spaceTimeVorlage.xSteps:=x; traceVorlage.xSteps:=x; sergeyVorlage.xSteps:=x; pipeVorlage.xSteps:=x; andorVorlage.xSteps:=x; end; procedure tInputDateiInfoVorlagen.wSpurNummer(s: longint); begin _spurNummer:=s; traceVorlage.spurNummer:=s; end; procedure tInputDateiInfoVorlagen.wFeldNummer(f: longint); begin _feldNummer:=f; traceVorlage.feldNummer:=f; sergeyVorlage.feldNummer:=f; end; procedure tInputDateiInfoVorlagen.wAnalysator(a: string); begin _analysator:=a; pipeVorlage.analysator:=a; end; procedure tInputDateiInfoVorlagen.wBytesPerSample(b: longint); begin _bytesPerSample:=b; pipeVorlage.bytesPerSample:=b; end; procedure tInputDateiInfoVorlagen.wKodierung(k: tKodierung); begin _Kodierung:=k; pipeVorlage.Kodierung:=k; end; procedure tInputDateiInfoVorlagen.wIstHintergrund(ih: boolean); begin _istHintergrung:=ih; andorVorlage.istHintergrund:=ih; end; function tInputDateiInfoVorlagen.genauigkeitFromStr(s: string): boolean; begin result:=strToGen(_genauigkeit,s); genauigkeit:=_genauigkeit; end; function tInputDateiInfoVorlagen.fehlerBehebungsProgramm: string; begin result:=copy(fehlerBehebungsKommando,1,pos(' ',fehlerBehebungsKommando+' ')-1); end; function tInputDateiInfoVorlagen.fehlerBehebungsParameter: string; begin result:=copy(fehlerBehebungsKommando,pos(' ',fehlerBehebungsKommando+' ')+1,length(fehlerBehebungsKommando)); end; procedure tInputDateiInfoVorlagen.wParams(p: tExtraInfos); begin _params:=p; phaseSpaceVorlage.params:=p; spaceTimeVorlage.params:=p; traceVorlage.params:=p; sergeyVorlage.params:=p; pipeVorlage.params:=p; andorVorlage.params:=p; end; // tFenster ******************************************************************** constructor tFenster.create; begin inherited create; setLength(werte,0); aktiv:=false; invers:=false; end; destructor tFenster.destroy; begin setLength(werte,0); inherited destroy; end; procedure tFenster.testeFensterDurchschnitt(schlussBeiWenigInhalt: boolean); var fenAvg: extended; i: longint; begin fenAvg:=0; for i:=0 to length(werte)-1 do fenAvg:=fenAvg+werte[i]; fenAvg:=fenAvg/length(werte); if fenAvg<0.5 then begin if schlussBeiWenigInhalt then fehler('Sehr geringer Fensterdurchschnitt: '+floatToStr(fenAvg)+' ('+dumpParams+')!') else gibAus('Sehr geringer Fensterdurchschnitt: '+floatToStr(fenAvg)+' ('+dumpParams+')! Ich mache aber trotzdem weiter.',3); end; end; function tFenster.dumpParams: string; begin result:=intToStr(length(werte))+' Werte '; if invers then result:=result+'invers '; if not aktiv then result:=result+'in'; result:=result+'aktiv'; end; // tSin2Fenster **************************************************************** constructor tSin2Fenster.create; begin inherited create; breite:=0; rand:=0; end; procedure tSin2Fenster.berechneWerte(anzWerte: longint; schlussBeiWenigInhalt: boolean); var i: integer; begin setLength(werte,anzWerte); for i:=0 to length(werte)-1 do begin if 2*i < anzWerte - breite - rand then begin werte[i]:=0; continue; end; if 2*i < anzWerte - breite + rand then begin werte[i]:=sqr(sin((2*i - anzWerte + breite + rand)/2/rand * pi/2)); continue; end; if 2*i < anzWerte + breite - rand then begin werte[i]:=1; continue; end; if 2*i < anzWerte + breite + rand then begin werte[i]:=sqr(sin((anzWerte + breite + rand - 2*i)/2/rand * pi/2)); continue; end; werte[i]:=0; end; if invers then for i:=0 to length(werte)-1 do werte[i]:=1-werte[i]; testeFensterDurchschnitt(schlussBeiWenigInhalt); end; function tSin2Fenster.dumpParams: string; begin result:= 'Breite: '+intToStr(breite)+', '+ 'Rand: '+intToStr(rand)+', '+ inherited dumpParams; end; // tGauszFenster *************************************************************** constructor tGauszFenster.create; begin inherited create; breite:=0; end; procedure tGauszFenster.berechneWerte(anzWerte: longint; schlussBeiWenigInhalt: boolean = false); var i: integer; begin setLength(werte,anzWerte); for i:=0 to length(werte)-1 do werte[i]:=power(2,-sqr(2*(i-anzWerte/2)/breite)); if invers then for i:=0 to length(werte)-1 do werte[i]:=1-werte[i]; testeFensterDurchschnitt(schlussBeiWenigInhalt); end; function tGauszFenster.dumpParams: string; begin result:= 'Breite: '+floattostrtrunc(breite,2,true)+', '+ 'Rand: '+intToStr(rand)+', '+ inherited dumpParams; end; // tVerlaufTeilFenster ********************************************************* constructor tVerlaufTeilFenster.create; begin fehler('tVerlaufTeilFenster ohne Verlauf kreiert!'); end; constructor tVerlaufTeilFenster.create(verlauf: tHintergrundAbzugsArt; epsilon: extended); begin inherited create; eps:=epsilon; if (verlauf.art=haaVertikaleMittel) and (length(verlauf.parameter)=2) then begin tMin:=verlauf.parameter[0]; tMax:=verlauf.parameter[1]; tRand:=-1; exit; end; if (verlauf.art=haaVertikaleMedianMittel) and (length(verlauf.parameter)=3) then begin tMin:=verlauf.parameter[0]; tMax:=verlauf.parameter[1]; tRand:=verlauf.parameter[2]; exit; end; fehler('tVerlaufTeilFenster mit ungültigem Verlauf kreiert - ich brauche haaVertikaleMittel oder haaVertikaleMedianMittel!'); end; procedure tVerlaufTeilFenster.berechneWerte(anzWerte: longint; schlussBeiWenigInhalt: boolean = false); begin if anzWerte>length(werte) then fehler('tVerlaufTeilFenster kann keine neuen Werte berechnen - ich soll aus '+intToStr(length(werte))+' Werten '+intToStr(anzWerte)+' Werte machen!'); setLength(werte,anzWerte); if invers then fehler('tVerlaufTeilFenster kann nicht invers sein!'); testeFensterDurchschnitt(schlussBeiWenigInhalt); end; function tVerlaufTeilFenster.dumpParams: string; begin result:= 'tMin: '+myFloatToStr(tMin)+', '+ 'tMax: '+myFloatToStr(tMax)+', '+ 'tRand: '+myFloatToStr(tRand)+', '+ 'eps: '+myFloatToStr(eps)+', '+ inherited dumpParams; end; // tBeschriftung *************************************************************** constructor tBeschriftung.create; begin inherited create; _inhalt:=''; end; destructor tBeschriftung.destroy; begin _inhalt:=''; inherited destroy; end; function tBeschriftung.strich: longint; begin result:=round(position); end; function tBeschriftung.links: longint; begin case lage of lOben,lUnten: result:=strich-(bild.breite div 2); lLinks: result:=-bild.breite-4-byte(rahmen); lRechts: result:=bBreite+3+byte(rahmen); end{of Case}; end; function tBeschriftung.oben: longint; begin case lage of lLinks,lRechts: result:=strich-(bild.hoehe div 2); lUnten: result:=-bild.hoehe-4-byte(rahmen); lOben: result:=bHoehe+3+byte(rahmen); end{of Case}; end; function tBeschriftung.rechts: longint; begin result:=links+bild.breite-1; end; function tBeschriftung.unten: longint; begin result:=oben+bild.hoehe-1; end; procedure tBeschriftung.wInhalt(s: string); begin _inhalt:=s; bild:=fontRend.rendere(_inhalt); end; // tExtraInfos ***************************************************************** constructor tExtraInfos.create(globaleWerte: tKnownValues); begin inherited create; maxW:=1; minW:=0; maxP:=int64Point(-1,-1); minP:=int64Point(-1,-1); zDP:=int64Point(-1,-1); transformationen:=tTransformation.create; transformationen.erhoeheZugehoerigkeitsanzahl; np:=1; beta:=0; tSiz:=0; xSteps:=0; tSiz_:=0; xSteps_:=0; istKomplex:=false; knownValues:=tKnownValues.create(globaleWerte); end; constructor tExtraInfos.create(original: tExtraInfos); begin inherited create; maxW:=original.maxW; minW:=original.minW; maxP:=original.maxP; minP:=original.minP; zDP:=original.minP; transformationen:=tIdentitaet.create(original.transformationen); np:=original.np; beta:=original.beta; tSiz:=original.tSiz; xSteps:=original.xSteps; tSiz_:=original.tSiz_; xSteps_:=original.xSteps_; istKomplex:=original.istKomplex; knownValues:=tKnownValues.createFromOriginal(original.knownValues); end; destructor tExtraInfos.destroy; begin knownValues.free; if assigned(_transformationen) then begin _transformationen.verringereZugehoerigkeitsanzahl; zerstoereTransformationWennObsolet(_transformationen); end; inherited destroy; end; procedure tExtraInfos.wTransformationen(tr: tTransformation); begin if assigned(_transformationen) then begin _transformationen.verringereZugehoerigkeitsanzahl; zerstoereTransformationWennObsolet(_transformationen); end; _transformationen:=tr; _transformationen.erhoeheZugehoerigkeitsanzahl; end; function tExtraInfos.xStart: extended; begin result:=transformationen.xStart; end; function tExtraInfos.xStop: extended; begin result:=transformationen.xStop; end; function tExtraInfos.tStart: extended; begin result:=transformationen.tStart; end; function tExtraInfos.tStop: extended; begin result:=transformationen.tStop; end; procedure tExtraInfos.refreshKnownValues; begin knownValues.add(knownValue('np',np)); knownValues.add(knownValue('maxW',maxW)); knownValues.add(knownValue('minW',minW)); if xSteps>1 then begin knownValues.add(knownValue('maxPX', maxP['x']/(xSteps-1)*(xStop-xStart) + xStart)); knownValues.add(knownValue('minPX', minP['x']/(xSteps-1)*(xStop-xStart) + xStart)); knownValues.add(knownValue('zDPX', zDP['x']/(xSteps-1)*(xStop-xStart) + xStart)); end else begin knownValues.add(knownValue('maxPX', xStart)); knownValues.add(knownValue('minPX', xStart)); knownValues.add(knownValue('zDPX', xStart)); end; if tSiz>1 then begin knownValues.add(knownValue('maxPY', maxP['y']/(tSiz-1)*(tStop-tStart) + tStart)); knownValues.add(knownValue('minPY', minP['y']/(tSiz-1)*(tStop-tStart) + tStart)); knownValues.add(knownValue('zDPY', maxP['y']/(tSiz-1)*(tStop-tStart) + tStart)); end else begin knownValues.add(knownValue('maxPY', tStart)); knownValues.add(knownValue('minPY', tStart)); knownValues.add(knownValue('zDPY', tStart)); end; knownValues.add(knownValue('beta',beta)); knownValues.add(knownValue('xStart',xStart)); knownValues.add(knownValue('xStop',xStop)); knownValues.add(knownValue('xSteps',xSteps)); knownValues.add(knownValue('tStart',tStart)); knownValues.add(knownValue('tStop',tStop)); knownValues.add(knownValue('tSiz',tSiz)); end; // tFontRenderer *************************************************************** constructor tFontRenderer.create(schriftgroesze: longint); var fontFile: string; begin inherited create; gibAus('FontRenderer erzeugen (Schriftgröße '+intToStr(schriftgroesze)+') ...',1); if not findeRekursiv('/usr/share/fonts','DejaVuSans.ttf',fontFile) then if not findeRekursiv('/usr/share/fonts','*.ttf',fontFile) then raise exception.create('Kann keine Schriftart finden.'); New(agg, Construct); agg^.font(char_ptr(fontFile),schriftgroesze,false,false,RasterFontCache,0.0); gibAus('... fertig',1); end; destructor tFontRenderer.destroy; begin Dispose(agg,Destruct); inherited destroy; end; function tFontRenderer.rendere(s: string): tLLBild; var buf: array of byte; ho,br,ymax,ymin,xMax,xMin,i,j: longint; b: boolean; begin while pos('.',s)>0 do s[pos('.',s)]:=','; br:=4*round(ceil(agg^.textWidth(char_ptr(s)))); ho:=4*round(ceil(agg^.fontHeight)); setLength(buf,ho*br*4); agg^.attach(@(buf[0]), br, ho, br * 4); agg^.clearAll(0, 0, 0); agg^.lineColor(0, 0, 0, 255); agg^.fillColor(255, 255, 255, 255); agg^.rectangle(-2, -2, br+2, ho+2); agg^.lineColor(255, 0, 0, 255); agg^.fillColor(0, 0, 0, 255); agg^.text(br div 2, ho div 2, char_ptr(s)); ymax:=ho; b:=true; while b and (ymax>0) do begin dec(ymax); for i:=0 to br-1 do if (buf[4*(i+br*ymax)+0]<>$ff) or (buf[4*(i+br*ymax)+1]<>$ff) or (buf[4*(i+br*ymax)+2]<>$ff) then b:=false; end; if b then begin gibAus('Leeres Bild!',3); halt(1); end; ymin:=-1; b:=true; while b and (ymin$ff) or (buf[4*(i+br*ymin)+1]<>$ff) or (buf[4*(i+br*ymin)+2]<>$ff) then b:=false; end; if b then begin gibAus('Leeres Bild!',3); halt(1); end; xMax:=br; b:=true; while b and (xMax>0) do begin dec(xMax); for i:=ymin to ymax do if (buf[4*(xMax+br*i)+0]<>$ff) or (buf[4*(xMax+br*i)+1]<>$ff) or (buf[4*(xMax+br*i)+2]<>$ff) then b:=false; end; if b then begin gibAus('Leeres Bild!',3); halt(1); end; xMin:=-1; b:=true; while b and (xMin<=xMax) do begin inc(xMin); for i:=ymin to ymax do if (buf[4*(xMin+br*i)+0]<>$ff) or (buf[4*(xMin+br*i)+1]<>$ff) or (buf[4*(xMin+br*i)+2]<>$ff) then b:=false; end; if b then begin gibAus('Leeres Bild!',3); halt(1); end; dec(xMin); dec(ymin); inc(xMax); inc(ymax); result.breite:=xMax-xMin+1; result.hoehe:=ymax-ymin+1; setLength(result.farben,result.breite*result.hoehe); for i:=0 to result.breite-1 do for j:=0 to result.hoehe-1 do begin result.farben[i + j*result.breite].rgbBlue:= byte(buf[4*(i+xMin+br*(j+ymin))+0]); result.farben[i + j*result.breite].rgbGreen:=byte(buf[4*(i+xMin+br*(j+ymin))+1]); result.farben[i + j*result.breite].rgbRed:= byte(buf[4*(i+xMin+br*(j+ymin))+2]); end; { for i:=0 to 1 do for j:=0 to 1 do begin result.farben[i*(result.breite-1) + j*(result.hoehe-1)*result.breite].rgbRed:= result.farben[i*(result.breite-1) + j*(result.hoehe-1)*result.breite].rgbRed xor $ff; result.farben[i*(result.breite-1) + j*(result.hoehe-1)*result.breite].rgbGreen:= result.farben[i*(result.breite-1) + j*(result.hoehe-1)*result.breite].rgbGreen xor $ff; result.farben[i*(result.breite-1) + j*(result.hoehe-1)*result.breite].rgbBlue:= result.farben[i*(result.breite-1) + j*(result.hoehe-1)*result.breite].rgbBlue xor $ff; end; } setLength(buf,0); end; // tTransformation ************************************************************* constructor tTransformation.create; begin inherited create; fillChar(vorgaenger,sizeOf(vorgaenger),#0); fillChar(nachfolger,sizeOf(nachfolger),#0); _anzZugehoerigerDaten:=0; end; destructor tTransformation.destroy; var i: longint; begin for i:=0 to length(vorgaenger)-1 do begin vorgaenger[i].loescheNachfolger(self); zerstoereTransformationWennObsolet(vorgaenger[i]); end; setLength(vorgaenger,0); if wirdGebraucht then fehler('Ich ('+className+') werde noch gebraucht (von '+werBrauchtDas+'), da kann ich mich nicht zerstören!'); inherited destroy; end; procedure tTransformation.testeAuszerhalb(input, koordinaten: boolean; p: tExtPoint); begin testeAuszerhalb(input,koordinaten,lUnten,p['x']); testeAuszerhalb(input,koordinaten,lLinks,p['y']); end; procedure tTransformation.testeAuszerhalb(input, koordinaten: boolean; l: tLage; x: extended); begin if koordinaten then begin if input then begin if (x<0) or (x>inXSTS[paralleleRichtung[l]]-1) then fehler('Wert '+ myFloatToStr(x)+ ' liegt außerhalb des gültigen '+paralleleRichtung[l]+'-Eingabebereich (0..'+ intToStr(inXSTS[paralleleRichtung[l]]-1)+')!'); end else if (x<0) or (x>outXSTS[paralleleRichtung[l]]-1) then fehler('Wert '+ myFloatToStr(x)+ ' liegt außerhalb des gültigen '+paralleleRichtung[l]+'-Ausgabebereich (0..'+ intToStr(outXSTS[paralleleRichtung[l]]-1)+')!'); end else begin if input then begin if (xmax(inAchsen[paralleleRichtung[l],'x'],inAchsen[paralleleRichtung[l],'y'])) then fehler('Wert '+ myFloatToStr(x)+ ' liegt außerhalb des gültigen '+paralleleRichtung[l]+'-Eingabebereich ('+ myFloatToStr(min(inAchsen[paralleleRichtung[l],'x'],inAchsen[paralleleRichtung[l],'y']))+'..'+ myFloatToStr(max(inAchsen[paralleleRichtung[l],'x'],inAchsen[paralleleRichtung[l],'y']))+')!'); end else if (xmax(outAchsen[paralleleRichtung[l],'x'],outAchsen[paralleleRichtung[l],'y'])) then fehler('Wert '+ myFloatToStr(x)+ ' liegt außerhalb des gültigen '+paralleleRichtung[l]+'-Ausgabebereich ('+ myFloatToStr(min(outAchsen[paralleleRichtung[l],'x'],outAchsen[paralleleRichtung[l],'y']))+'..'+ myFloatToStr(max(outAchsen[paralleleRichtung[l],'x'],outAchsen[paralleleRichtung[l],'y']))+')!'); end; end; procedure tTransformation.holeInfosVonVorgaengern; var i: longint; begin inAchsen:=vorgaenger[0].achsen; for i:=1 to length(vorgaenger)-1 do if inAchsen <> vorgaenger[i].achsen then fehler('Vorgänger haben verschiedene Achsen, was generisch nicht zu verstehen ist!'); inXSTS:=vorgaenger[0].xStepsTSiz; for i:=1 to length(vorgaenger)-1 do if inXSTS <> vorgaenger[i].xStepsTSiz then fehler('Vorgänger haben verschiedene xSteps oder tSiz, was generisch nicht zu verstehen ist!'); if not wmiaExplizit then begin inWMia:=vorgaenger[0].wMia; inPMia:=vorgaenger[0].pMia; inZDP:=vorgaenger[0].zDP; for i:=1 to length(vorgaenger)-1 do if (inWMia <> vorgaenger[i].wMia) or (inPMia <> vorgaenger[i].pMia) or (inZDP <> vorgaenger[i].zDP) then fehler('Vorgänger haben verschiedene wmin, wmax, pmin oder pmax, was generisch nicht zu verstehen ist!'); end; end; procedure tTransformation.aktualisiereAchsen; // nicht zum direkten Aufrufen begin outAchsen:=inAchsen; end; procedure tTransformation.aktualisiereXsTs; // nicht zum direkten Aufrufen begin outXSTS:=inXSTS; end; procedure tTransformation.aktualisiereWmia; // nicht zum direkten Aufrufen begin if not wmiaExplizit then begin outWMia:=inWMia; outPMia:=inPMia; outZDP:=inZDP; end; end; function tTransformation.rXStart: extended; begin result:=outAchsen['x','x']; end; procedure tTransformation.wXStart(x: extended); begin if not (self is tKeineTransformation) then fehler('Will xStart schreiben, aber bin nicht der Anfang einer Transformationskette!'); inAchsen['x','x']:=x; aktualisiereAlles; end; function tTransformation.rXStop: extended; begin result:=outAchsen['x','y']; end; procedure tTransformation.wXStop(x: extended); begin if not (self is tKeineTransformation) then fehler('Will xStop schreiben, aber bin nicht der Anfang einer Transformationskette!'); inAchsen['x','y']:=x; aktualisiereAlles; end; function tTransformation.rTStart: extended; begin result:=outAchsen['y','x']; end; procedure tTransformation.wTStart(t: extended); begin if not (self is tKeineTransformation) then fehler('Will tStart schreiben, aber bin nicht der Anfang einer Transformationskette!'); inAchsen['y','x']:=t; aktualisiereAlles; end; function tTransformation.rTStop: extended; begin result:=outAchsen['y','y']; end; procedure tTransformation.wTStop(t: extended); begin if not (self is tKeineTransformation) then fehler('Will tStop schreiben, aber bin nicht der Anfang einer Transformationskette!'); inAchsen['y','y']:=t; aktualisiereAlles; end; function tTransformation.rWMin: extended; begin result:=outWMia['x']; end; procedure tTransformation.wWMin(w: extended); begin if (self is tAgglomeration) then begin if outWMia['x']<>w then fehler('Setzen von wMin für Agglomeration nicht erlaubt ( '+floatToStr(w)+' ≠ '+floatToStr(outWMia['x'])+' )!'); exit; end; outWMia['x']:=w; wmiaExplizit:=true; aktualisiereAlles; end; function tTransformation.rWMax: extended; begin result:=outWMia['y']; end; procedure tTransformation.wWMax(w: extended); begin if (self is tAgglomeration) then begin if outWMia['y']<>w then fehler('Setzen von wMax für Agglomeration nicht erlaubt ( '+floatToStr(w)+' ≠ '+floatToStr(outWMia['y'])+' )!'); exit; end; wmiaExplizit:=true; outWMia['y']:=w; aktualisiereAlles; end; function tTransformation.rPMin: tInt64Point; begin result:=outPMia['x']; end; procedure tTransformation.wPMin(p: tInt64Point); begin if (self is tAgglomeration) then begin if outPMia['x']<>p then fehler('Setzen von pMin für Agglomeration nicht erlaubt ( '+tInt64PointToStr(p)+' ≠ '+tInt64PointToStr(outPMia['x'])+' )!'); exit; end; outPMia['x']:=p; wmiaExplizit:=true; aktualisiereAlles; end; function tTransformation.rPMax: tInt64Point; begin result:=outPMia['y']; end; procedure tTransformation.wPMax(p: tInt64Point); begin if (self is tAgglomeration) then begin if outPMia['y']<>p then fehler('Setzen von pMax für Agglomeration nicht erlaubt ( '+tInt64PointToStr(p)+' ≠ '+tInt64PointToStr(outPMia['y'])+' )!'); exit; end; wmiaExplizit:=true; outPMia['y']:=p; aktualisiereAlles; end; function tTransformation.rZDP: tInt64Point; begin result:=outZDP; end; procedure tTransformation.wZDP(p: tInt64Point); begin if (self is tAgglomeration) then begin if zDP<>p then fehler('Setzen von zDP für Agglomeration nicht erlaubt ( '+tInt64PointToStr(p)+' ≠ '+tInt64PointToStr(zDP)+' )!'); exit; end; wmiaExplizit:=true; outZDP:=p; aktualisiereAlles; end; function tTransformation.rXSteps: longint; begin result:=outXSTS['x']; end; procedure tTransformation.wXSteps(x: longint); begin if not (self is tKeineTransformation) then fehler('Will xSteps schreiben, aber bin nicht der Anfang einer Transformationskette!'); inXSTS['x']:=x; aktualisiereAlles; end; function tTransformation.rTSiz: longint; begin result:=outXSTS['y']; end; procedure tTransformation.wTSiz(t: longint); begin if not (self is tKeineTransformation) then fehler('Will tSiz schreiben, aber bin nicht der Anfang einer Transformationskette!'); inXSTS['y']:=t; aktualisiereAlles; end; procedure tTransformation.erhoeheZugehoerigkeitsanzahl; begin inc(_anzZugehoerigerDaten); end; procedure tTransformation.verringereZugehoerigkeitsanzahl; begin if _anzZugehoerigerDaten<=0 then fehler('Die Anzahl zugehöroger Daten ist angeblich negativ!'); dec(_anzZugehoerigerDaten); end; procedure tTransformation.fuegeNachfolgerHinzu(tr: tTransformation); begin if assigned(tr) then begin setLength(nachfolger,length(nachfolger)+1); nachfolger[length(nachfolger)-1]:=tr; end; end; procedure tTransformation.loescheNachfolger(tr: tTransformation); var i,j: longint; begin for i:=0 to length(nachfolger)-1 do if nachfolger[i]=tr then begin for j:=i+1 to length(nachfolger)-1 do nachfolger[j-1]:=nachfolger[j]; setLength(nachfolger,length(nachfolger)-1); exit; end; fehler('Kann zu löschenden Nachfolger nicht finden!'); end; procedure tTransformation.fuegeVorgaengerHinzu(tr: tTransformation); begin if assigned(tr) then begin setLength(vorgaenger,length(vorgaenger)+1); vorgaenger[length(vorgaenger)-1]:=tr; tr.fuegeNachfolgerHinzu(self); end; aktualisiereAlles; end; procedure tTransformation.loescheVorgaenger(tr: tTransformation); var i,j: longint; begin for i:=0 to length(vorgaenger)-1 do if vorgaenger[i]=tr then begin for j:=i+1 to length(vorgaenger)-1 do vorgaenger[j-1]:=vorgaenger[j]; setLength(vorgaenger,length(vorgaenger)-1); tr.loescheNachfolger(self); exit; end; fehler('Kann zu löschenden Vorgänger nicht finden!'); end; function tTransformation.wirdGebraucht: boolean; begin result:=(length(nachfolger)>0) or (_anzZugehoerigerDaten>0); end; procedure tTransformation.aktualisiereAlles; // (inkl. Informieren der Nachfolger) var i: longint; begin holeInfosVonVorgaengern; aktualisiereAchsen; aktualisiereWmia; aktualisiereXsTs; for i:=0 to length(nachfolger)-1 do nachfolger[i].aktualisiereAlles; end; function tTransformation.ersetzeAnfangDurch(tr: tTransformation): boolean; begin result:=false; if length(vorgaenger)<>1 then begin gibAus('Kann Anfang von Transformation nicht ersetzen, da nicht genau ein Vorgänger!',3); exit; end; if vorgaenger[0] is tKeineTransformation then begin vorgaenger[0].loescheNachfolger(self); zerstoereTransformationWennObsolet(vorgaenger[0]); vorgaenger[0]:=tr; vorgaenger[0].fuegeNachfolgerHinzu(self); result:=true; aktualisiereAlles; end else result:=vorgaenger[0].ersetzeAnfangDurch(tr); end; function tTransformation.beliebigerVorgaenger: tTransformation; begin if length(vorgaenger)=0 then begin gibAus('Es gibt keinen Vorgänger, daher kann ich keinen belibigen Vorgänger auswählen!',3); exit; end; result:=vorgaenger[0]; end; function tTransformation.werBrauchtDas: string; var i: longint; begin if _anzZugehoerigerDaten>0 then result:=' '+intToStr(_anzZugehoerigerDaten)+' Daten' else result:=''; for i:=0 to length(nachfolger)-1 do begin result:=result+' '+nachfolger[i].className; if nachfolger[i].wirdGebraucht then result:=result+' (von'+nachfolger[i].werBrauchtDas+')'; end; end; function tTransformation.transformiereKoordinatenEinzeln(const p: tExtPoint; auszerhalbIstFehler: boolean = true): tExtPoint; begin if auszerhalbIstFehler then testeAuszerhalb(true,true,p); result:=p; if auszerhalbIstFehler then testeAuszerhalb(false,true,result); end; function tTransformation.transformiereKoordinatenEinzelnInvers(const p: tExtPoint; auszerhalbIstFehler: boolean = true): tExtPoint; begin if auszerhalbIstFehler then testeAuszerhalb(false,true,p); result:=p; if auszerhalbIstFehler then testeAuszerhalb(true,true,result); end; function tTransformation.transformiereAchseEinzeln(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; begin // generisch passiert nichts mit der Achsenbeschriftung if auszerhalbIstFehler then testeAuszerhalb(true,false,l,x); result:=x; if auszerhalbIstFehler then testeAuszerhalb(false,false,l,result); end; function tTransformation.transformiereAchseEinzelnInvers(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; begin // generisch passiert nichts mit der Achsenbeschriftung if auszerhalbIstFehler then testeAuszerhalb(false,false,l,x); result:=x; if auszerhalbIstFehler then testeAuszerhalb(true,false,l,result); end; function tTransformation.transformiereKoordinaten(const p: tExtPoint; const tiefe: longint = -1): tExtPoint; begin if (length(vorgaenger)>0) and (tiefe<>0) then result:=beliebigerVorgaenger.transformiereKoordinaten(p,tiefe-1) else result:=p; result:=transformiereKoordinatenEinzeln(result); end; function tTransformation.transformiereKoordinaten(const x,y: longint; const tiefe: longint = -1): tExtPoint; var p: tExtPoint; begin p['x']:=x; p['y']:=y; result:=transformiereKoordinaten(p,tiefe); end; function tTransformation.transformiereKoordinatenInvers(const p: tExtPoint; const tiefe: longint = -1): tExtPoint; begin result:=transformiereKoordinatenEinzelnInvers(p); if (length(vorgaenger)>0) and (tiefe<>0) then result:=beliebigerVorgaenger.transformiereKoordinaten(result,tiefe-1); end; function tTransformation.wertZuPositionAufAchse(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; var c,d: char; p: tExtPoint; begin if auszerhalbIstFehler then testeAuszerhalb(false,false,l,x); // das generische Verhalten ist c:=paralleleRichtung[l]; d:=senkrechteRichtung[l]; // zuerst den Wert zu transformieren x:=transformiereAchseEinzelnInvers(l,x,auszerhalbIstFehler); // dann den Vorgänger nach der Position zu fragen p[c]:=beliebigerVorgaenger.wertZuPositionAufAchse(l,x,auszerhalbIstFehler); p[d]:=byte(l in [lRechts,lOben]); // in Koordinaten umzurechnen for d:='x' to 'y' do p[d]:=p[d] * (inXSTS[d]-1); // zu transformieren p:=transformiereKoordinatenEinzeln(p,auszerhalbIstFehler); // und in Anteile zurückzurechnen result:=p[c]/(outXSTS[c]-1+byte(outXSTS[c]=1)); if auszerhalbIstFehler then testeAuszerhalb(false,true,l,result); end; function tTransformation.positionAufAchseZuWert(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; var c,d: char; p: tExtPoint; begin if auszerhalbIstFehler then testeAuszerhalb(false,true,l,x); // das generische Verhalten ist invers zu oben: c:=paralleleRichtung[l]; d:=senkrechteRichtung[l]; // Anteile setzen p[c]:=x; p[d]:=byte(l in [lRechts,lOben]); // in Koordinaten umrechnen for d:='x' to 'y' do p[d]:=p[d] * (outXSTS[d]-1); // transformieren p:=transformiereKoordinatenEinzelnInvers(p,auszerhalbIstFehler); // und in Anteile zurückrechnen p[c]:=p[c]/(inXSTS[c]-1); // vom Vorgänger weiter berechnen lassen result:=beliebigerVorgaenger.positionAufAchseZuWert(l,p[c],auszerhalbIstFehler); // und den Wert transformieren result:=transformiereAchseEinzeln(l,result,auszerhalbIstFehler); if auszerhalbIstFehler then testeAuszerhalb(false,false,l,result); end; function tTransformation.transformiereWertEinzeln(const x: extended): extended; begin result:=x; end; function tTransformation.transformiereWert(const x: extended; const tiefe: longint = -1): extended; begin if (length(vorgaenger)>0) and (tiefe<>0) then result:=beliebigerVorgaenger.transformiereWert(x,tiefe-1) else result:=x; result:=transformiereWertEinzeln(result); end; function tTransformation.dumpParams: string; begin result:=t2x2ExtendedToStr(inAchsen)+' -> '+t2x2ExtendedToStr(outAchsen); end; function tTransformation.dumpParams(tiefe: longint): string; var i: longint; begin if tiefe=0 then result:='' else for i:=0 to length(vorgaenger)-1 do begin if length(vorgaenger)>1 then result:=result+lf+'< '+intToStr(i)+' >'; result:=result+lf+vorgaenger[i].dumpParams(tiefe-1); end; result:=result+intToStr(tiefe+1)+': '+dumpParams; end; // tKeineTransformation ******************************************************** procedure tKeineTransformation.holeInfosVonVorgaengern; begin end; function tKeineTransformation.wertZuPositionAufAchse(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; var c: char; begin if auszerhalbIstFehler then testeAuszerhalb(false,false,l,x); // ein Wert am Anfang ist einfach linear zu interpolieren c:=paralleleRichtung[l]; if x=outAchsen[c,'x'] then result:=0 else result:=(x-outAchsen[c,'x'])/(outAchsen[c,'y']-outAchsen[c,'x'])*(1-1/outXSTS[c]); if auszerhalbIstFehler then testeAuszerhalb(false,true,l,result); end; function tKeineTransformation.positionAufAchseZuWert(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; var c: char; begin if auszerhalbIstFehler then testeAuszerhalb(false,true,l,x); // ein Wert am Anfang ist einfach linear zu interpolieren c:=paralleleRichtung[l]; if x=0 then result:=outAchsen[c,'x'] else result:=x/(1-1/outXSTS[c])*(outAchsen[c,'y']-outAchsen[c,'x'])+outAchsen[c,'x']; if auszerhalbIstFehler then testeAuszerhalb(false,false,l,result); end; // tIdentitaet ***************************************************************** constructor tIdentitaet.create(original: tTransformation); begin inherited create; fuegeVorgaengerHinzu(original); end; // tUeberlagerung ************************************************************** constructor tUeberlagerung.create; begin inherited create; wmiaExplizit:=true; // nicht sinnvoll berechenbar end; procedure tUeberlagerung.addKomponente(tr: tTransformation); begin fuegeVorgaengerHinzu(tr); end; // tFFTTransformation ********************************************************** constructor tFFTTransformation.create; begin inherited create; horizontal:=false; vertikal:=false; horizontalZentrieren:=false; vertikalZentrieren:=false; end; constructor tFFTTransformation.create(vorg: tTransformation; hor,ver,hZnt,vZnt: boolean); begin inherited create; horizontal:=hor; vertikal:=ver; horizontalZentrieren:=hZnt; vertikalZentrieren:=vZnt; fuegeVorgaengerHinzu(vorg); end; procedure tFFTTransformation.aktualisiereAchsen; var c: char; begin if horizontal then begin outAchsen['x','x']:=0; outAchsen['x','y']:=(inXSTS['x']-1)/(inAchsen['x','y']-inAchsen['x','x']); if horizontalZentrieren then begin outAchsen['x','x']:=-outAchsen['x','y']/2; outAchsen['x','y']:=outAchsen['x','y']+outAchsen['x','x']; end; end else for c:='x' to 'y' do outAchsen['x',c]:=inAchsen['x',c]; if vertikal then begin outAchsen['y','x']:=0; outAchsen['y','y']:=(inXSTS['y']-1)/(inAchsen['y','y']-inAchsen['y','x']); if vertikalZentrieren then begin outAchsen['y','x']:=-outAchsen['y','y']/2; outAchsen['y','y']:=outAchsen['y','y']+outAchsen['y','x']; end; end else for c:='x' to 'y' do outAchsen['y',c]:=inAchsen['y',c]; end; function tFFTTransformation.wertZuPositionAufAchse(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; var c: char; begin if auszerhalbIstFehler then testeAuszerhalb(false,false,l,x); if ((l in [lOben,lUnten]) and not horizontal) or // untransformierte Achse? ((not (l in [lOben,lUnten])) and not vertikal) then result:=inherited wertZuPositionAufAchse(l,x,auszerhalbIstFehler) // Vorfahren befragen else begin // egal, wie die Werte vor der FFT aussahen, wir setzen die Frequenzen danach linear c:=paralleleRichtung[l]; if x=outAchsen[c,'x'] then result:=0 else result:=(x-outAchsen[c,'x'])/(outAchsen[c,'y']-outAchsen[c,'x']); result:=result*(1-1/outXSTS[c]); end; if auszerhalbIstFehler then testeAuszerhalb(false,true,l,result); end; function tFFTTransformation.positionAufAchseZuWert(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; var c: char; begin if auszerhalbIstFehler then testeAuszerhalb(false,true,l,x); if ((l in [lOben,lUnten]) and not horizontal) or // untransformierte Achse? ((not (l in [lOben,lUnten])) and not vertikal) then result:=inherited positionAufAchseZuWert(l,x,auszerhalbIstFehler) // Vorfahren befragen else begin // egal, wie die Werte vor der FFT aussahen, wir setzen die Frequenzen danach linear c:=paralleleRichtung[l]; if x=0 then result:=outAchsen[c,'x'] else result:=x/(1-1/outXSTS[c])*(outAchsen[c,'y']-outAchsen[c,'x'])+outAchsen[c,'x']; end; if auszerhalbIstFehler then testeAuszerhalb(false,false,l,result); end; function tFFTTransformation.dumpParams: string; begin result:='FFT: '; if horizontal then begin result:=result+'h'; if horizontalZentrieren then result:=result+'(z)'; end; if vertikal then begin result:=result+'v'; if vertikalZentrieren then result:=result+'(z)'; end; result:=result + ' ' + inherited dumpParams; end; // tRTVorbereitungsTransformation ********************************************** constructor tRTVorbereitungsTransformation.create; begin inherited create; end; constructor tRTVorbereitungsTransformation.create(vorg: tTransformation); begin inherited create; fuegeVorgaengerHinzu(vorg); end; procedure tRTVorbereitungsTransformation.aktualisiereAchsen; var c: char; begin for c:='x' to 'y' do begin outAchsen[c,'x']:=inAchsen[c,'x']; // TODO: vllt. zentrieren? outAchsen[c,'y']:=outAchsen[c,'x'] + (inAchsen[c,'y'] - inAchsen[c,'x']) * outXSTS[c]/inXSTS[c]; end; end; procedure tRTVorbereitungsTransformation.aktualisiereXsTs; begin outXSTS['x']:=round(power(2,ceil(ln(3*max(inXSTS['x'],inXSTS['y']))/ln(2)))); outXSTS['y']:=outXSTS['x']; aktualisiereAchsen; end; function tRTVorbereitungsTransformation.wertZuPositionAufAchse(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; var c: char; begin if auszerhalbIstFehler then testeAuszerhalb(false,false,l,x); // egal, wie die Werte vor der RTV aussahen, wir setzen sie danach linear c:=paralleleRichtung[l]; if x=outAchsen[c,'x'] then result:=0 else result:=(x-outAchsen[c,'x'])/(outAchsen[c,'y']-outAchsen[c,'x']); result:=result*(1-1/outXSTS[c]); if auszerhalbIstFehler then testeAuszerhalb(false,true,l,result); end; function tRTVorbereitungsTransformation.positionAufAchseZuWert(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; var c: char; begin if auszerhalbIstFehler then testeAuszerhalb(false,true,l,x); // egal, wie die Werte vor der RTV aussahen, wir setzen sie danach linear c:=paralleleRichtung[l]; if x=0 then result:=outAchsen[c,'x'] else result:=x/(1-1/outXSTS[c])*(outAchsen[c,'y']-outAchsen[c,'x'])+outAchsen[c,'x']; if auszerhalbIstFehler then testeAuszerhalb(false,false,l,result); end; function tRTVorbereitungsTransformation.dumpParams: string; begin result:='RTvb ' + inherited dumpParams; end; // tRTLineOutTransformation **************************************************** constructor tRTLineOutTransformation.create; begin inherited create; winkelSchritte:=180; end; constructor tRTLineOutTransformation.create(vorg: tTransformation; ws: int64); begin inherited create; winkelSchritte:=ws; fuegeVorgaengerHinzu(vorg); end; procedure tRTLineOutTransformation.aktualisiereAchsen; begin outAchsen['x','y']:=pi*(1-1/winkelSchritte)/2; // Winkel von pi/2 outAchsen['x','x']:=-outAchsen['x','y']; // bis -pi/2 // Vorsicht, Willkür! (Ergebnis müsste aber für x gleich sein) outAchsen['y','y']:=(inAchsen['y','y']-inAchsen['y','x'])*outXSTS['y']/inXSTS['y']/2; // dY bleibt erhalten outAchsen['y','x']:=-outAchsen['y','y']; end; procedure tRTLineOutTransformation.aktualisiereXsTs; begin outXSTS['x']:=winkelSchritte; outXSTS['y']:=round(sqrt(inXSTS*inXSTS)/2); aktualisiereAchsen; end; function tRTLineOutTransformation.wertZuPositionAufAchse(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; var c: char; begin if auszerhalbIstFehler then testeAuszerhalb(false,false,l,x); // egal, wie die Werte vor der RT aussahen, wir setzen sie danach linear c:=paralleleRichtung[l]; if x=outAchsen[c,'x'] then result:=0 else result:=(x-outAchsen[c,'x'])/(outAchsen[c,'y']-outAchsen[c,'x']); result:=result*(1-1/outXSTS[c]); if auszerhalbIstFehler then testeAuszerhalb(false,true,l,result); end; function tRTLineOutTransformation.positionAufAchseZuWert(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; var c: char; begin if auszerhalbIstFehler then testeAuszerhalb(false,true,l,x); // egal, wie die Werte vor der RT aussahen, wir setzen sie danach linear c:=paralleleRichtung[l]; if x=0 then result:=outAchsen[c,'x'] else result:=x/(1-1/outXSTS[c])*(outAchsen[c,'y']-outAchsen[c,'x'])+outAchsen[c,'x']; if auszerhalbIstFehler then testeAuszerhalb(false,false,l,result); end; function tRTLineOutTransformation.dumpParams: string; begin result:='RTlo: '+intToStr(winkelSchritte); result:=result + ' ' + inherited dumpParams; end; // tAK2dTransformation ********************************************************* constructor tAK2dTransformation.create; var c: char; begin inherited create; for c:='x' to 'y' do spiegeln[c]:=false; end; constructor tAK2dTransformation.create(vorg: tTransformation; hoS,veS: boolean); begin inherited create; spiegeln['x']:=hoS; spiegeln['y']:=veS; fuegeVorgaengerHinzu(vorg); end; procedure tAK2dTransformation.aktualisiereAchsen; var c: char; begin for c:='x' to 'y' do if spiegeln[c] then begin outAchsen[c,'x']:=0; outAchsen[c,'y']:=inAchsen[c,'y']-inAchsen[c,'x']; end else begin outAchsen[c,'x']:=inAchsen[c,'x']-inAchsen[c,'y']; outAchsen[c,'y']:=inAchsen[c,'y']-inAchsen[c,'x']; end; end; procedure tAK2dTransformation.aktualisiereXsTs; var c: char; begin for c:='x' to 'y' do outXSTS[c]:=2*inXSTS[c]; end; function tAK2dTransformation.wertZuPositionAufAchse(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; var c: char; begin if auszerhalbIstFehler then testeAuszerhalb(false,false,l,x); // egal, wie die Werte vor der AK aussahen, wir setzen sie danach linear c:=paralleleRichtung[l]; if x=outAchsen[c,'x'] then result:=0 else result:=(x-outAchsen[c,'x'])/(outAchsen[c,'y']-outAchsen[c,'x']); result:=result*(1-1/outXSTS[c]); if auszerhalbIstFehler then testeAuszerhalb(false,true,l,result); end; function tAK2dTransformation.positionAufAchseZuWert(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; var c: char; begin if auszerhalbIstFehler then testeAuszerhalb(false,true,l,x); // egal, wie die Werte vor der AK aussahen, wir setzen die Frequenzen danach linear c:=paralleleRichtung[l]; if x=0 then result:=outAchsen[c,'x'] else result:=x/(1-1/outXSTS[c])*(outAchsen[c,'y']-outAchsen[c,'x'])+outAchsen[c,'x']; if auszerhalbIstFehler then testeAuszerhalb(false,false,l,result); end; function tAK2dTransformation.dumpParams: string; var c: char; begin result:='AK: '; for c:='x' to 'y' do if spiegeln[c] then result:=result+c; result:=result + ' ' + inherited dumpParams; end; // tSpiegelungsTransformation ************************************************** constructor tSpiegelungsTransformation.create; begin inherited create; end; constructor tSpiegelungsTransformation.create(vorg: tTransformation); begin inherited create; fuegeVorgaengerHinzu(vorg); end; function tSpiegelungsTransformation.transformiereKoordinatenEinzeln(const p: tExtPoint; auszerhalbIstFehler: boolean = true): tExtPoint; begin if auszerhalbIstFehler then testeAuszerhalb(true,true,p); result['x']:=inXSTS['x']-1-p['x']; result['y']:=p['y']; if auszerhalbIstFehler then testeAuszerhalb(false,true,result); end; function tSpiegelungsTransformation.transformiereKoordinatenEinzelnInvers(const p: tExtPoint; auszerhalbIstFehler: boolean = true): tExtPoint; begin if auszerhalbIstFehler then testeAuszerhalb(false,true,p); result['x']:=inXSTS['x']-1-p['x']; result['y']:=p['y']; if auszerhalbIstFehler then testeAuszerhalb(true,true,result); end; function tSpiegelungsTransformation.dumpParams: string; begin result:='horizontale Spiegelung ' + inherited dumpParams; end; // tKonkreteKoordinatenTransformation ****************************************** constructor tKonkreteKoordinatenTransformation.create; var c,d: char; begin for c:='x' to 'y' do begin for d:='x' to 'y' do begin lin[c,d]:=byte(c=d); lnInt[c,d]:=0; expExp[c,d]:=0; end; off[c]:=0; lnFak[c]:=0; expFak[c]:=0; lnOff[c]:=1; end; end; function tKonkreteKoordinatenTransformation.findeLineareParameter(syntaxTest: boolean; auszenSkala: char; s: string; xScale,yScale: extended; var off,xl,yl: extended; ueberschreiben: boolean; etf: tExprToFloat): boolean; var t: string; c: char; tmp: extended; begin result:=false; if ueberschreiben then begin off:=0; xl:=0; yl:=0; end; while length(s)>0 do begin t:=leftStr(s,max(binOpPos('+',s),binOpPos('-',s))-1); if (binOpPos('+',t)>0) or (binOpPos('-',t)>0) then t:=leftStr(s,min(binOpPos('+',s),binOpPos('-',s))-1); if t='' then begin t:=s; s:=''; end else delete(s,1,length(t)); if t='' then exit; c:=rightStr(t,1)[1]; if c in ['x','y'] then delete(t,length(t),1); if leftStr(t,1)='+' then delete(t,1,1); if t='' then tmp:=1 else if t='-' then tmp:=-1 else try tmp:=etf(syntaxTest,t); case c of 'x': tmp:=tmp*xScale; 'y': tmp:=tmp*yScale; end; case auszenSkala of 'x': tmp:=tmp/xScale; 'y': tmp:=tmp/yScale; end; except exit; end; case c of 'x': xl:=xl+tmp; 'y','t': yl:=yl+tmp; else off:=off+tmp; end{of case}; end; result:=true; end; function tKonkreteKoordinatenTransformation.transformiereKoordinatenEinzeln(const p: tExtPoint; auszerhalbIstFehler: boolean = true): tExtPoint; var c,d: char; lt,et: extended; begin if auszerhalbIstFehler then testeAuszerhalb(true,true,p); for c:='x' to 'y' do begin result[c]:=off[c]; lt:=lnOff[c]; et:=0; for d:='x' to 'y' do begin result[c]:= result[c] + p[d]*lin[c,d]; lt:=lt+p[d]*lnInt[c,d]; et:=et+p[d]*expExp[c,d]; end; result[c]:= result[c] + lnFak[c] * ln(lt) + expFak[c] * exp(et); end; if auszerhalbIstFehler then testeAuszerhalb(false,true,result); end; function tKonkreteKoordinatenTransformation.transformiereKoordinatenEinzelnInvers(const p: tExtPoint; auszerhalbIstFehler: boolean = true): tExtPoint; begin if auszerhalbIstFehler then testeAuszerhalb(false,true,p); fehler('tKonkreteKoordinatenTransformation: transformiereKoordinatenEinzelnInvers kann es nicht geben, weil transformiereKoordinatenEinzeln nicht umkehrbar sein muss!'); result:=extPoint(0,0); if auszerhalbIstFehler then testeAuszerhalb(true,true,result); end; function tKonkreteKoordinatenTransformation.initAbbildung(syntaxTest: boolean; s: string; xScale,yScale: extended; etf: tExprToFloat): boolean; var c,d: char; i: longint; t,u,v: string; tmp: extended; begin result:=false; if not assigned(etf) then exit; for c:='x' to 'y' do begin for d:='x' to 'y' do begin lin[c,d]:=0; lnInt[c,d]:=0; expExp[c,d]:=0; end; off[c]:=0; lnFak[c]:=0; expFak[c]:=0; lnOff[c]:=1; end; while pos(' ',s)>0 do delete(s,pos(' ',s),1); if (not startetMit('(',s)) or (not endetMit(')',s)) then exit; if pos(';',s)=0 then exit; t:=erstesArgument(s,';'); if (t='') or (s='') then exit; for c:='x' to 'y' do begin while pos('(',t)>0 do begin u:=t; delete(u,1,pos('(',u)); if pos(')',u)=0 then exit; u:=leftStr(u,pos(')',u)-1); i:=pos('(',t); while (i>=1) and not (t[i] in ['+','-']) do dec(i); if i=0 then i:=1; v:=copy(t,i,pos('(',t)-i-3); if leftStr(v,1)='+' then delete(v,1,1); if v='' then tmp:=1 else if v='-' then tmp:=-1 else try tmp:=etf(syntaxTest,v); if c='x' then tmp:=tmp/xScale else tmp:=tmp/yScale; except exit; end; if copy(t,pos('(',t)-3,3)='log' then begin lnFak[c]:=tmp; if not findeLineareParameter(syntaxTest,' ',u,xScale,yScale,lnOff[c],lnInt[c,'x'],lnInt[c,'y'],true,etf) then exit; end else if copy(t,pos('(',t)-3,3)='exp' then begin expFak[c]:=tmp; tmp:=0; if not findeLineareParameter(syntaxTest,' ',u,xScale,yScale,tmp,expExp[c,'x'],expExp[c,'y'],true,etf) then exit; if tmp<>0 then exit; end else exit; delete(t,i,pos(')',t)-i+1); end; if t<>'' then if not findeLineareParameter(syntaxTest,c,t,xScale,yScale,off[c],lin[c,'x'],lin[c,'y'],false,etf) then exit; t:=s; end; result:=true; end; function tKonkreteKoordinatenTransformation.dumpParams: string; var c,d: char; begin result:=''; for c:='x' to 'y' do begin result:=result+lf+c+' = '; if off[c]<>0 then result:=result + floatToStr(off[c]) + ' '; for d:='x' to 'y' do if lin[c,d]<>0 then result:=result + '+ ' + floatToStr(lin[c,d]) + ' ' + d + ' '; if lnFak[c]<>0 then begin result:=result + '+ ' + floatToStr(lnFak[c])+' log ( '; if lnOff[c]<>0 then result:=result + floatToStr(lnOff[c]) + ' '; for d:='x' to 'y' do if lnInt[c,d]<>0 then result:=result + '+ ' + floatToStr(lnInt[c,d]) + ' ' + d + ' '; result:=result + ') '; end; if expFak[c]<>0 then begin result:=result + '+ ' + floatToStr(expFak[c])+' exp ( '; for d:='x' to 'y' do if expExp[c,d]<>0 then result:=result + '+ ' + floatToStr(expExp[c,d]) + ' ' + d + ' '; result:=result + ') '; end; end; delete(result,1,2); result:=result + ' ' + inherited dumpParams; end; function tKonkreteKoordinatenTransformation.zielausdehnung: t2x2Longint; var RandPkt: tExtPoint; i,j,k: longint; c,d: char; begin for c:='x' to 'y' do for d:='x' to 'y' do result[c,d]:=-1; for k:=0 to 1 do for i:=0 to (inXSTS['x']*(1-k)+inXSTS['y']*k)-1 do for j:=0 to 1 do begin RandPkt:=transformiereKoordinaten( i*(1-k) + j*k*(inXSTS['x']-1), j*(1-k)*(inXSTS['y']-1) + i*k); for c:='x' to 'y' do for d:='x' to 'y' do if ((i=0) and (j=0)) or ((d='y') xor (result[c,d]>floor(RandPkt[c]) + byte(d='y'))) then result[c,d]:=floor(RandPkt[c]) + byte(d='y'); end; end; procedure tKonkreteKoordinatenTransformation.aktualisiereXsTs; var gr: t2x2Longint; c: char; begin gr:=zielausdehnung; for c:='x' to 'y' do outXSTS[c]:=gr[c,'y']-gr[c,'x']+1; end; // tLineareAchsenVerzerrTransformation ***************************************** procedure tLineareAchsenVerzerrTransformation.aktualisiereAchsen; var c,d: char; begin for c:='x' to 'y' do for d:='x' to 'y' do outAchsen[c,d]:=(inAchsen[c,d] + offset[c])*fak[c]; end; function tLineareAchsenVerzerrTransformation.transformiereAchseEinzeln(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; begin if auszerhalbIstFehler then testeAuszerhalb(true,false,l,x); result:=(x + offset[paralleleRichtung[l]]) * fak[paralleleRichtung[l]]; if auszerhalbIstFehler then testeAuszerhalb(false,false,l,result); end; function tLineareAchsenVerzerrTransformation.transformiereAchseEinzelnInvers(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; begin if auszerhalbIstFehler then testeAuszerhalb(false,false,l,x); result:=x/fak[paralleleRichtung[l]] - offset[paralleleRichtung[l]]; if auszerhalbIstFehler then testeAuszerhalb(true,false,l,result); end; constructor tLineareAchsenVerzerrTransformation.create(vg: tTransformation); var c: char; begin inherited create; for c:='x' to 'y' do begin fak[c]:=1; offset[c]:=0; end; fuegeVorgaengerHinzu(vg); aktualisiereAchsen; end; function tLineareAchsenVerzerrTransformation.dumpParams: string; begin result:='+ ' + tExtPointToStr(offset) + ' * ' + tExtPointToStr(fak) + ' ' + inherited dumpParams; end; // tGroeszenVerdopplungsTransformation ***************************************** constructor tGroeszenVerdopplungsTransformation.create(vorg: tTransformation; hor,ver: boolean); begin inherited create; fuegeVorgaengerHinzu(vorg); _horizontal:=hor; _vertikal:=ver; aktualisiereXsTs; aktualisiereAchsen; end; procedure tGroeszenVerdopplungsTransformation.wHorizontal(h: boolean); begin _horizontal:=h; aktualisiereXsTs; aktualisiereAchsen; end; procedure tGroeszenVerdopplungsTransformation.wVertikal(v: boolean); begin _vertikal:=v; aktualisiereXsTs; aktualisiereAchsen; end; procedure tGroeszenVerdopplungsTransformation.aktualisiereAchsen; begin outAchsen:=inAchsen; if horizontal then outAchsen['x','y']:=2*outAchsen['x','y']-outAchsen['x','x']; if vertikal then outAchsen['y','y']:=2*outAchsen['y','y']-outAchsen['y','x']; end; procedure tGroeszenVerdopplungsTransformation.aktualisiereXsTs; begin outXSTS:=inXSTS; if horizontal then outXSTS['x']:=2*outXSTS['x']; if vertikal then outXSTS['y']:=2*outXSTS['y']; end; function tGroeszenVerdopplungsTransformation.wertZuPositionAufAchse(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; var extra,faktor: extended; begin if auszerhalbIstFehler then testeAuszerhalb(false,false,l,x); if (((l in [lOben,lUnten]) and horizontal) or // wenn in der abgefragten Richtung ((l in [lLinks,lRechts]) and vertikal)) then begin // verdoppelt wurde faktor:=0.5; // wird gestaucht if x > inAchsen[paralleleRichtung[l],'y'] then begin // wenn der Wert in der 2. Hälfte liegt // dann verschieben wir den Wert um die Hälfte x:=x-(inAchsen[paralleleRichtung[l],'y']-inAchsen[paralleleRichtung[l],'x']) * (1+1/(inXSTS[paralleleRichtung[l]]-1)); // und addieren diese danach wieder extra:=0.5; end else extra:=0; end else begin extra:=0; faktor:=1; end; result:=faktor*beliebigerVorgaenger.wertZuPositionAufAchse(l,x,auszerhalbIstFehler) + extra; if auszerhalbIstFehler then testeAuszerhalb(false,true,l,result); end; function tGroeszenVerdopplungsTransformation.positionAufAchseZuWert(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; var extra: extended; begin if auszerhalbIstFehler then testeAuszerhalb(false,true,l,x); if (((l in [lOben,lUnten]) and horizontal) or // wenn in der abgefragten Richtung ((l in [lLinks,lRechts]) and vertikal)) then begin // verdoppelt wurde x:=x*2; // wird gestreckt if x>=1 then begin // wenn der Wert in der 2. Hälfte liegt // dann verschieben wir den Wert um die Hälfte x:=x-1; // und addieren diese danach wieder extra:=(inAchsen[paralleleRichtung[l],'y']-inAchsen[paralleleRichtung[l],'x'])*(1+1/(inXSTS[paralleleRichtung[l]]-1)); end else extra:=0; end else extra:=0; result:=beliebigerVorgaenger.wertZuPositionAufAchse(l,x,auszerhalbIstFehler) + extra; if auszerhalbIstFehler then testeAuszerhalb(false,false,l,result); end; function tGroeszenVerdopplungsTransformation.dumpParams: string; begin result:=inherited dumpParams; if horizontal then result:='horizontal verdoppeln, '+result; if horizontal then result:='vertikal verdoppeln, '+result; end; // tLambdaZuOmegaTransformation ************************************************ constructor tLambdaZuOmegaTransformation.create; begin create(2*pi*299792458); end; constructor tLambdaZuOmegaTransformation.create(faktor: extended); begin inherited create; _horizontal:=false; _vertikal:=false; _faktor:=faktor; aktualisiereAchsen; end; function tLambdaZuOmegaTransformation.transformiereAchseEinzeln(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; begin if auszerhalbIstFehler then testeAuszerhalb(true,false,l,x); if ((l in [lOben,lUnten]) and horizontal) or // transformierte Achse? ((l in [lLinks,lRechts]) and vertikal) then result:=_faktor/x else result:=x; if auszerhalbIstFehler then testeAuszerhalb(false,false,l,result); end; function tLambdaZuOmegaTransformation.transformiereAchseEinzelnInvers(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; begin if auszerhalbIstFehler then testeAuszerhalb(false,false,l,x); if ((l in [lOben,lUnten]) and horizontal) or // transformierte Achse? ((l in [lLinks,lRechts]) and vertikal) then result:=_faktor/x else result:=x; if auszerhalbIstFehler then testeAuszerhalb(true,false,l,result); end; procedure tLambdaZuOmegaTransformation.wHorizontal(h: boolean); begin _horizontal:=h; aktualisiereAlles; end; procedure tLambdaZuOmegaTransformation.wVertikal(v: boolean); begin _vertikal:=v; aktualisiereAlles; end; function tLambdaZuOmegaTransformation.verhaeltnisHorizontal: extended; begin if horizontal then result:=inAchsen['x','x']/(inAchsen['x','y']-inAchsen['x','x']) else result:=0; end; function tLambdaZuOmegaTransformation.verhaeltnisVertikal: extended; begin if vertikal then result:=inAchsen['y','x']/(inAchsen['y','y']-inAchsen['y','x']) else result:=0; end; procedure tLambdaZuOmegaTransformation.aktualisiereAchsen; var c: char; begin if horizontal then begin outAchsen['x','x']:=_faktor/inAchsen['x','y']; outAchsen['x','y']:=_faktor/inAchsen['x','x']; end else for c:='x' to 'y' do outAchsen['x',c]:=inAchsen['x',c]; if vertikal then begin outAchsen['y','x']:=_faktor/inAchsen['y','y']; outAchsen['y','y']:=_faktor/inAchsen['y','x']; end else for c:='x' to 'y' do outAchsen['y',c]:=inAchsen['y',c]; end; function tLambdaZuOmegaTransformation.transformiereKoordinatenEinzeln(const p: tExtPoint; auszerhalbIstFehler: boolean = true): tExtPoint; var verh: extended; begin if auszerhalbIstFehler then testeAuszerhalb(true,true,p); if horizontal then begin verh:=verhaeltnisHorizontal; result['x']:= (inXSTS['x']-1-p['x'])/ (p['x']/verh/(inXSTS['x']-1)+1); end else result['x']:=p['x']; if vertikal then begin verh:=verhaeltnisVertikal; result['y']:= (inXSTS['y']-1-p['y'])/ (p['y']/verh/(inXSTS['y']-1)+1); end else result['y']:=p['y']; if auszerhalbIstFehler then testeAuszerhalb(false,true,result); end; function tLambdaZuOmegaTransformation.transformiereKoordinatenEinzelnInvers(const p: tExtPoint; auszerhalbIstFehler: boolean = true): tExtPoint; var verh: extended; begin if auszerhalbIstFehler then testeAuszerhalb(false,true,p); if horizontal then begin verh:=verhaeltnisHorizontal; result['x']:= (inXSTS['x']-1-p['x'])/ (p['x']/verh/(inXSTS['x']-1)+1); end else result['x']:=p['x']; if vertikal then begin verh:=verhaeltnisVertikal; result['y']:= (inXSTS['y']-1-p['y'])/ (p['y']/verh/(inXSTS['y']-1)+1); end else result['y']:=p['y']; if auszerhalbIstFehler then testeAuszerhalb(true,true,result); end; function tLambdaZuOmegaTransformation.dumpParams: string; begin result:=''; if horizontal then result:='horizontal'; if vertikal then result:=result+' und vertikal'; startetMit(' und ',result); result:=result+' ('+floatToStr(_faktor)+')'; result:=result + ' ' + inherited dumpParams; end; // tKoordinatenAusschnitt ****************************************************** constructor tKoordinatenAusschnitt.create; var c,d: char; begin inherited create; for c:='x' to 'y' do for d:='x' to 'y' do gr[c,d]:=0; end; constructor tKoordinatenAusschnitt.create(vorg: tTransformation; xMin,xMax,tMin,tMax: longint); begin inherited create; gr['x','x']:=xMin; gr['x','y']:=xMax; gr['y','x']:=tMin; gr['y','y']:=tMax; fuegeVorgaengerHinzu(vorg); end; procedure tKoordinatenAusschnitt.aktualisiereXsTs; var c: char; begin for c:='x' to 'y' do outXSTS[c]:=max(0,min(inXSTS[c],gr[c,'y']+1)-gr[c,'x']); end; procedure tKoordinatenAusschnitt.aktualisiereAchsen; var c,d: char; begin for c:='x' to 'y' do if inXSTS[c]<=1 then begin for d:='x' to 'y' do outAchsen[c,d]:=inAchsen[c,d]; if inAchsen[c,'x']<>inAchsen[c,'y'] then fehler('Nur eine Koordinate, aber '+floatToStr(inAchsen[c,'x'])+' = '+c+'start <> '+c+'stop = '+floatToStr(inAchsen[c,'y'])+'!'); end else for d:='x' to 'y' do outAchsen[c,d]:=inAchsen[c,'x'] + gr[c,d]/(inXSTS[c]-1)*(inAchsen[c,'y']-inAchsen[c,'x']); end; function tKoordinatenAusschnitt.transformiereKoordinatenEinzeln(const p: tExtPoint; auszerhalbIstFehler: boolean = true): tExtPoint; var c: char; begin if auszerhalbIstFehler then testeAuszerhalb(true,true,p); for c:='x' to 'y' do result[c]:=max(0,min(outXSTS[c]-1,p[c]-gr[c,'x'])); if auszerhalbIstFehler then testeAuszerhalb(false,true,result); end; function tKoordinatenAusschnitt.transformiereKoordinatenEinzelnInvers(const p: tExtPoint; auszerhalbIstFehler: boolean = true): tExtPoint; var c: char; begin if auszerhalbIstFehler then testeAuszerhalb(false,true,p); for c:='x' to 'y' do result[c]:=p[c]+gr[c,'x']; if auszerhalbIstFehler then testeAuszerhalb(true,true,result); end; function tKoordinatenAusschnitt.dumpParams: string; begin result:='Koordinatenausschnitt: '+intToStr(gr['x','x'])+'..'+intToStr(gr['x','y'])+' x '+intToStr(gr['y','x'])+'..'+intToStr(gr['y','y']); result:=result + ' ' + inherited dumpParams; end; // tFitTransformation ********************************************************** constructor tFitTransformation.create(daten: tTransformation; senkrecht: boolean; adLaenge: longint; adStart,adStop: extended); begin inherited create; wmiaExplizit:=true; // nicht sinnvoll berechenbar _senkrecht:=senkrecht; // die Richtung, in der gefittet wurde ("andere Dimension") - also senkrecht zur übernommenen Ausdehnung _adLaenge:=adLaenge; // Größe in der "anderen Dimension" _adStao['x']:=adStart; // Start und _adStao['y']:=adStop; // Stopp in der "anderen Dimension" if (_adLaenge=1) xor (_adStao['x']=_adStao['y']) then fehler('Die gefitteten Daten müssen genau dann eindimensional sein, wenn Start = Stopp ist. ('+intToStr(_adLaenge)+'-d vs. '+floatToStr(_adStao['x'])+'..'+floatToStr(_adStao['y'])+')'); fuegeVorgaengerHinzu(daten); end; procedure tFitTransformation.aktualisiereXsTs; var c: char; begin for c:='x' to 'y' do outXSTS[c]:=_adLaenge+(inXSTS[c]-_adLaenge)*byte(_senkrecht xor (c='y')); end; procedure tFitTransformation.aktualisiereAchsen; var c: char; begin for c:='x' to 'y' do begin outAchsen[char(ord('x')+byte(_senkrecht)),c]:= inAchsen[char(ord('x')+byte(_senkrecht)),c]; outAchsen[char(ord('y')-byte(_senkrecht)),c]:= _adStao[c]; end; end; function tFitTransformation.wertZuPositionAufAchse(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; begin if auszerhalbIstFehler then testeAuszerhalb(false,false,l,x); if (l in [lOben,lUnten]) xor _senkrecht then result:=0 // keine Ausdehnung in dieser Richtung! else result:=beliebigerVorgaenger.wertZuPositionAufAchse(l,x,auszerhalbIstFehler); if auszerhalbIstFehler then testeAuszerhalb(false,true,l,result); end; function tFitTransformation.positionAufAchseZuWert(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; begin if auszerhalbIstFehler then testeAuszerhalb(false,true,l,x); if (l in [lOben,lUnten]) xor _senkrecht then fehler('Eine fit-Transformation hat keine Ausdehnung in dieser Richtung!') else result:=beliebigerVorgaenger.positionAufAchseZuWert(l,x,auszerhalbIstFehler); if auszerhalbIstFehler then testeAuszerhalb(false,false,l,result); end; function tFitTransformation.dumpParams: string; begin result:='FitTransformation: '; if _senkrecht then result:=result+'vertik' else result:=result+'horizont'; result:=result+'al ' + inherited dumpParams; end; // tAgglomeration ************************************************************** constructor tAgglomeration.create; begin inherited create; schritt:=-1; _nullposition:=nan; horizontal:=false; end; function tAgglomeration.rNullposition: extended; begin if isNaN(_nullposition) then result:=inAchsen[char(ord('y')-byte(horizontal)),'x'] else result:=_nullposition; end; procedure tAgglomeration.wNullposition(n: extended); begin _nullposition:=n; aktualisiereAlles; end; procedure tAgglomeration.holeInfosVonVorgaengern; var i: longint; begin if length(vorgaenger)=0 then exit; inAchsen:=vorgaenger[0].achsen; for i:=1 to length(vorgaenger)-1 do if inAchsen <> vorgaenger[i].achsen then fehler('Vorgänger haben verschiedene Achsen, was bei Agglomeration nicht geht!'); inXSTS:=vorgaenger[0].xStepsTSiz; for i:=1 to length(vorgaenger)-1 do if inXSTS <> vorgaenger[i].xStepsTSiz then fehler('Vorgänger haben verschiedene xSteps oder tSiz, was bei Agglomeration nicht geht!'); inWMia:=vorgaenger[0].wMia; inPMia:=vorgaenger[0].pMia; inZDP:=int64Point(-1,-1); for i:=1 to length(vorgaenger)-1 do begin if inWMia['x'] > vorgaenger[i].wMia['x'] then begin inWMia['x']:=vorgaenger[i].wMia['x']; inPMia['x']:=vorgaenger[i].pMia['x']; end; if inWMia['y'] < vorgaenger[i].wMia['y'] then begin inWMia['y']:=vorgaenger[i].wMia['y']; inPMia['y']:=vorgaenger[i].pMia['y']; end; end; end; procedure tAgglomeration.addKomponente(tr: tTransformation); begin fuegeVorgaengerHinzu(tr); end; procedure tAgglomeration.aktualisiereXsTs; var c: char; begin for c:='x' to 'y' do outXSTS[c]:=inXSTS[c]*(1+(length(vorgaenger)-1)*byte(horizontal xor (c='y'))); end; procedure tAgglomeration.aktualisiereAchsen; var c,d: char; begin for c:='x' to 'y' do if inXSTS[c]<=1 then begin // diese Dimension gibt es in der Quelle nicht if (horizontal xor (c='y')) and (schritt<0) then fehler('Die Richtung einer Agglomeration ohne explizite Schrittweite kann nicht senkrecht zur Dimension eindimensionaler Daten sein!'); for d:='x' to 'y' do outAchsen[c,d]:= inAchsen[c,d] + byte(horizontal xor (c='y')) * ( // in Agglomerationsrichtung nullposition-inAchsen[c,'x'] + // Verschiebung durch explizite Nullposition byte(d='y') * schritt*(length(vorgaenger)-1) // das Ende ); if inAchsen[c,'x']<>inAchsen[c,'y'] then fehler('Nur eine Koordinate, aber '+floatToStr(inAchsen[c,'x'])+' = '+c+'start <> '+c+'stop = '+floatToStr(inAchsen[c,'y'])+'!'); end else // diese Dimension gibt es in der Quelle for d:='x' to 'y' do outAchsen[c,d]:= inAchsen[c,d] + (inAchsen[c,'y']-inAchsen[c,'x'])/ (1+1/inXSTS[c]) * (length(vorgaenger)-1) * byte((horizontal xor (c='y')) and (d='y')); end; function tAgglomeration.wertZuPositionAufAchse(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; var i: longint; c: char; s: extended; begin if auszerhalbIstFehler then testeAuszerhalb(false,false,l,x); // man muss zuerst herausfinden, welcher Vorfahr für den Wert verantwortlich ist: i:=0; c:=paralleleRichtung[l]; if horizontal xor not (l in [lOben,lUnten]) then begin // aber nur, wenn der Wert auf einer Achse in Agglomerationsrichtung liegt x:=x+inAchsen[c,'x']-nullposition; if schritt<0 then // Schrittlänge berechnen s:=(vorgaenger[0].achsen[c,'y']-vorgaenger[0].achsen[c,'x'])*(1+1/vorgaenger[0].xStepsTSiz[c]) else s:=schritt; while (i=length(vorgaenger)) or // kein Vorfahr verantwortlich? (vorgaenger[i].achsen[c,'x']>x) then result:=0 // dann lag der Wert direkt vor dem i-ten, else result:=vorgaenger[i].wertZuPositionAufAchse(l,x,auszerhalbIstFehler); // der dann genaueres weiß if horizontal xor not (l in [lOben,lUnten]) then // in Agglomerationsrichtung result:=(result+i)/length(vorgaenger); // muss verschoben und gestaucht werden if auszerhalbIstFehler then testeAuszerhalb(false,true,l,result); end; function tAgglomeration.positionAufAchseZuWert(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; begin if auszerhalbIstFehler then // intentionally wrong! testeAuszerhalb(false,false,l,x); fehler('tAgglomeration: positionAufAchseZuWert ist noch nicht implementiert'); result:=0; if auszerhalbIstFehler then testeAuszerhalb(false,true,l,result); end; function tAgglomeration.dumpParams: string; begin result:='Agglomeration: '+intToStr(length(vorgaenger))+'x '; if horizontal then result:=result+'horizont' else result:=result+'vertik'; result:=result+'al um '+floatToStr(schritt)+' versetzt ' + inherited dumpParams; end; // tDiagonaleAgglomeration ***************************************************** constructor tDiagonaleAgglomeration.create(vorg: tTransformation); begin inherited create; fuegeVorgaengerHinzu(vorg); end; function tDiagonaleAgglomeration.datenRichtung: char; begin if not (inXSTS['x']=1) xor (inXSTS['y']=1) then fehler('Diagonal zu agglomerierende Daten müssen eindimensional sein und nicht '+intToStr(inXSTS['x'])+'x'+intToStr(inXSTS['y'])+'!'); result:=char(ord('x')+byte(inXSTS['y']<>1)); end; procedure tDiagonaleAgglomeration.holeInfosVonVorgaengern; begin if length(vorgaenger)=0 then exit; inAchsen:=beliebigerVorgaenger.achsen; if length(vorgaenger)>1 then fehler('Diagonale Agglomeration kann nur einen Vorgänger haben!'); inXSTS:=beliebigerVorgaenger.xStepsTSiz; inWMia:=beliebigerVorgaenger.wMia; inPMia:=beliebigerVorgaenger.pMia; inZDP:=beliebigerVorgaenger.zDP; end; procedure tDiagonaleAgglomeration.aktualisiereXsTs; var c: char; begin for c:='x' to 'y' do outXSTS[c]:=inXSTS[datenRichtung]; end; procedure tDiagonaleAgglomeration.aktualisiereAchsen; var c,d: char; begin for c:='x' to 'y' do for d:='x' to 'y' do outAchsen[c,d]:=inAchsen[datenRichtung,d]; end; function tDiagonaleAgglomeration.wertZuPositionAufAchse(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; begin if auszerhalbIstFehler then testeAuszerhalb(false,false,l,x); if (datenRichtung='x') xor (l in [lOben,lUnten]) then result:=beliebigerVorgaenger.wertZuPositionAufAchse(dreheLagePositiv(l),x,auszerhalbIstFehler) else result:=beliebigerVorgaenger.wertZuPositionAufAchse(l,x,auszerhalbIstFehler); if auszerhalbIstFehler then testeAuszerhalb(false,true,l,result); end; function tDiagonaleAgglomeration.positionAufAchseZuWert(const l: tLage; x: extended; auszerhalbIstFehler: boolean = true): extended; begin if auszerhalbIstFehler then // intentionally wrong testeAuszerhalb(false,true,l,x); fehler('tDiagonaleAgglomeration: positionAufAchseZuWert ist noch nicht implementiert!'); result:=0; if auszerhalbIstFehler then testeAuszerhalb(false,false,l,result); end; function tDiagonaleAgglomeration.dumpParams: string; begin result:='diagonale Agglomeration ' + inherited dumpParams; end; // tWerteKnickTransformation *************************************************** constructor tWerteKnickTransformation.create; begin inherited create; setLength(parameter,0); end; destructor tWerteKnickTransformation.destroy; begin setLength(parameter,0); inherited destroy; end; function tWerteKnickTransformation.transformiereWertEinzeln(const x: extended): extended; var i: longint; begin if x>=parameter[length(parameter)-2] then begin result:=parameter[length(parameter)-1]; exit; end; i:=0; while (i=parameter[i+2]) do inc(i,2); result:=x-parameter[i]; result:=result/(parameter[i+2]-parameter[i]); result:=parameter[i+1]+result*(parameter[i+3]-parameter[i+1]) end; function tWerteKnickTransformation.dumpParams: string; var i: longint; begin result:='Knick:'; for i:=0 to length(parameter) div 2 - 1 do result:=result + ' (' + floatToStr(parameter[2*i])+';'+floatToStr(parameter[2*i+1])+')'; result:=result + ' ' + inherited dumpParams; end; // tWerteLogTransformation ***************************************************** constructor tWerteLogTransformation.create; begin inherited create; logMin:=0.1; end; function tWerteLogTransformation.transformiereWertEinzeln(const x: extended): extended; begin result:=ln(max(x/logMin,1))/ln(max(1/logMin,1)); end; function tWerteLogTransformation.dumpParams: string; begin result:='Logarithmus: '+floatToStr(logMin)+' ' + inherited dumpParams; end; // tWerteLogAbsTransformation ************************************************** constructor tWerteLogAbsTransformation.create; begin inherited create; logSkala:=0.1; end; function tWerteLogAbsTransformation.transformiereWertEinzeln(const x: extended): extended; begin result:=(1+sign(x-0.5)*ln(logSkala*abs(x-0.5)+1)/ln(logSkala*0.5+1))/2; end; function tWerteLogAbsTransformation.dumpParams: string; begin result:='Betragslogarithmus: '+floatToStr(logSkala) + ' ' + inherited dumpParams; end; // tWerteAbsTransformation ***************************************************** constructor tWerteAbsTransformation.create; begin inherited create; end; function tWerteAbsTransformation.transformiereWertEinzeln(const x: extended): extended; begin result:=2*abs(x-0.5); end; function tWerteAbsTransformation.dumpParams: string; begin result:='Betrag ' + inherited dumpParams; end; function liesTWerteTransformationen(sT: boolean; s: string; f: tMyStringList; etf: tExprToFloat; var tr: tTransformation): boolean; var i: longint; tmp: tTransformation; bekannteTransformationen: tMyStringList; begin result:=false; bekannteTransformationen:=tMyStringList.create; if istDasBefehl('Knick',s,bekannteTransformationen,false) then begin tmp:=tWerteKnickTransformation.create; with (tmp as tWerteKnickTransformation) do begin setLength(parameter,2); parameter[0]:=0; parameter[1]:=0; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); bekannteTransformationen.free; exit; end; if s='Ende' then break; setLength(parameter,length(parameter)+2); parameter[length(parameter)-2]:= etf(sT,erstesArgument(s,' ')); if s='' then s:=intToStr(length(parameter) div 2 - 1); parameter[length(parameter)-1]:= etf(sT,s); until false; for i:=0 to length(parameter)-1 do if odd(i) then parameter[i]:= parameter[i]/ (length(parameter) div 2); setLength(parameter,length(parameter)+2); parameter[length(parameter)-2]:= 1; parameter[length(parameter)-1]:= 1; end; result:=true; tmp.fuegeVorgaengerHinzu(tr); tr:=tmp; bekannteTransformationen.free; exit; end; if istDasBefehl('Log:',s,bekannteTransformationen,true) then begin tmp:=tWerteLogTransformation.create; (tmp as tWerteLogTransformation).logMin:=etf(sT,s); result:=true; tmp.fuegeVorgaengerHinzu(tr); tr:=tmp; bekannteTransformationen.free; exit; end; if istDasBefehl('AbsLog:',s,bekannteTransformationen,true) then begin tmp:=tWerteLogAbsTransformation.create; (tmp as tWerteLogAbsTransformation).logSkala:=etf(sT,s); result:=true; tmp.fuegeVorgaengerHinzu(tr); tr:=tmp; bekannteTransformationen.free; exit; end; if istDasBefehl('Abs',s,bekannteTransformationen,false) then begin tmp:=tWerteAbsTransformation.create; result:=true; tmp.fuegeVorgaengerHinzu(tr); tr:=tmp; bekannteTransformationen.free; exit; end; bekannteTransformationen.sort; gibAus('Kenne Bearbeitungsmethode '''+s+''' nicht!'#10'Ich kenne:'#10+bekannteTransformationen.text,3); bekannteTransformationen.free; end; procedure zerstoereTransformationWennObsolet(tr: tTransformation); begin if assigned(tr) and not tr.wirdGebraucht then tr.free; end; function dreheLagePositiv(l: tLage): tLage; begin case l of lLinks: result:=lUnten; lOben: result:=lLinks; lRechts: result:=lOben; lUnten: result:=lRechts; end{of case}; end; function stringToTHintergrundAbzugsArt(s: string; sT: boolean; kvs: tKnownValues; cbgv: tCallBackGetValue; out hintergrundAbzugsArt: tHintergrundAbzugsArt): boolean; var bekannteArten: tMyStringList; begin result:=true; bekannteArten:=tMyStringList.create; if istDasBefehl('keine',s,bekannteArten,false) then begin hintergrundAbzugsArt.art:=haaKeine; setLength(hintergrundAbzugsArt.parameter,0); bekannteArten.free; exit; end; if istDasBefehl('Rand-Durchschnitt',s,bekannteArten,false) then begin hintergrundAbzugsArt.art:=haaRandDurchschnitt; setLength(hintergrundAbzugsArt.parameter,0); bekannteArten.free; exit; end; if istDasBefehl('Rand-Minimum',s,bekannteArten,false) then begin hintergrundAbzugsArt.art:=haaRandMinimum; setLength(hintergrundAbzugsArt.parameter,0); bekannteArten.free; exit; end; if istDasBefehl('Rand-Perzentil',s,bekannteArten,true) then begin hintergrundAbzugsArt.art:=haaRandPerzentil; setLength(hintergrundAbzugsArt.parameter,1); hintergrundAbzugsArt.parameter[0]:=exprToFloat(false,s,nil,nil); bekannteArten.free; exit; end; if istDasBefehl('Minimum',s,bekannteArten,false) then begin hintergrundAbzugsArt.art:=haaMinimum; setLength(hintergrundAbzugsArt.parameter,0); bekannteArten.free; exit; end; if istDasBefehl('vertikale Mittel von',s,bekannteArten,true) then begin bekannteArten.free; result:=false; setLength(hintergrundAbzugsArt.parameter,2); hintergrundAbzugsArt.parameter[0]:=exprToFloat(sT,erstesArgument(s),kvs,cbgv); if not startetMit('bis ',s) then begin gibAus('Syntaxfehler in Hintergrundabzugsart, ich erwarte: ''vertikale Mittel von $minT bis $maxT''!',3); setLength(hintergrundAbzugsArt.parameter,0); exit; end; hintergrundAbzugsArt.parameter[1]:=exprToFloat(sT,erstesArgument(s),kvs,cbgv); hintergrundAbzugsArt.art:=haaVertikaleMittel; result:=true; exit; end; if istDasBefehl('vertikale Median-Mittel von',s,bekannteArten,true) then begin bekannteArten.free; result:=false; setLength(hintergrundAbzugsArt.parameter,3); hintergrundAbzugsArt.parameter[0]:=exprToFloat(sT,erstesArgument(s),kvs,cbgv); if not startetMit('bis ',s) then begin gibAus('Syntaxfehler in Hintergrundabzugsart, ich erwarte: ''vertikale Median-Mittel von $minT bis $maxT mit Rand $dT''!',3); setLength(hintergrundAbzugsArt.parameter,0); exit; end; hintergrundAbzugsArt.parameter[1]:=exprToFloat(sT,erstesArgument(s),kvs,cbgv); if not startetMit('mit Rand ',s) then begin gibAus('Syntaxfehler in Hintergrundabzugsart, ich erwarte: ''vertikale Median-Mittel von $minT bis $maxT mit Rand $dT''!',3); setLength(hintergrundAbzugsArt.parameter,0); exit; end; hintergrundAbzugsArt.parameter[2]:=exprToFloat(sT,erstesArgument(s),kvs,cbgv); hintergrundAbzugsArt.art:=haaVertikaleMedianMittel; result:=true; exit; end; result:=false; hintergrundAbzugsArt.art:=haaKeine; setLength(hintergrundAbzugsArt.parameter,0); bekannteArten.sort; gibAus('Unbekannte Art, den Hintergrund abzuziehen: '''+s+'''!'#10+bekannteArten.text,3); bekannteArten.free; end; function tHintergrundAbzugsArtToStr(hintergrundAbzugsArt: tHintergrundAbzugsArt): string; begin case hintergrundAbzugsArt.art of haaKeine: result:='keine'; haaMinimum: result:='Minimum'; haaRandMinimum: result:='Rand-Minimum'; haaRandPerzentil: result:='Rand-Perzentil ('+floatToStr(hintergrundAbzugsArt.parameter[0])+')'; haaRandDurchschnitt: result:='Rand-Durchschnitt'; haaVertikaleMittel: result:='vertikale Mittel von '+floatToStr(hintergrundAbzugsArt.parameter[0])+' bis '+floatToStr(hintergrundAbzugsArt.parameter[1]); haaVertikaleMedianMittel: result:='vertikale Mittel von '+floatToStr(hintergrundAbzugsArt.parameter[0])+' bis '+floatToStr(hintergrundAbzugsArt.parameter[1])+' ohne die extremsten '+floatToStr(hintergrundAbzugsArt.parameter[2])+' Werte ("Median-Mittel")'; else result:='UNBEKANNT'; end{of case}; end; function strToTEntspringModus(s: string; sT: boolean; kvs: tKnownValues; cbgv: tCallBackGetValue; out entspringModus: tEntspringModus): boolean; var bekannteModi: tMyStringList; begin bekannteModi:=tMyStringList.create; result:=true; if istDasBefehl('kein',s,bekannteModi,false) then begin entspringModus.modus:=emKein; setLength(entspringModus.parameter,0); end else if istDasBefehl('horizontal',s,bekannteModi,true) then begin entspringModus.modus:=emHorizontal; setLength(entspringModus.parameter,2); entspringModus.parameter[0]:=exprToFloat(sT,erstesArgument(s),kvs,cbgv); entspringModus.parameter[1]:=exprToFloat(sT,s,kvs,cbgv); end else if istDasBefehl('vertikal',s,bekannteModi,true) then begin entspringModus.modus:=emVertikal; setLength(entspringModus.parameter,2); entspringModus.parameter[0]:=exprToFloat(sT,erstesArgument(s),kvs,cbgv); entspringModus.parameter[1]:=exprToFloat(sT,s,kvs,cbgv); end else begin entspringModus.modus:=emKein; setLength(entspringModus.parameter,0); result:=false; bekannteModi.sort; gibAus('Unbekannter Entspringmodus '''+s+''' - ich kenne nur:'#10+bekannteModi.text,3); end; bekannteModi.free; end; function tEntspringModusToStr(entspringModus: tEntspringModus): string; begin case entspringModus.modus of emKein: result:='kein'; emHorizontal: result:='horizontal '+myFloatToStr(entspringModus.parameter[0]); emVertikal: result:='vertikal '+myFloatToStr(entspringModus.parameter[0]); else result:='UNBEKANNT'; end{of case}; end; end.