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; tKomplexMachModus = (kmmReNull,kmmImNull,kmmPhZuf); tIntegrationsRichtung = (irHorizontal,irEinfall,irAusfall); 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; 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; end; tSergeyInputDateiInfo = class (tGenerischeInputDateiInfo) feldNummer: longint; constructor create(vorlage: tGenerischeInputDateiInfo); overload; constructor create; overload; destructor destroy; 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; end; tAndorInputDateiInfo = class (tGenerischeInputDateiInfo) temperatur,belichtungsZeit, zyklusZeit,akkumulierteZyklusZeit, zyklusStapelZeit,pixelAusleseZeit, verstaerkungADW: extended; akkumulierteZyklen,datenStart: int64; detektorTyp,dateiName,xAchsenTitel, yAchsenTitel,datenTypTitel: string; detektorGroesze,bildBereichStapel, rahmenToepfe: tIntPoint; bildBereich,rahmenBereich: t2x2Longint; shutterZeit: tExtPoint; constructor create(vorlage: tGenerischeInputDateiInfo); overload; constructor create; overload; destructor destroy; override; function detectorSkipLines: int64; 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; _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 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 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: 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; 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; tSiz,xSteps,tSiz_,xSteps_: longint; istKomplex: boolean; knownValues: tKnownValues; constructor create; 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: array of tTransformation; inXSTS,outXSTS: tIntPoint; inAchsen,outAchsen: t2x2Extended; inWMia,outWMia: tExtPoint; wmiaExplizit: boolean; // wMia wurde explizit gesetzt _anzZugehoerigerDaten: longint; procedure testeAuszerhalb(const p: tExtPoint); procedure holeInfosVonVorgaengern; virtual; procedure aktualisiereAchsen; virtual; procedure aktualisiereXsTs; virtual; procedure aktualisiereWmia; virtual; function transformiereKoordinatenEinzeln(const p: tExtPoint): tExtPoint; virtual; // wie ändert sich die Position eines Punktes (Paradebeispiel: bei Spiegelung: x -> xSteps-1-x) // ist für p veranwortlich? 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 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 wertZuPositionAufAchse(const l: tLage; x: extended): extended; virtual; function transformiereWert(const x: extended; const tiefe: longint = -1): extended; property xStepsTSiz: tIntPoint read outXSTS; property wMia: tExtPoint read outWMia; 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 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): 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: boolean; constructor create; overload; constructor create(vorg: tTransformation; hor,ver: boolean); procedure aktualisiereAchsen; override; // keine Änderung der Positionen, der Werte(skalierung), der Ausdehnung function wertZuPositionAufAchse(const l: tLage; x: extended): 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): tExtPoint; override; overload; // 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; overload; function transformiereKoordinatenEinzeln(const p: tExtPoint): tExtPoint; override; overload; 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; tLambdaZuOmegaTransformation = class (tKoordinatenTransformation) horizontal, vertikal: boolean; constructor create; overload; function verhaeltnisHorizontal: extended; function verhaeltnisVertikal: extended; function wertZuPositionAufAchse(const l: tLage; x: extended): extended; override; procedure aktualisiereAchsen; override; function transformiereKoordinatenEinzeln(const p: tExtPoint): tExtPoint; override; overload; // 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): tExtPoint; override; overload; // 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): 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): 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): 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; function liesTWerteTransformationen(sT: boolean; s: string; f: tMyStringList; etf: tExprToFloat; var tr: tTransformation): boolean; procedure zerstoereTransformationWennObsolet(tr: tTransformation); function dreheLagePositiv(l: tLage): tLage; inline; implementation // 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; // 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; // 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; // 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; // 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; 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); 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); end; destructor tAndorInputDateiInfo.destroy; begin detektorTyp:=''; dateiName:=''; inherited destroy; end; function tAndorInputDateiInfo.detectorSkipLines: int64; begin result:=15; if pos('Luc',detektorTyp)>0 then result:=result+2; if detektorTyp='DV436' then result:=result+9; if detektorTyp='DU920P_BR,DD' then result:=result+10; 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; 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; 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; 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 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; 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)); testeFensterDurchschnitt(schlussBeiWenigInhalt); end; function tGauszFenster.dumpParams: string; begin result:= 'Breite: '+floattostrtrunc(breite,2,true)+', '+ 'Rand: '+intToStr(rand)+', '+ 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; begin inherited create; maxW:=1; minW:=0; transformationen:=tTransformation.create; transformationen.erhoeheZugehoerigkeitsanzahl; np:=1; beta:=0; tSiz:=0; xSteps:=0; tSiz_:=0; xSteps_:=0; istKomplex:=false; knownValues:=tKnownValues.create; 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)); knownValues.add(knownValue('beta',beta)); knownValues.add(knownValue('xStart',xStart)); knownValues.add(knownValue('xStop',xStop)); knownValues.add(knownValue('tStart',tStart)); knownValues.add(knownValue('tStop',tStop)); end; // tFontRenderer *************************************************************** constructor tFontRenderer.create(schriftgroesze: longint); begin inherited create; gibAus('FontRenderer erzeugen (Schriftgröße '+intToStr(schriftgroesze)+') ...',1); New(agg, Construct); agg^.font('/usr/share/fonts/TTF/DejaVuSans.ttf',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(const p: tExtPoint); begin if (p['x']<0) or (p['x']>inXSTS['x']-1) or (p['y']<0) or (p['y']>inXSTS['y']-1) then fehler('Punkt '+tExtPointToStr(p)+' liegt außerhalb des gültigen Eingabebereich (0..'+intToStr(inXSTS['x']-1)+' x 0..'+intToStr(inXSTS['y']-1)+')!'); 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; for i:=1 to length(vorgaenger)-1 do if inWMia <> vorgaenger[i].wMia then fehler('Vorgänger haben verschiedene wmin oder wmax, 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 outWMia:=inWMia; 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.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 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): tExtPoint; begin result:=p; testeAuszerhalb(p); end; function tTransformation.transformiereKoordinaten(const p: tExtPoint; const tiefe: longint = -1): tExtPoint; begin if (length(vorgaenger)>0) and (tiefe<>0) then result:=vorgaenger[0].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.wertZuPositionAufAchse(const l: tLage; x: extended): extended; var c,d: char; p: tExtPoint; begin // das generische Verhalten ist c:=char(ord('y')-byte(l in [lOben,lUnten])); d:=char(ord('x')+byte(l in [lOben,lUnten])); // zuerst den Vorgänger nach der Position zu fragen p[c]:=vorgaenger[0].wertZuPositionAufAchse(l,x); 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); // und in Anteile zurückzurechnen result:=p[c]/outXSTS[c]; 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:=vorgaenger[0].transformiereWert(x,tiefe-1) else result:=x; result:=transformiereWertEinzeln(result); end; function tTransformation.dumpParams: string; begin result:=''; 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+#13'< '+intToStr(i)+' >'; result:=result+#13+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): extended; var c: char; begin // ein Wert am Anfang ist einfach linear zu interpolieren c:=char(ord('y')-byte(l in [lOben,lUnten])); if x=outAchsen[c,'x'] then result:=0 else result:=(x-outAchsen[c,'x'])/(outAchsen[c,'y']-outAchsen[c,'x'])*(1-1/outXSTS[c]); 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; end; constructor tFFTTransformation.create(vorg: tTransformation; hor,ver: boolean); begin inherited create; horizontal:=hor; vertikal:=ver; 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']); 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']); end else for c:='x' to 'y' do outAchsen['y',c]:=inAchsen['y',c]; end; function tFFTTransformation.wertZuPositionAufAchse(const l: tLage; x: extended): extended; var c: char; begin 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) // Vorfahren befragen else begin // egal, wie die Werte vor der FFT aussahen, wir setzen die Frequenzen danach linear c:=char(ord('y')-byte(l in [lOben,lUnten])); 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; end; function tFFTTransformation.dumpParams: string; begin result:='FFT: '; if horizontal then result:=result+'h'; if vertikal then result:=result+'v'; 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): tExtPoint; begin testeAuszerhalb(p); result['x']:=inXSTS['x']-1-p['x']; result['y']:=p['y']; end; function tSpiegelungsTransformation.dumpParams: string; begin result:='horizontale Spiegelung'; 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): tExtPoint; var c,d: char; lt,et: extended; begin testeAuszerhalb(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; 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+#13#10+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); 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; // tLambdaZuOmegaTransformation ************************************************ constructor tLambdaZuOmegaTransformation.create; begin inherited create; horizontal:=false; vertikal:=false; 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; function tLambdaZuOmegaTransformation.wertZuPositionAufAchse(const l: tLage; x: extended): extended; begin if ((l in [lOben,lUnten]) and horizontal) or // transformierte Achse? ((l in [lLinks,lRechts]) and vertikal) then x:=2*pi*299792458/x; result:=inherited wertZuPositionAufAchse(l,x); // Vorfahren befragen end; procedure tLambdaZuOmegaTransformation.aktualisiereAchsen; var c: char; begin if horizontal then begin outAchsen['x','x']:=2*pi*299792458/inAchsen['x','y']; outAchsen['x','y']:=2*pi*299792458/inAchsen['x','x']; end else for c:='x' to 'y' do outAchsen['x',c]:=inAchsen['x',c]; if vertikal then begin outAchsen['y','x']:=2*pi*299792458/inAchsen['y','y']; outAchsen['y','y']:=2*pi*299792458/inAchsen['y','x']; end else for c:='x' to 'y' do outAchsen['y',c]:=inAchsen['y',c]; end; function tLambdaZuOmegaTransformation.transformiereKoordinatenEinzeln(const p: tExtPoint): tExtPoint; var verh: extended; begin testeAuszerhalb(p); if horizontal then begin verh:=verhaeltnisHorizontal; result['x']:= (1/(verh + p['x']/(inXSTS['x']-1)) - 1/verh) / (1/(verh + 1) - 1/verh); end else result['x']:=p['x']; if vertikal then begin verh:=verhaeltnisVertikal; result['y']:= (1/(verh + p['y']/(inXSTS['y']-1)) - 1/verh) / (1/(verh + 1) - 1/verh); end else result['y']:=p['y']; end; function tLambdaZuOmegaTransformation.dumpParams: string; begin result:=''; if horizontal then result:='horizontal'; if vertikal then result:=result+' und vertikal'; startetMit(' und ',result); 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): tExtPoint; var c: char; begin testeAuszerhalb(p); for c:='x' to 'y' do result[c]:=max(0,min(outXSTS[c],p[c]-gr[c,'x'])); 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']); 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): extended; begin if (l in [lOben,lUnten]) xor _senkrecht then result:=0 // keine Ausdehnung in dieser Richtung! else result:=vorgaenger[0].wertZuPositionAufAchse(l,x); end; function tFitTransformation.dumpParams: string; begin result:='FitTransformation: '; if _senkrecht then result:=result+'vertik' else result:=result+'horizont'; result:=result+'al'; 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; for i:=1 to length(vorgaenger)-1 do begin inWMia['x']:=min(inWMia['x'],vorgaenger[i].wMia['x']); inWMia['y']:=max(inWMia['y'],vorgaenger[i].wMia['y']); 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): extended; var i: longint; c: char; s: extended; begin // man muss zuerst herausfinden, welcher Vorfahr für den Wert verantwortlich ist: i:=0; c:=char(ord('y')-byte(l in [lOben,lUnten])); 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); // 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 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'; 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:=vorgaenger[0].achsen; if length(vorgaenger)>1 then fehler('Diagonale Agglomeration kann nur einen Vorgänger haben!'); inXSTS:=vorgaenger[0].xStepsTSiz; inWMia:=vorgaenger[0].wMia; 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): extended; begin if (datenRichtung='x') xor (l in [lOben,lUnten]) then result:=vorgaenger[0].wertZuPositionAufAchse(dreheLagePositiv(l),x) else result:=vorgaenger[0].wertZuPositionAufAchse(l,x); end; function tDiagonaleAgglomeration.dumpParams: string; begin result:='diagonale Agglomeration'; 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])+')'; 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); 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); 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'; 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; end.