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; 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; 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; 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; 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; in_xs_ts,out_xs_ts: tIntPoint; in_achsen,out_achsen: t2x2Extended; in_wmia,out_wmia: 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 out_achsen; // 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 xsteps_tsiz: tIntPoint read out_xs_ts; property wmia: tExtPoint read out_wmia; 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; 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; 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; // tInputDateiInfoVorlagen ***************************************************** constructor tInputDateiInfoVorlagen.create; begin inherited create; PhaseSpaceVorlage:=tPhaseSpaceInputDateiInfo.create; SpaceTimeVorlage:=tSpaceTimeInputDateiInfo.create; TraceVorlage:=tTraceInputDateiInfo.create; SergeyVorlage:=tSergeyInputDateiInfo.create; PipeVorlage:=tPipeInputDateiInfo.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; _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; end; procedure tInputDateiInfoVorlagen.wName(n: string); begin _Name:=n; PhaseSpaceVorlage.Name:=n; SpaceTimeVorlage.Name:=n; TraceVorlage.Name:=n; SergeyVorlage.Name:=n; PipeVorlage.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; end; procedure tInputDateiInfoVorlagen.wTStop(t: extended); begin _tstop:=t; PhaseSpaceVorlage.tstop:=t; SpaceTimeVorlage.tstop:=t; TraceVorlage.tstop:=t; SergeyVorlage.tstop:=t; PipeVorlage.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; end; procedure tInputDateiInfoVorlagen.wXStop(x: extended); begin _xstop:=x; PhaseSpaceVorlage.xstop:=x; SpaceTimeVorlage.xstop:=x; TraceVorlage.xstop:=x; SergeyVorlage.xstop:=x; PipeVorlage.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; 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; end; procedure tInputDateiInfoVorlagen.wTSiz(t: longint); begin _tsiz:=t; PhaseSpaceVorlage.tsiz:=t; SpaceTimeVorlage.tsiz:=t; TraceVorlage.tsiz:=t; SergeyVorlage.tsiz:=t; PipeVorlage.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; 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; 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; 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']>in_xs_ts['x']-1) or (p['y']<0) or (p['y']>in_xs_ts['y']-1) then fehler('Punkt '+tExtPointToStr(p)+' liegt außerhalb des gültigen Eingabebereich (0..'+inttostr(in_xs_ts['x']-1)+' x 0..'+inttostr(in_xs_ts['y']-1)+')!'); end; procedure tTransformation.holeInfosVonVorgaengern; var i: longint; begin in_achsen:=vorgaenger[0].achsen; for i:=1 to length(vorgaenger)-1 do if in_achsen <> vorgaenger[i].achsen then fehler('Vorgänger haben verschiedene Achsen, was generisch nicht zu verstehen ist!'); in_xs_ts:=vorgaenger[0].xsteps_tsiz; for i:=1 to length(vorgaenger)-1 do if in_xs_ts <> vorgaenger[i].xsteps_tsiz then fehler('Vorgänger haben verschiedene xsteps oder tsiz, was generisch nicht zu verstehen ist!'); if not wmiaExplizit then begin in_wmia:=vorgaenger[0].wmia; for i:=1 to length(vorgaenger)-1 do if in_wmia <> 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 out_achsen:=in_achsen; end; procedure tTransformation.aktualisiereXsTs; // nicht zum direkten Aufrufen begin out_xs_ts:=in_xs_ts; end; procedure tTransformation.aktualisiereWmia; // nicht zum direkten Aufrufen begin if not wmiaExplizit then out_wmia:=in_wmia; end; function tTransformation.rXstart: extended; begin result:=out_achsen['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!'); in_achsen['x','x']:=x; aktualisiereAlles; end; function tTransformation.rXstop: extended; begin result:=out_Achsen['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!'); in_achsen['x','y']:=x; aktualisiereAlles; end; function tTransformation.rTstart: extended; begin result:=out_Achsen['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!'); in_achsen['y','x']:=t; aktualisiereAlles; end; function tTransformation.rTstop: extended; begin result:=out_Achsen['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!'); in_achsen['y','y']:=t; aktualisiereAlles; end; function tTransformation.rWmin: extended; begin result:=out_wmia['x']; end; procedure tTransformation.wWmin(w: extended); begin if (self is tAgglomeration) then begin if out_wmia['x']<>w then fehler('Setzen von wmin für Agglomeration nicht erlaubt ( '+floattostr(w)+' ≠ '+floattostr(out_wmia['x'])+' )!'); exit; end; out_wmia['x']:=w; wmiaExplizit:=true; aktualisiereAlles; end; function tTransformation.rWmax: extended; begin result:=out_wmia['y']; end; procedure tTransformation.wWmax(w: extended); begin if (self is tAgglomeration) then begin if out_wmia['y']<>w then fehler('Setzen von wmax für Agglomeration nicht erlaubt ( '+floattostr(w)+' ≠ '+floattostr(out_wmia['y'])+' )!'); exit; end; wmiaExplizit:=true; out_wmia['y']:=w; aktualisiereAlles; end; function tTransformation.rXsteps: longint; begin result:=out_xs_ts['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!'); in_xs_ts['x']:=x; aktualisiereAlles; end; function tTransformation.rTsiz: longint; begin result:=out_xs_ts['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!'); in_xs_ts['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] * (in_xs_ts[d]-1); // zu transformieren p:=transformiereKoordinatenEinzeln(p); // un in Anteile zurückzurechnen result:=p[c]/out_xs_ts[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=out_achsen[c,'x'] then result:=0 else result:=(x-out_achsen[c,'x'])/(out_achsen[c,'y']-out_achsen[c,'x'])*(1-1/out_xs_ts[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; fuegeVorgaengerHinzu(vorg); horizontal:=hor; vertikal:=ver; end; procedure tFFTTransformation.aktualisiereAchsen; var c: char; begin if horizontal then begin out_achsen['x','x']:=0; out_achsen['x','y']:=(in_xs_ts['x']-1)/(in_achsen['x','y']-in_achsen['x','x']); end else for c:='x' to 'y' do out_achsen['x',c]:=in_achsen['x',c]; if vertikal then begin out_achsen['y','x']:=0; out_achsen['y','y']:=(in_xs_ts['y']-1)/(in_achsen['y','y']-in_achsen['y','x']); end else for c:='x' to 'y' do out_achsen['y',c]:=in_achsen['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=out_achsen[c,'x'] then result:=0 else result:=(x-out_achsen[c,'x'])/(out_achsen[c,'y']-out_achsen[c,'x']); result:=result*(1-1/out_xs_ts[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']:=in_xs_ts['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 (in_xs_ts['x']*(1-k)+in_xs_ts['y']*k)-1 do for j:=0 to 1 do begin RandPkt:=transformiereKoordinaten( i*(1-k) + j*k*(in_xs_ts['x']-1), j*(1-k)*(in_xs_ts['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 out_xs_ts[c]:=gr[c,'y']-gr[c,'x']+1; 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; fuegeVorgaengerHinzu(vorg); gr['x','x']:=xmin; gr['x','y']:=xmax; gr['y','x']:=tmin; gr['y','y']:=tmax; aktualisiereAlles; end; procedure tKoordinatenAusschnitt.aktualisiereXsTs; var c: char; begin for c:='x' to 'y' do out_xs_ts[c]:=max(0,min(in_xs_ts[c],gr[c,'y']+1)-gr[c,'x']); end; procedure tKoordinatenAusschnitt.aktualisiereAchsen; var c,d: char; begin for c:='x' to 'y' do if in_xs_ts[c]<=1 then begin for d:='x' to 'y' do out_achsen[c,d]:=in_achsen[c,d]; if in_achsen[c,'x']<>in_achsen[c,'y'] then fehler('Nur eine Koordinate, aber '+floattostr(in_achsen[c,'x'])+' = '+c+'start <> '+c+'stop = '+floattostr(in_achsen[c,'y'])+'!'); end else for d:='x' to 'y' do out_achsen[c,d]:=in_achsen[c,'x'] + gr[c,d]/(in_xs_ts[c]-1)*(in_achsen[c,'y']-in_achsen[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(out_xs_ts[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; // tAgglomeration ************************************************************** constructor tAgglomeration.create; begin inherited create; schritt:=-1; _nullposition:=nan; horizontal:=false; end; function tAgglomeration.rNullposition: extended; begin if isNaN(_nullposition) then result:=in_achsen[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; in_achsen:=vorgaenger[0].achsen; for i:=1 to length(vorgaenger)-1 do if in_achsen <> vorgaenger[i].achsen then fehler('Vorgänger haben verschiedene Achsen, was bei Agglomeration nicht geht!'); in_xs_ts:=vorgaenger[0].xsteps_tsiz; for i:=1 to length(vorgaenger)-1 do if in_xs_ts <> vorgaenger[i].xsteps_tsiz then fehler('Vorgänger haben verschiedene xsteps oder tsiz, was bei Agglomeration nicht geht!'); in_wmia:=vorgaenger[0].wmia; for i:=1 to length(vorgaenger)-1 do begin in_wmia['x']:=min(in_wmia['x'],vorgaenger[i].wmia['x']); in_wmia['y']:=max(in_wmia['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 out_xs_ts[c]:=in_xs_ts[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 in_xs_ts[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 out_achsen[c,d]:= in_achsen[c,d] + byte(horizontal xor (c='y')) * ( // in Agglomerationsrichtung nullposition-in_achsen[c,'x'] + // Verschiebung durch explizite Nullposition byte(d='y') * schritt*(length(vorgaenger)-1) // das Ende ); if in_achsen[c,'x']<>in_achsen[c,'y'] then fehler('Nur eine Koordinate, aber '+floattostr(in_achsen[c,'x'])+' = '+c+'start <> '+c+'stop = '+floattostr(in_achsen[c,'y'])+'!'); end else // diese Dimension gibt es in der Quelle for d:='x' to 'y' do out_achsen[c,d]:= in_achsen[c,d] + (in_achsen[c,'y']-in_achsen[c,'x'])/ (1+1/in_xs_ts[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+in_achsen[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].xsteps_tsiz[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); aktualisiereAlles; end; function tDiagonaleAgglomeration.datenRichtung: char; begin if not (in_xs_ts['x']=1) xor (in_xs_ts['y']=1) then fehler('Diagonal zu allomerierende Daten müssen eindimensional sein und nicht '+inttostr(in_xs_ts['x'])+'x'+inttostr(in_xs_ts['y'])+'!'); result:=char(ord('x')+byte(in_xs_ts['y']<>1)); end; procedure tDiagonaleAgglomeration.holeInfosVonVorgaengern; begin if length(vorgaenger)=0 then exit; in_achsen:=vorgaenger[0].achsen; if length(vorgaenger)>1 then fehler('Diagonale Agglomeration kann nur einen Vorgänger haben!'); in_xs_ts:=vorgaenger[0].xsteps_tsiz; in_wmia:=vorgaenger[0].wmia; end; procedure tDiagonaleAgglomeration.aktualisiereXsTs; var c: char; begin for c:='x' to 'y' do out_xs_ts[c]:=in_xs_ts[datenRichtung]; end; procedure tDiagonaleAgglomeration.aktualisiereAchsen; var c,d: char; begin for c:='x' to 'y' do for d:='x' to 'y' do out_achsen[c,d]:=in_achsen[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; begin result:=false; if s='Knick' 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); 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; exit; end; if startetMit('Log:',s) then begin tmp:=tWerteLogTransformation.create; (tmp as tWerteLogTransformation).logMin:=etf(st,s); result:=true; tmp.fuegeVorgaengerHinzu(tr); tr:=tmp; exit; end; if startetMit('AbsLog:',s) then begin tmp:=tWerteLogAbsTransformation.create; (tmp as tWerteLogAbsTransformation).logSkala:=etf(st,s); result:=true; tmp.fuegeVorgaengerHinzu(tr); tr:=tmp; exit; end; if s='Abs' then begin tmp:=tWerteAbsTransformation.create; result:=true; tmp.fuegeVorgaengerHinzu(tr); tr:=tmp; exit; end; gibAus('Kenne Bearbeitungsmethode '''+s+''' nicht!',3); 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.