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; 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; 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 SpaceTimeVorlage: tSpaceTimeInputDateiInfo; TraceVorlage: tTraceInputDateiInfo; 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); tFFTDatenordnung = (doResIms,doResSmi,doRes,doBetr,doBetrQdr); tFenster = object aktiv: boolean; Breite,Rand: longint; Werte: tExtendedArray; procedure berechneWerte(anzWerte: longint); 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); tTransformationen = class; tExtraInfos = class maxW,minW,np,beta: extended; tsiz,xsteps,tsiz_,xsteps_: longint; transformationen: tTransformationen; knownValues: tKnownValues; constructor create; destructor destroy; override; function xstart: extended; function xstop: extended; function tstart: extended; function tstop: extended; procedure refreshKnownValues; end; tTransformation = class // eine generische Transformation von Werten oder Koordinaten // selbst nicht zum Instanziieren gedacht private procedure testeAuszerhalb(const p: tExtPoint); public in_xs_ts: tIntPoint; in_achsen: t2x2Extended; function achsen: t2x2Extended; virtual; // wie ändern sich xstart,xstop,tstart,tstop? function transformiereKoordinaten(const x,y: longint): tExtPoint; overload; function transformiereKoordinaten(const p: tExtPoint): tExtPoint; virtual; overload; // wie ändert sich die Position eines Punktes (Paradebeispiel: bei Spiegelung: x -> xsteps-1-x) function transformiereWert(const x: extended): extended; virtual; // wie ändert sich ein Wert function xsteps_tsiz: tIntPoint; virtual; // wie ändert sich die Ausdehnung? function dumpParams: string; virtual; 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(original: tFFTTransformation); overload; function achsen: t2x2Extended; override; // keine Änderung der Positionen, der Werte(skalierung), der Ausdehnung function dumpParams: string; override; end; tSpiegelungsTransformation = class (tKoordinatenTransformation) // repräsentiert die horizontale Spiegelung der Koordinaten constructor create; function transformiereKoordinaten(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; constructor create(original: tKonkreteKoordinatenTransformation); overload; function transformiereKoordinaten(const p: tExtPoint): tExtPoint; override; overload; function initAbbildung(syntaxtest: boolean; s: string; xscale,yscale: extended; etf: tExprToFloat): boolean; function zielausdehnung: t2x2Longint; function xsteps_tsiz: tIntPoint; override; // keine Änderung der Achsenbegrenzungen, der Werte(skalierung) function dumpParams: string; override; end; tKoordinatenAusschnitt = class (tKoordinatenTransformation) gr: t2x2Longint; constructor create; overload; constructor create(original: tKoordinatenAusschnitt); overload; function xsteps_tsiz: tIntPoint; override; function achsen: t2x2Extended; override; function transformiereKoordinaten(const p: tExtPoint): tExtPoint; override; overload; // keine Änderung der Werte(skalierung) 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; constructor create(original: tWerteKnickTransformation); overload; destructor destroy; override; function transformiereWert(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; constructor create(original: tWerteLogTransformation); overload; function transformiereWert(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; constructor create(original: tWerteLogAbsTransformation); overload; function transformiereWert(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 transformiereWert(const x: extended): extended; override; // keine Änderung der Achsenbegrenzungen, der Positionen, der Ausdehnung function dumpParams: string; override; end; tTransformationen = class private // merkt sich, was mit den Werten und Koordinaten nach einem festen Punkt (dem Einlesen) passiert ist, // sodass man immer nachvollziehen kann, welcher Punkt woher kam und wie verarbeitet wurde. // -> sinnvolle Achsenbezeichnungen und Legenden Schritte: array of tTransformation; _xtstao: t2x2Extended; _wmia: tExtPoint; _xs_ts: tIntPoint; function gibInhalt(ii: longint): tTransformation; procedure nimmInhalt(ii: longint; inh: tTransformation); 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); function xsteps_tsiz: tIntPoint; function gibAchsen: t2x2Extended; procedure achsenUndGroeszeAktualisieren; public 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; property inhalt[ii: longint]: tTransformation read gibInhalt write nimmInhalt; default; constructor create; overload; constructor create(original: tTransformationen); overload; destructor destroy; override; function kopiereVon(original: tTransformationen): boolean; function count: longint; function kCount: longint; function wCount: longint; function last: tTransformation; procedure clear; procedure clearWerte; procedure addFFT(hor,ver: boolean); procedure AddSpiegelung; function add(inh: tTransformation): boolean; overload; function add(st: boolean; s: string; f: tMyStringlist; etf: tExprToFloat): boolean; overload; function add(syntaxtest: boolean; s: string; xscale,yscale: extended; etf: tExprToFloat): boolean; overload; procedure addAusschnitt(xmin,xmax,tmin,tmax: longint); function append(inhs: tTransformationen): boolean; function transformiereKoordinaten(const lage: tLage; const x: extended): extended; overload; function transformiereKoordinaten(const x,y: extended): tExtPoint; overload; function transformiereKoordinaten(const p: tExtPoint): tExtPoint; overload; function transformiereWert(const x: extended): extended; function dumpParams: string; procedure berechneZielausdehnung(out grenzen: t2x2Longint); end; 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; // 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; // 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; SpaceTimeVorlage:=tSpaceTimeInputDateiInfo.create; TraceVorlage:=tTraceInputDateiInfo.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 SpaceTimeVorlage.free; TraceVorlage.free; PipeVorlage.free; _Name:=''; _Fehlerbehebungskommando:=''; _Analysator:=''; inherited destroy; end; procedure tInputDateiInfoVorlagen.wFehlerbehebungskommando(f: string); begin _Fehlerbehebungskommando:=f; SpaceTimeVorlage.Fehlerbehebungskommando:=f; TraceVorlage.Fehlerbehebungskommando:=f; PipeVorlage.Fehlerbehebungskommando:=f; end; procedure tInputDateiInfoVorlagen.wName(n: string); begin _Name:=n; SpaceTimeVorlage.Name:=n; TraceVorlage.Name:=n; PipeVorlage.Name:=n; end; procedure tInputDateiInfoVorlagen.wGamma(g: extended); begin _Gamma:=g; SpaceTimeVorlage.Gamma:=g; TraceVorlage.Gamma:=g; PipeVorlage.Gamma:=g; end; procedure tInputDateiInfoVorlagen.wTStart(t: extended); begin _tstart:=t; SpaceTimeVorlage.tstart:=t; TraceVorlage.tstart:=t; PipeVorlage.tstart:=t; end; procedure tInputDateiInfoVorlagen.wTStop(t: extended); begin _tstop:=t; SpaceTimeVorlage.tstop:=t; TraceVorlage.tstop:=t; PipeVorlage.tstop:=t; end; procedure tInputDateiInfoVorlagen.wXStart(x: extended); begin _xstart:=x; SpaceTimeVorlage.xstart:=x; TraceVorlage.xstart:=x; PipeVorlage.xstart:=x; end; procedure tInputDateiInfoVorlagen.wXStop(x: extended); begin _xstop:=x; SpaceTimeVorlage.xstop:=x; TraceVorlage.xstop:=x; PipeVorlage.xstop:=x; end; procedure tInputDateiInfoVorlagen.wT0Abs(t: longint); begin _t0abs:=t; SpaceTimeVorlage.t0abs:=t; TraceVorlage.t0abs:=t; PipeVorlage.t0abs:=t; end; procedure tInputDateiInfoVorlagen.wGroeszenFaktor(g: extended); begin _groeszenFaktor:=g; SpaceTimeVorlage.groeszenFaktor:=g; TraceVorlage.groeszenFaktor:=g; PipeVorlage.groeszenFaktor:=g; end; procedure tInputDateiInfoVorlagen.wGenauigkeit(g: tGenauigkeit); begin _Genauigkeit:=g; SpaceTimeVorlage.Genauigkeit:=g; TraceVorlage.Genauigkeit:=g; PipeVorlage.Genauigkeit:=g; end; procedure tInputDateiInfoVorlagen.wTSiz(t: longint); begin _tsiz:=t; SpaceTimeVorlage.tsiz:=t; TraceVorlage.tsiz:=t; PipeVorlage.tsiz:=t; end; procedure tInputDateiInfoVorlagen.wXSteps(x: longint); begin _xsteps:=x; SpaceTimeVorlage.xsteps:=x; TraceVorlage.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; 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; SpaceTimeVorlage.params:=p; TraceVorlage.params:=p; PipeVorlage.params:=p; end; // tFenster ******************************************************************** procedure tFenster.berechneWerte(anzWerte: longint); 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; 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:=tTransformationen.create; np:=1; beta:=0; tsiz:=0; xsteps:=0; tsiz_:=0; xsteps_:=0; knownValues:=tKnownValues.create; end; destructor tExtraInfos.destroy; begin knownValues.free; transformationen.free; inherited destroy; 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); 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 ************************************************************* 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 raise exception.create('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; function tTransformation.transformiereKoordinaten(const x,y: longint): tExtPoint; var p: tExtPoint; begin p['x']:=x; p['y']:=y; result:=transformiereKoordinaten(p); end; function tTransformation.transformiereKoordinaten(const p: tExtPoint): tExtPoint; begin result:=p; testeAuszerhalb(p); end; function tTransformation.transformiereWert(const x: extended): extended; begin result:=x; end; function tTransformation.xsteps_tsiz: tIntPoint; begin result:=in_xs_ts; end; function tTransformation.achsen: t2x2Extended; var c,d: char; begin for c:='x' to 'y' do for d:='x' to 'y' do result[c,d]:=in_achsen[c,d]*byte((in_xs_ts['x']>0) and (in_xs_ts['y']>0)); end; function tTransformation.dumpParams: string; begin result:=''; end; // tFFTTransformation ********************************************************** constructor tFFTTransformation.create; begin inherited create; horizontal:=false; vertikal:=false; end; constructor tFFTTransformation.create(original: tFFTTransformation); begin inherited create; horizontal:=original.horizontal; vertikal:=original.vertikal; end; function tFFTTransformation.achsen: t2x2Extended; var c: char; begin if horizontal then begin result['x','x']:=0; result['x','y']:=(in_xs_ts['x']-1)/(in_achsen['x','y']-in_achsen['x','x']); end else for c:='x' to 'y' do result['x',c]:=in_achsen['x',c]; if vertikal then begin result['y','x']:=0; result['y','y']:=(in_xs_ts['y']-1)/(in_achsen['y','y']-in_achsen['y','x']); end else for c:='x' to 'y' do result['y',c]:=in_achsen['y',c]; 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; function tSpiegelungsTransformation.transformiereKoordinaten(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; constructor tKonkreteKoordinatenTransformation.create(original: tKonkreteKoordinatenTransformation); var c,d: char; begin for c:='x' to 'y' do begin for d:='x' to 'y' do begin lin[c,d]:=original.lin[c,d]; lnInt[c,d]:=original.lnInt[c,d]; expExp[c,d]:=original.expExp[c,d]; end; off[c]:=original.off[c]; lnFak[c]:=original.lnFak[c]; expFak[c]:=original.expFak[c]; lnOff[c]:=original.lnOff[c]; 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.transformiereKoordinaten(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; function tKonkreteKoordinatenTransformation.xsteps_tsiz: tIntPoint; var gr: t2x2Longint; c: char; begin gr:=zielausdehnung; for c:='x' to 'y' do result[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(original: tKoordinatenAusschnitt); var c,d: char; begin inherited create; for c:='x' to 'y' do for d:='x' to 'y' do gr[c,d]:=original.gr[c,d]; end; function tKoordinatenAusschnitt.xsteps_tsiz: tIntPoint; var c: char; begin for c:='x' to 'y' do result[c]:=max(0,min(in_xs_ts[c],gr[c,'y']+1)-gr[c,'x']); end; function tKoordinatenAusschnitt.achsen: t2x2Extended; 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 result[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 result[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.transformiereKoordinaten(const p: tExtPoint): tExtPoint; var c: char; begin testeAuszerhalb(p); for c:='x' to 'y' do result[c]:=max(0,min(gr[c,'y'],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; // tWerteKnickTransformation *************************************************** constructor tWerteKnickTransformation.create; begin inherited create; setlength(parameter,0); end; constructor tWerteKnickTransformation.create(original: tWerteKnickTransformation); var i: longint; begin inherited create; setlength(parameter,length(original.parameter)); for i:=0 to length(parameter)-1 do parameter[i]:=original.parameter[i]; end; destructor tWerteKnickTransformation.destroy; begin setlength(parameter,0); inherited destroy; end; function tWerteKnickTransformation.transformiereWert(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; constructor tWerteLogTransformation.create(original: tWerteLogTransformation); begin inherited create; logMin:=original.logMin; end; function tWerteLogTransformation.transformiereWert(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; constructor tWerteLogAbsTransformation.create(original: tWerteLogAbsTransformation); begin inherited create; logSkala:=original.logSkala; end; function tWerteLogAbsTransformation.transformiereWert(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.transformiereWert(const x: extended): extended; begin result:=2*abs(x-0.5); end; function tWerteAbsTransformation.dumpParams: string; begin result:='Betrag'; end; // tTransformationen *********************************************************** constructor tTransformationen.create; begin inherited create; setlength(Schritte,0); end; constructor tTransformationen.create(original: tTransformationen); begin inherited create; setlength(Schritte,0); if not kopiereVon(original) then halt(1); end; destructor tTransformationen.destroy; var i: longint; begin for i:=0 to length(Schritte)-1 do if assigned(Schritte[i]) then Schritte[i].free; setlength(Schritte,0); inherited destroy; end; function tTransformationen.gibInhalt(ii: longint): tTransformation; begin result:=Schritte[ii]; end; procedure tTransformationen.nimmInhalt(ii: longint; inh: tTransformation); begin Schritte[ii]:=inh; end; function tTransformationen.rXstart: extended; begin result:=gibAchsen['x','x']; end; procedure tTransformationen.wXstart(x: extended); begin if kCount>0 then begin gibAus('Will xstart schreiben, aber der kCount ist '+inttostr(kCount),3); raise exception.create('Will xstart schreiben, aber der kCount ist '+inttostr(kCount)); end; _xtstao['x','x']:=x; end; function tTransformationen.rXstop: extended; begin result:=gibAchsen['x','y']; end; procedure tTransformationen.wXstop(x: extended); begin if kCount>0 then begin gibAus('Will xstop schreiben, aber der kCount ist '+inttostr(kCount),3); raise exception.create('Will xstop schreiben, aber der kCount ist '+inttostr(kCount)); end; _xtstao['x','y']:=x; end; function tTransformationen.rTstart: extended; begin result:=gibAchsen['y','x']; end; procedure tTransformationen.wTstart(t: extended); begin if kCount>0 then begin gibAus('Will tstart schreiben, aber der kCount ist '+inttostr(kCount),3); raise exception.create('Will tstart schreiben, aber der kCount ist '+inttostr(kCount)); end; _xtstao['y','x']:=t; end; function tTransformationen.rTstop: extended; begin result:=gibAchsen['y','y']; end; procedure tTransformationen.wTstop(t: extended); begin if kCount>0 then begin gibAus('Will tstop schreiben, aber der kCount ist '+inttostr(kCount),3); raise exception.create('Will tstop schreiben, aber der kCount ist '+inttostr(kCount)); end; _xtstao['y','y']:=t; end; function tTransformationen.rWmin: extended; begin result:=_wmia['x']; end; procedure tTransformationen.wWmin(w: extended); begin _wmia['x']:=w; end; function tTransformationen.rWmax: extended; begin result:=_wmia['y']; end; procedure tTransformationen.wWmax(w: extended); begin _wmia['y']:=w; end; function tTransformationen.rXsteps: longint; begin result:=xsteps_tsiz['x']; end; procedure tTransformationen.wXsteps(x: longint); begin if kCount>0 then begin gibAus('Will xsteps schreiben, aber der kCount ist '+inttostr(kCount),3); raise exception.create('Will xsteps schreiben, aber der kCount ist '+inttostr(kCount)); end; _xs_ts['x']:=x; end; function tTransformationen.rTsiz: longint; begin result:=xsteps_tsiz['y']; end; function tTransformationen.xsteps_tsiz: tIntPoint; begin if count=0 then result:=_xs_ts else result:=last.xsteps_tsiz; end; procedure tTransformationen.wTsiz(t: longint); begin if kCount>0 then begin gibAus('Will tsiz schreiben, aber der kCount ist '+inttostr(kCount),3); raise exception.create('Will tsiz schreiben, aber der kCount ist '+inttostr(kCount)); end; _xs_ts['y']:=t; end; function tTransformationen.count: longint; begin result:=length(Schritte); end; function tTransformationen.kCount: longint; var i: longint; begin result:=0; for i:=0 to count-1 do if Inhalt[i] is tKoordinatenTransformation then inc(result); end; function tTransformationen.wCount: longint; var i: longint; begin result:=0; for i:=0 to count-1 do if Inhalt[i] is tWerteTransformation then inc(result); end; procedure tTransformationen.achsenUndGroeszeAktualisieren; var i: longint; begin for i:=0 to count-1 do begin if i=0 then begin schritte[i].in_xs_ts:=_xs_ts; schritte[i].in_achsen:=_xtstao; end else begin schritte[i].in_xs_ts:=schritte[i-1].xsteps_tsiz; schritte[i].in_achsen:=schritte[i-1].achsen; end end; end; function tTransformationen.gibAchsen: t2x2Extended; begin if count=0 then result:=_xtstao else result:=last.achsen; end; function tTransformationen.last: tTransformation; begin result:=gibInhalt(count-1); end; procedure tTransformationen.clear; var i: longint; begin for i:=0 to length(Schritte)-1 do if assigned(Schritte[i]) then Schritte[i].free; setlength(Schritte,0); end; procedure tTransformationen.clearWerte; var i,j: longint; begin for i:=0 to length(Schritte)-1 do if assigned(Schritte[i]) and (Schritte[i] is tWerteTransformation) then Schritte[i].free; j:=0; for i:=0 to length(Schritte)-1 do if assigned(Schritte[i]) then begin Schritte[j]:=Schritte[i]; inc(j); end; setlength(Schritte,j); achsenUndGroeszeAktualisieren; end; procedure tTransformationen.addFFT(hor,ver: boolean); begin setlength(Schritte,length(Schritte)+1); Schritte[length(Schritte)-1]:=tFFTTransformation.create; with last as tFFTTransformation do begin horizontal:=hor; vertikal:=ver; end; achsenUndGroeszeAktualisieren; end; procedure tTransformationen.AddSpiegelung; begin setlength(Schritte,length(Schritte)+1); Schritte[length(Schritte)-1]:=tSpiegelungsTransformation.create; achsenUndGroeszeAktualisieren; end; function tTransformationen.add(inh: tTransformation): boolean; begin result:=false; setlength(Schritte,length(Schritte)+1); if inh is tFFTTransformation then Schritte[length(Schritte)-1]:=tFFTTransformation.create(inh as tFFTTransformation) else if inh is tKoordinatenAusschnitt then Schritte[length(Schritte)-1]:=tKoordinatenAusschnitt.create(inh as tKoordinatenAusschnitt) else if inh is tKonkreteKoordinatenTransformation then Schritte[length(Schritte)-1]:=tKonkreteKoordinatenTransformation.create(inh as tKonkreteKoordinatenTransformation) else if inh is tSpiegelungsTransformation then Schritte[length(Schritte)-1]:=tSpiegelungsTransformation.create else if inh is tWerteKnickTransformation then Schritte[length(Schritte)-1]:=tWerteKnickTransformation.create(inh as tWerteKnickTransformation) else if inh is tWerteLogTransformation then Schritte[length(Schritte)-1]:=tWerteLogTransformation.create(inh as tWerteLogTransformation) else if inh is tWerteLogAbsTransformation then Schritte[length(Schritte)-1]:=tWerteLogAbsTransformation.create(inh as tWerteLogAbsTransformation) else if inh is tWerteAbsTransformation then Schritte[length(Schritte)-1]:=tWerteAbsTransformation.create else begin gibAus('Ich kann unbekannten Transformationstyp ('+inh.ClassName+') nicht einfügen, da ich ihn nicht kopieren kann!',3); exit; end; achsenUndGroeszeAktualisieren; result:=true; end; function tTransformationen.add(st: boolean; s: string; f: tMyStringlist; etf: tExprToFloat): boolean; var i: longint; begin result:=false; if s='Knick' then begin setlength(Schritte,length(Schritte)+1); Schritte[length(Schritte)-1]:=tWerteKnickTransformation.create; with (last as tWerteKnickTransformation) do begin setlength(parameter,2); parameter[0]:=0; parameter[1]:=0; repeat if not f.readln(s) 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; exit; end; if startetMit('Log:',s) then begin setlength(Schritte,length(Schritte)+1); Schritte[length(Schritte)-1]:=tWerteLogTransformation.create; (last as tWerteLogTransformation).logMin:=etf(st,s); result:=true; exit; end; if startetMit('AbsLog:',s) then begin setlength(Schritte,length(Schritte)+1); Schritte[length(Schritte)-1]:=tWerteLogAbsTransformation.create; (last as tWerteLogAbsTransformation).logSkala:=etf(st,s); result:=true; exit; end; if s='Abs' then begin setlength(Schritte,length(Schritte)+1); Schritte[length(Schritte)-1]:=tWerteAbsTransformation.create; result:=true; exit; end; gibAus('Kenne Nachbearbeitungsmethode '''+s+''' nicht!',3); end; function tTransformationen.add(syntaxtest: boolean; s: string; xscale,yscale: extended; etf: tExprToFloat): boolean; begin setlength(Schritte,length(Schritte)+1); Schritte[length(Schritte)-1]:=tKonkreteKoordinatenTransformation.create; result:=(last as tKonkreteKoordinatenTransformation).initAbbildung(syntaxtest,s,xscale,yscale,etf); achsenUndGroeszeAktualisieren; end; function tTransformationen.append(inhs: tTransformationen): boolean; var i: longint; begin result:=true; for i:=0 to inhs.count-1 do result:=result and add(inhs[i]); achsenUndGroeszeAktualisieren; end; procedure tTransformationen.addAusschnitt(xmin,xmax,tmin,tmax: longint); begin setlength(Schritte,length(Schritte)+1); Schritte[length(Schritte)-1]:=tKoordinatenAusschnitt.create; (last as tKoordinatenAusschnitt).gr['x','x']:=xmin; (last as tKoordinatenAusschnitt).gr['x','y']:=xmax; (last as tKoordinatenAusschnitt).gr['y','x']:=tmin; (last as tKoordinatenAusschnitt).gr['y','y']:=tmax; achsenUndGroeszeAktualisieren; end; function tTransformationen.kopiereVon(original: tTransformationen): boolean; begin clear; _xs_ts:=original._xs_ts; _xtstao:=original._xtstao; _wmia:=original._wmia; result:=append(original); end; function tTransformationen.transformiereKoordinaten(const lage: tLage; const x: extended): extended; var p: tExtPoint; c,d: char; begin c:=char(ord('x')+byte(not(lage in [lOben,lUnten]))); d:=char(ord('x')+byte(lage in [lOben,lUnten])); if lage in [lLinks,lUnten] then p[d]:=0 else p[d]:=1; p[c]:=(x-gibAchsen[c,'x'])/(gibAchsen[c,'y']-gibAchsen[c,'x']); for d:='x' to 'y' do p[d]:=p[d]*(_xs_ts[d]-1); p:=transformiereKoordinaten(p); result:=p[c]/xsteps_tsiz[c]; end; function tTransformationen.transformiereKoordinaten(const x,y: extended): tExtPoint; begin result['x']:=x; result['y']:=y; result:=transformiereKoordinaten(result); end; function tTransformationen.transformiereKoordinaten(const p: tExtPoint): tExtPoint; var i: longint; begin result:=p; for i:=0 to count-1 do result:=inhalt[i].transformiereKoordinaten(result); end; function tTransformationen.transformiereWert(const x: extended): extended; var i: longint; begin result:=x; for i:=0 to count-1 do result:=inhalt[i].transformiereWert(result); end; function tTransformationen.dumpParams: string; var i: longint; begin result:=inttostr(xsteps)+' x '+inttostr(tsiz)+' ('+floattostr(xstart)+'..'+floattostr(xstop)+' x '+floattostr(tstart)+'..'+floattostr(tstop)+')'; for i:=0 to count-1 do result:=result+#10' '+inhalt[i].dumpParams; end; procedure tTransformationen.berechneZielausdehnung(out grenzen: t2x2Longint); var RandPkt: tExtPoint; i,j,k: longint; c,d: char; begin for c:='x' to 'y' do for d:='x' to 'y' do grenzen[c,d]:=-1; for k:=0 to 1 do for i:=0 to (_xs_ts['x']*(1-k)+_xs_ts['y']*k)-1 do for j:=0 to 1 do begin RandPkt:=transformiereKoordinaten( i*(1-k) + j*k*(_xs_ts['x']-1), j*(1-k)*(_xs_ts['y']-1) + i*k); for c:='x' to 'y' do for d:='x' to 'y' do if ((d='y') xor (grenzen[c,d]>floor(RandPkt[c]) + byte(d='y'))) or ((k=0) and (i=0) and (j=0)) then grenzen[c,d]:=floor(RandPkt[c]) + byte(d='y'); end; end; end.