program epost; {$DEFINE UseCThreads} {$mode objfpc}{$H+} uses {$IFDEF UNIX}{$IFDEF UseCThreads} cthreads, {$ENDIF}{$ENDIF} Classes, { you can add units after this } sysutils, epostunit, mystringlistunit, typenunit, lowlevelunit; var maxthreads,i,j,k: longint; inf: tMyStringlist; s: string; b,syntaxtest,parallelLesen: boolean; wertes: tWerteArray; Konturen: tKonturenArray; Warnstufe: tWarnstufe; procedure werte_aufraeumen; var i: integer; begin for i:=0 to length(wertes)-1 do if assigned(wertes[i]) then wertes[i].free; setlength(wertes,0); for i:=0 to length(Konturen)-1 do if assigned(Konturen[i]) then Konturen[i].free; setlength(Konturen,0); end; procedure aufraeumen; begin warte_auf_externeBefehle; werte_aufraeumen; inf.free; end; begin cleanupLogs; if (not (paramcount in [1,2])) or ((paramcount=2) and (paramstr(2)<>'-L')) or not fileexists(paramstr(1)) then begin gibAus('Verwendung: '+paramstr(0)+' input.epost',3); gibAus('oder: '+paramstr(0)+' input.epost -L',3); halt(1); end; maxthreads:=1; Warnstufe:=wsStreng; parallelLesen:=false; setlength(wertes,0); setlength(Konturen,0); behalteLogs:=(paramcount=2) and (paramstr(2)='-L'); inf:=tMyStringlist.create(nil,''); inf.loadFromFile(paramstr(1)); if not inf.unfoldMacros then begin gibAus('Fehlerhafte input-Datei '''+paramstr(1)+'''!',3); halt(1); end; for syntaxtest:=true downto false do begin if not syntaxtest then gibAus('Syntaxtest bestanden!',3); inf.rewind; while inf.readln(s) do begin i:=0; while i'') and not inf.stillNeed(wertes[i].bezeichner) then begin gibAus('Müllabfuhr löscht Wert Nummer '+inttostr(i)+' mit Bezeichner '''+wertes[i].bezeichner+'''!',3); wertes[i].free; for j:=i+1 to length(wertes)-1 do wertes[j-1]:=wertes[j]; setlength(wertes,length(wertes)-1); continue; end; inc(i); end; i:=0; while i'') and not inf.stillNeed(Konturen[i].bezeichner) then begin gibAus('Müllabfuhr löscht Kontur Nummer '+inttostr(i)+' mit Bezeichner '''+Konturen[i].bezeichner+'''!',3); Konturen[i].free; for j:=i+1 to length(Konturen)-1 do Konturen[j-1]:=Konturen[j]; setlength(Konturen,length(Konturen)-1); continue; end; inc(i); end; if not syntaxtest then begin gibAus('**** '+inttostr(belegterSpeicher div 1024)+' MB Ram belegt',3); for i:=0 to length(wertes)-1 do gibAus(inttostr(i)+' '+wertes[i].bezeichner+' '+inttostr(wertes[i].Transformationen.xsteps)+' '+inttostr(wertes[i].Transformationen.tsiz),3); gibAus('----',3); for i:=0 to length(Konturen)-1 do gibAus(inttostr(i)+' '+Konturen[i].bezeichner,3); gibAus('****',3); end; if s='streng warnen' then begin Warnstufe:=wsStreng; continue; end; if s='lasch warnen' then begin Warnstufe:=wsLasch; continue; end; if s='parallel lesen' then begin parallelLesen:=true; continue; end; if s='sequentiell lesen' then begin parallelLesen:=false; continue; end; if startetMit('externer Befehl:',s) then begin if externerBefehl(syntaxtest,s) then continue; aufraeumen; halt(1); end; if s='warte auf externe Befehle' then begin if not syntaxtest then begin warte_auf_externeBefehle; for i:=0 to length(wertes)-1 do wertes[i].warteAufBeendigungDesLeseThreads; end; continue; end; if startetMit('exprtofloat-Test:',s) then begin gibAus('exprtofloat-Test: '+s+'='+floattostr(wertes[length(wertes)-1].exprtofloat(syntaxtest,s)),3); continue; end; if startetMit('dupliziere:',s) then begin i:=findeWerte(erstesArgument(s),@wertes,@Konturen,false); if i<0 then begin aufraeumen; halt(1); end; j:=findeWerte(s,@wertes,@Konturen,true); if j<0 then begin aufraeumen; halt(1); end; wertes[j].kopiereVon(syntaxtest,wertes[i]); continue; end; if startetMit('Daten einlesen',s) then begin i:=findeWerte(s,@wertes,@Konturen,true); if i<0 then begin aufraeumen; halt(1); end; if wertes[i].ladeDateien(syntaxtest,inf,parallelLesen) then begin continue; end; aufraeumen; halt(1); end; if startetMit('Ascii laden',s) then begin if not (s[1] in ['0'..'9']) then begin setlength(wertes,length(wertes)+1); wertes[length(wertes)-1]:=tWerte.create; i:=length(wertes)-1; end else i:=strtoint(erstesArgument(s)); if wertes[i].ladeAscii(syntaxtest,s) then continue; aufraeumen; halt(1); end; if startetMit('Linearkombination',s) then begin i:=findeWerte(s,@wertes,@Konturen,true); if i<0 then begin aufraeumen; halt(1); end; if wertes[i].berechneLiKo(syntaxtest,inf,maxthreads) then continue; aufraeumen; halt(1); end; if startetMit('Teile',s) then begin i:=findeWerte(erstesArgument(s),@wertes,@Konturen,false); if i<0 then begin aufraeumen; halt(1); end; if (not startetMit('durch ',s)) or (length(s)=0) then begin gibAus('Fehlende Parameter, erwartet: ''Teile $Dividend durch $Divisor (zu $Quotient)''',3); aufraeumen; halt(1); end; j:=findeWerte(erstesArgument(s),@wertes,@Konturen,false); if j<0 then begin aufraeumen; halt(1); end; b:=not startetMit('zu',s); k:=findeWerte(s,@wertes,@Konturen,b); if k<0 then begin aufraeumen; halt(1); end; if wertes[k].berechneQuotient(syntaxtest,inf,maxthreads,i,j) then continue; aufraeumen; halt(1); end; if startetMit('Multipliziere',s) then begin i:=findeWerte(erstesArgument(s),@wertes,@Konturen,false); if i<0 then begin aufraeumen; halt(1); end; if (not startetMit('mal ',s)) or (length(s)=0) then begin gibAus('Fehlende Parameter, erwartet: ''Multipliziere $Faktor mal $Faktor (zu $Produkt)''',3); aufraeumen; halt(1); end; j:=findeWerte(erstesArgument(s),@wertes,@Konturen,false); if j<0 then begin aufraeumen; halt(1); end; b:=not startetMit('zu',s); k:=findeWerte(s,@wertes,@Konturen,b); if k<0 then begin aufraeumen; halt(1); end; if wertes[k].berechneProdukt(syntaxtest,inf,maxthreads,i,j) then continue; aufraeumen; halt(1); end; if startetMit('FFT2d',s) then begin if s='' then i:=length(wertes)-1 else i:=findeWerte(s,@wertes,@Konturen,false); if i<0 then begin aufraeumen; halt(1); end; if wertes[i].berechneFFT2d(syntaxtest,inf,maxthreads,Warnstufe) then continue; aufraeumen; halt(1); end; if startetMit('FFT',s) then begin if s='' then i:=length(wertes)-1 else i:=findeWerte(s,@wertes,@Konturen,false); if i<0 then begin aufraeumen; halt(1); end; if wertes[i].berechneFFT(syntaxtest,inf,maxthreads,Warnstufe) then continue; aufraeumen; halt(1); end; if startetMit('Zeitfrequenzanalyse',s) then begin if s='' then j:=length(wertes)-1 else j:=findeWerte(erstesArgument(s),@wertes,@Konturen,false); if j<0 then begin aufraeumen; halt(1); end; i:=findeWerte(s,@wertes,@Konturen,true); if i<0 then begin aufraeumen; halt(1); end; if wertes[i].berechneZeitfrequenzanalyse(syntaxtest,inf,maxthreads,wertes[j],Warnstufe) then continue; aufraeumen; halt(1); end; if startetMit('Verzerrung',s) then begin if s='' then j:=length(wertes)-1 else j:=findeWerte(erstesArgument(s),@wertes,@Konturen,false); if j<0 then begin aufraeumen; halt(1); end; i:=findeWerte(s,@wertes,@Konturen,true); if i<0 then begin aufraeumen; halt(1); end; if wertes[i].berechneVerzerrung(syntaxtest,inf,maxthreads,wertes[j],Warnstufe) then continue; aufraeumen; halt(1); end; if startetMit('Integral',s) then begin if s='' then j:=length(wertes)-1 else j:=findeWerte(erstesArgument(s),@wertes,@Konturen,false); if j<0 then begin aufraeumen; halt(1); end; i:=findeWerte(s,@wertes,@Konturen,true); if i<0 then begin aufraeumen; halt(1); end; if wertes[i].berechneIntegral(syntaxtest,inf,maxthreads,wertes[j]) then continue; aufraeumen; halt(1); end; if startetMit('Korrelation',s) then begin if s='' then j:=length(wertes)-1 else j:=findeWerte(erstesArgument(s),@wertes,@Konturen,false); if j<0 then begin aufraeumen; halt(1); end; i:=findeWerte(s,@wertes,@Konturen,true); if i<0 then begin aufraeumen; halt(1); end; if wertes[i].berechneKorrelation(syntaxtest,inf,maxthreads,wertes[j]) then continue; aufraeumen; halt(1); end; if startetMit('Threadanzahl:',s) then begin maxThreads:=strtoint(s); continue; end; if startetMit('maximale und minimale Dichten bestimmen',s) then begin b:=startetMit('(symmetrisch)',s); if s='' then i:=length(wertes)-1 else findeWerte(s,@wertes,@Konturen,false); if i<0 then begin aufraeumen; halt(1); end; wertes[i].ermittleMinMaxDichten(syntaxtest,maxThreads,b); continue; end; if startetMit('lineares Bild',s) then begin if s='' then i:=length(wertes)-1 else i:=findeWerte(s,@wertes,@Konturen,false); if i<0 then begin aufraeumen; halt(1); end; if not wertes[i].erzeugeLinearesBild(syntaxtest,inf,maxthreads) then begin aufraeumen; halt(1); end; continue; end; if startetMit('Ascii',s) then begin if s='' then i:=length(wertes)-1 else i:=findeWerte(s,@wertes,@Konturen,false); if i<0 then begin aufraeumen; halt(1); end; if not wertes[i].erzeugeAscii(syntaxtest,inf) then begin aufraeumen; halt(1); end; continue; end; if startetMit('Lineout',s) then begin if pos(':',s)=1 then i:=length(wertes)-1 else i:=findeWerte(erstesArgument(s,':'),@wertes,@Konturen,false); if (i<0) or not wertes[i].erzeugeLineout(syntaxtest,s) then begin aufraeumen; halt(1); end; continue; end; if startetMit('Binning',s) then begin if pos(':',s)=1 then i:=length(wertes)-1 else i:=findeWerte(erstesArgument(s,':'),@wertes,@Konturen,false); if (i<0) or not wertes[i].erzeugeBinning(syntaxtest,s) then begin aufraeumen; halt(1); end; continue; end; if startetMit('Lösche:',s) then begin s:=s+' '; while pos(' ',s)>0 do begin j:=findeWerte(erstesArgument(s),@wertes,@Konturen,false); if j<0 then begin aufraeumen; halt(1); end; wertes[j].free; for i:=j+1 to length(wertes)-1 do wertes[i-1]:=wertes[i]; setlength(wertes,length(wertes)-1); end; continue; end; if s='Palette' then begin if neuePalette(inf) then continue; aufraeumen; halt(1); end; if startetMit('Kontur',s) then begin i:=findeKontur(s,@Konturen,true); if (i>=0) and Konturen[i].Init(syntaxtest,inf,@wertes,maxthreads) then continue; aufraeumen; halt(1); end; if s='Dateiende' then break; gibAus('Befehl '''+s+''' ist unverständlich in '''+paramstr(1)+'''!',3); aufraeumen; halt(1); end; werte_aufraeumen; end; aufraeumen; if not behalteLogs then cleanupLogs; end.