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, lowlevelunit; var maxThreads,i,j,k: longint; inf,bekannteBefehle: tMyStringList; s,name: string; b1,b2,syntaxTest,parallelLesen: boolean; wertes: tWerteArray; konturen: tKonturenArray; Warnstufe: tWarnStufe; f: textFile; {$I githash.inc} procedure werteAufraeumen; 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 warteAufExterneBefehle; werteAufraeumen; inf.free; end; begin gibAus('Kopmiliert an '+{$I %DATE%}+' '+{$I %TIME%},1); if (not (paramcount in [1,2])) or ((paramcount=2) and (paramstr(2)<>'-L') and (paramstr(2)<>'-C')) or not fileExists(paramstr(1)) then begin gibAus('Verwendung: '+paramstr(0)+' input.epost',3); gibAus('oder: '+paramstr(0)+' input.epost -C',3); gibAus('oder: '+paramstr(0)+' input.epost -L',3); halt(1); end; if (paramcount=2) and (paramstr(2)='-C') then cleanupLogs; maxThreads:=1; Warnstufe:=wsStreng; parallelLesen:=false; setLength(wertes,0); setLength(konturen,0); behalteLogs:=(paramcount=2) and (paramstr(2)='-L'); assignFile(f,extractFileDir(paramstr(1))+'/.'+extractFileName(paramstr(1))+'.run'); rewrite(f); writeln(f,gitRevision+' '+compilerVersion+' '+intToStr(round(now*24*60*60))); closeFile(f); inf:=tMyStringList.create(nil,''); inf.nichtInSubRoutine('^lösche Werte '); // Zeilen, die hierauf passen, werden nicht an subRoutinen-Aufrufe inf.nichtInSubRoutine('^lösche Kontur '); // von metaReadln gegeben, sondern nach hinten ans Hauptprogramm verschoben inf.loadFromFile(paramstr(1)); if not inf.unfoldMacros then begin inf.free; fehler('Fehlerhafte input-Datei '''+paramstr(1)+'''!'); end; bekannteBefehle:=tMyStringList.create; for syntaxTest:=true downto false do begin if not syntaxTest then gibAus('Syntaxtest bestanden!',3); inf.rewind; repeat if not inf.metaReadln(s,false) then begin gibAus('Unerwartetes Dateiende in '''+paramstr(1)+'''!',3); aufraeumen; halt(1); end; for i:=0 to length(wertes)-1 do wertes[i].beendeLeseThreadWennFertig; beendeExterneBefehleWennFertig; bekannteBefehle.clear; if istDasBefehl('streng warnen',s,bekannteBefehle,false) then begin Warnstufe:=wsStreng; continue; end; if istDasBefehl('lasch warnen',s,bekannteBefehle,false) then begin Warnstufe:=wsLasch; continue; end; if istDasBefehl('parallel lesen',s,bekannteBefehle,false) then begin parallelLesen:=true; continue; end; if istDasBefehl('sequentiell lesen',s,bekannteBefehle,false) then begin parallelLesen:=false; continue; end; if istDasBefehl('ohne Logdateien',s,bekannteBefehle,false) then begin __ausgabenMaske:=__ausgabenMaske or 1; continue; end; if istDasBefehl('mit Logdateien',s,bekannteBefehle,false) then begin __ausgabenMaske:=__ausgabenMaske and not 1; continue; end; if istDasBefehl('ohne Bildschirmausgaben',s,bekannteBefehle,false) then begin __ausgabenMaske:=__ausgabenMaske or 2; continue; end; if istDasBefehl('mit Bildschirmausgaben',s,bekannteBefehle,false) then begin __ausgabenMaske:=__ausgabenMaske and not 2; continue; end; if istDasBefehl('externer Befehl:',s,bekannteBefehle,true) then begin if externerBefehl(syntaxTest,s) then continue; aufraeumen; halt(1); end; if istDasBefehl('warte auf externe Befehle',s,bekannteBefehle,false) then begin if not syntaxTest then begin warteAufExterneBefehle; for i:=0 to length(wertes)-1 do wertes[i].warteAufBeendigungDesLeseThreads; end; continue; end; if istDasBefehl('exprtofloat-Test:',s,bekannteBefehle,true) then begin gibAus('exprtofloat-Test: '+s+'='+floatToStr(wertes[length(wertes)-1].exprToFloat(syntaxTest,s)),3); continue; end; if istDasBefehl('Wert',s,bekannteBefehle,true) then begin name:=erstesArgument(s); if not startetMit('aus ',s) then begin gibAus('Fehlende Parameter, erwartet: ''Wert $Name aus $Werten berechnen durch $Formel''',3); aufraeumen; halt(1); end; i:=findeWerte(erstesArgument(s),inf,@wertes,@konturen,true); if i<0 then begin gibAus('Fehlende Parameter, erwartet: ''Wert $Name aus $Werten berechnen durch $Formel''',3); aufraeumen; halt(1); end; if not startetMit('berechnen durch ',s) then begin gibAus('Fehlende Parameter, erwartet: ''Wert $Name aus $Werten berechnen durch $Formel''',3); aufraeumen; halt(1); end; globaleWerte.add(name,wertes[i].exprToFloat(syntaxTest,s)); continue; end; if istDasBefehl('dupliziere',s,bekannteBefehle,true) then begin i:=findeWerte(erstesArgument(s),nil,@wertes,@konturen,false); if i<0 then begin aufraeumen; halt(1); end; if not startetMit('zu ',s) then begin gibAus('Fehlende Parameter, erwartet: ''dupliziere $Original zu $Kopie''',3); aufraeumen; halt(1); end; j:=findeWerte(s,inf,@wertes,@konturen,true); if j<0 then begin aufraeumen; halt(1); end; wertes[j].kopiereVon(syntaxTest,wertes[i]); continue; end; if istDasBefehl('Radon-Transformation',s,bekannteBefehle,true) then begin i:=findeWerte(erstesArgument(s),nil,@wertes,@konturen,false); if i<0 then begin aufraeumen; halt(1); end; if not startetMit('zu ',s) then begin gibAus('Fehlende Parameter, erwartet: ''Radon $Quelle zu $Ziel''',3); aufraeumen; halt(1); end; j:=findeWerte(s,inf,@wertes,@konturen,true); if j<0 then begin aufraeumen; halt(1); end; if wertes[j].berechneRadonTransformation(syntaxTest,inf,maxThreads,wertes[i],Warnstufe) then continue; aufraeumen; halt(1); end; if istDasBefehl('erzeuge Dummy-Werte',s,bekannteBefehle,true) then begin b1:=startetMit('gefüllt',s); i:=findeWerte(s,inf,@wertes,@konturen,true); if i<0 then begin aufraeumen; halt(1); end; wertes[i].free; wertes[i]:=tWerte.create(@konturen,@wertes); wertes[i].bezeichner:=s; if b1 then wertes[i].fuelleMitDummys(syntaxTest); continue; end; if istDasBefehl('Nullen einfügen in',s,bekannteBefehle,true) then begin i:=findeWerte(s,inf,@wertes,@konturen,true); if i<0 then begin aufraeumen; halt(1); end; if wertes[i].nullenEinfuegen(syntaxTest,inf) then continue; aufraeumen; halt(1); end; if istDasBefehl('mache komplex',s,bekannteBefehle,true) then begin i:=findeWerte(s,inf,@wertes,@konturen,false); if i<0 then begin aufraeumen; halt(1); end; if wertes[i].macheKomplex(syntaxTest,inf,maxThreads) then continue; aufraeumen; halt(1); end; if istDasBefehl('Daten einlesen',s,bekannteBefehle,true) then begin b1:=not startetMit('(ohne Ausgaben)',s); i:=findeWerte(s,inf,@wertes,@konturen,true); if i<0 then begin aufraeumen; halt(1); end; if wertes[i].ladeDateien(syntaxTest,inf,parallelLesen,b1) then continue; aufraeumen; halt(1); end; if istDasBefehl('Ascii laden',s,bekannteBefehle,true) then begin i:=findeWerte(erstesArgument(s),inf,@wertes,@konturen,true); if wertes[i].ladeAscii(syntaxTest,s) then continue; aufraeumen; halt(1); end; if istDasBefehl('Linearkombination',s,bekannteBefehle,true) then begin i:=findeWerte(s,inf,@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 istDasBefehl('Agglomeration',s,bekannteBefehle,true) then begin i:=findeWerte(s,inf,@wertes,@konturen,true); if i<0 then begin aufraeumen; halt(1); end; if wertes[i].berechneAgglomeration(syntaxTest,inf) then continue; aufraeumen; halt(1); end; if istDasBefehl('teile',s,bekannteBefehle,true) then begin i:=findeWerte(erstesArgument(s),nil,@wertes,@konturen,false); if i<0 then begin aufraeumen; halt(1); end; if not startetMit('durch ',s) then begin gibAus('Fehlende Parameter, erwartet: ''teile $Dividend durch $Divisor zu $Quotient''',3); aufraeumen; halt(1); end; j:=findeWerte(erstesArgument(s),nil,@wertes,@konturen,false); if j<0 then begin aufraeumen; halt(1); end; if not startetMit('zu ',s) then begin gibAus('Fehlende Parameter, erwartet: ''teile $Dividend durch $Divisor zu $Quotient''',3); aufraeumen; halt(1); end; k:=findeWerte(s,inf,@wertes,@konturen,true); 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 istDasBefehl('multipliziere',s,bekannteBefehle,true) then begin i:=findeWerte(erstesArgument(s),nil,@wertes,@konturen,false); if i<0 then begin aufraeumen; halt(1); end; if not startetMit('mal ',s) then begin gibAus('Fehlende Parameter, erwartet: ''multipliziere $Faktor mal $Faktor zu $Produkt''',3); aufraeumen; halt(1); end; j:=findeWerte(erstesArgument(s),nil,@wertes,@konturen,false); if j<0 then begin aufraeumen; halt(1); end; if not startetMit('zu ',s) then begin gibAus('Fehlende Parameter, erwartet: ''multipliziere $Faktor mal $Faktor zu $Produkt''',3); aufraeumen; halt(1); end; k:=findeWerte(s,inf,@wertes,@konturen,true); 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 istDasBefehl('Autokorrelation2d',s,bekannteBefehle,true) then begin i:=findeWerte(s,inf,@wertes,@konturen,true); if i<0 then begin aufraeumen; halt(1); end; if wertes[i].berechneAutokorrelation2d(syntaxTest,inf,maxThreads,Warnstufe) then continue; aufraeumen; halt(1); end; if istDasBefehl('FFT2d',s,bekannteBefehle,true) then begin i:=findeWerte(s,inf,@wertes,@konturen,true); if i<0 then begin aufraeumen; halt(1); end; if wertes[i].berechneFFT2d(syntaxTest,inf,maxThreads,Warnstufe) then continue; aufraeumen; halt(1); end; if istDasBefehl('FFT',s,bekannteBefehle,true) then begin i:=findeWerte(s,inf,@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 istDasBefehl('fitte Gauße an',s,bekannteBefehle,true) then begin i:=findeWerte(s,nil,@wertes,@konturen,false); if i<0 then begin aufraeumen; halt(1); end; if wertes[i].fitteGausze(syntaxTest,inf,maxThreads) then continue; aufraeumen; halt(1); end; if istDasBefehl('fitte 2d-Gauße an',s,bekannteBefehle,true) then begin i:=findeWerte(s,nil,@wertes,@konturen,false); if i<0 then begin aufraeumen; halt(1); end; if wertes[i].fitte2dGausze(syntaxTest,inf) then continue; aufraeumen; halt(1); end; if istDasBefehl('faktorisiere',s,bekannteBefehle,true) then begin i:=findeWerte(s,nil,@wertes,@konturen,false); if i<0 then begin aufraeumen; halt(1); end; if wertes[i].faktorisiere(syntaxTest,inf) then continue; aufraeumen; halt(1); end; if istDasBefehl('Zeitfrequenzanalyse',s,bekannteBefehle,true) then begin j:=findeWerte(erstesArgument(s),nil,@wertes,@konturen,false); if j<0 then begin aufraeumen; halt(1); end; if not startetMit('zu ',s) then begin gibAus('Fehlende Parameter, erwartet: ''Zeitfrequenzanalyse $Original zu $Analyse''',3); aufraeumen; halt(1); end; i:=findeWerte(s,inf,@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 istDasBefehl('Verzerrung',s,bekannteBefehle,true) then begin j:=findeWerte(erstesArgument(s),nil,@wertes,@konturen,false); if j<0 then begin aufraeumen; halt(1); end; if not startetMit('zu ',s) then begin gibAus('Fehlende Parameter, erwartet: ''Verzerrung $Original zu $Bild''',3); aufraeumen; halt(1); end; i:=findeWerte(s,inf,@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 istDasBefehl('lambda',s,bekannteBefehle,true) then begin j:=findeWerte(erstesArgument(s),nil,@wertes,@konturen,false); if j<0 then begin aufraeumen; halt(1); end; if not startetMit('zu omega ',s) then begin gibAus('Fehlende Parameter, erwartet: ''lambda $original zu omega $Daten''',3); aufraeumen; halt(1); end; i:=findeWerte(s,inf,@wertes,@konturen,true); if i<0 then begin aufraeumen; halt(1); end; if wertes[i].berechneLambdaZuOmegaVerzerrung(syntaxTest,inf,maxThreads,wertes[j]) then continue; aufraeumen; halt(1); end; if istDasBefehl('entferne Artefakte in',s,bekannteBefehle,true) then begin i:=findeWerte(s,nil,@wertes,@konturen,false); if i<0 then begin aufraeumen; halt(1); end; if wertes[i].entferneArtefakte(syntaxTest,inf,maxThreads) then continue; aufraeumen; halt(1); end; if istDasBefehl('entferne nullte Ordnung in',s,bekannteBefehle,true) then begin i:=findeWerte(s,nil,@wertes,@konturen,false); if i<0 then begin aufraeumen; halt(1); end; if wertes[i].entferneNullteOrdnung(syntaxTest,inf,maxThreads) then continue; aufraeumen; halt(1); end; if istDasBefehl('extrahiere Einhüllende von',s,bekannteBefehle,true) then begin i:=findeWerte(s,nil,@wertes,@konturen,false); if i<0 then begin aufraeumen; halt(1); end; if wertes[i].extrahiereEinhuellende(syntaxTest,inf,maxThreads,Warnstufe) then continue; aufraeumen; halt(1); end; if istDasBefehl('extrahiere Phase von',s,bekannteBefehle,true) then begin i:=findeWerte(s,nil,@wertes,@konturen,false); if i<0 then begin aufraeumen; halt(1); end; if wertes[i].extrahierePhase(syntaxTest,inf,maxThreads,Warnstufe) then continue; aufraeumen; halt(1); end; if istDasBefehl('extrahiere Kanten von',s,bekannteBefehle,true) then begin i:=findeWerte(s,nil,@wertes,@konturen,false); if i<0 then begin aufraeumen; halt(1); end; if wertes[i].extrahiereKanten(syntaxTest,inf,maxThreads) then continue; aufraeumen; halt(1); end; if istDasBefehl('ermittle Anstieg',s,bekannteBefehle,true) then begin if not ermittleAnstieg(syntaxTest,s) then begin aufraeumen; halt(1); end; continue; end; if istDasBefehl('ermittle Mittelwert',s,bekannteBefehle,true) then begin if not ermittleMittelwert(syntaxTest,s) then begin aufraeumen; halt(1); end; continue; end; if istDasBefehl('skaliere',s,bekannteBefehle,true) then begin i:=findeWerte(s,nil,@wertes,@konturen,false); if i<0 then begin aufraeumen; halt(1); end; if wertes[i].skaliere(syntaxTest,inf,maxThreads) then continue; aufraeumen; halt(1); end; if istDasBefehl('finde zweitdominantesten Punkt in',s,bekannteBefehle,true) then begin i:=findeWerte(s,nil,@wertes,@konturen,false); if i<0 then begin aufraeumen; halt(1); end; if wertes[i].findeZweitdominantestenPunkt(syntaxTest,inf) then continue; aufraeumen; halt(1); end; if istDasBefehl('finde Maximum von',s,bekannteBefehle,true) then begin i:=findeWerte(s,nil,@wertes,@konturen,false); if i<0 then begin aufraeumen; halt(1); end; if wertes[i].findeMaximum(syntaxTest,inf,maxThreads,Warnstufe) then continue; aufraeumen; halt(1); end; if istDasBefehl('integriere',s,bekannteBefehle,true) then begin j:=findeWerte(erstesArgument(s),nil,@wertes,@konturen,false); if j<0 then begin aufraeumen; halt(1); end; if not startetMit('zu ',s) then begin gibAus('Fehlende Parameter, erwartet: ''integriere $Funktion zu $Stammfunktion''',3); aufraeumen; halt(1); end; i:=findeWerte(s,inf,@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 istDasBefehl('korreliere',s,bekannteBefehle,true) then begin j:=findeWerte(erstesArgument(s),nil,@wertes,@konturen,false); if j<0 then begin aufraeumen; halt(1); end; if not startetMit('zu ',s) then begin gibAus('Fehlende Parameter, erwartet: ''korreliere $Original zu $Korrelation''',3); aufraeumen; halt(1); end; i:=findeWerte(s,inf,@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 istDasBefehl('Threadanzahl:',s,bekannteBefehle,true) then begin maxThreads:=strToInt(s); continue; end; if istDasBefehl('maximale und minimale Dichten bestimmen',s,bekannteBefehle,true) then begin b1:=startetMit('(symmetrisch) ',s); b2:=endetMit(':',s); i:=findeWerte(s,nil,@wertes,@konturen,false); if i<0 then begin aufraeumen; halt(1); end; if b2 then wertes[i].ermittleMinMaxDichten(syntaxTest,inf,maxThreads,b1) else wertes[i].ermittleMinMaxDichten(syntaxTest,maxThreads,b1); continue; end; if istDasBefehl('maximale und minimale Dichten angleichen',s,bekannteBefehle,true) then begin b1:=startetMit('(symmetrisch) ',s); i:=findeWerte(s,nil,@wertes,@konturen,false); if i<0 then begin aufraeumen; halt(1); end; wertes[i].gleicheMinMaxDichtenAn(syntaxTest,inf,b1); continue; end; if istDasBefehl('lineares Bild',s,bekannteBefehle,true) then begin i:=findeWerte(s,nil,@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 istDasBefehl('Ascii',s,bekannteBefehle,true) then begin i:=findeWerte(s,nil,@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 istDasBefehl('Lineout',s,bekannteBefehle,true) then begin i:=findeWerte(s,nil,@wertes,@konturen,false); if i<0 then begin aufraeumen; halt(1); end; if not wertes[i].erzeugeLineout(syntaxTest,inf) then begin aufraeumen; halt(1); end; continue; end; if istDasBefehl('Binning',s,bekannteBefehle,true) then begin i:=findeWerte(erstesArgument(s),nil,@wertes,@konturen,false); if (i<0) or not wertes[i].erzeugeBinning(syntaxTest,s) then begin aufraeumen; halt(1); end; continue; end; if istDasBefehl('lösche Werte',s,bekannteBefehle,true) then begin while s<>'' do begin j:=findeWerte(erstesArgument(s),nil,@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 istDasBefehl('lösche Kontur',s,bekannteBefehle,true) then begin while s<>'' do begin j:=findeKontur(erstesArgument(s),nil,@wertes,@konturen,false); if j<0 then begin aufraeumen; halt(1); end; konturen[j].free; for i:=j+1 to length(konturen)-1 do konturen[i-1]:=konturen[i]; setLength(konturen,length(konturen)-1); end; continue; end; if istDasBefehl('Palette',s,bekannteBefehle,false) then begin if neuePalette(inf) then continue; aufraeumen; halt(1); end; if istDasBefehl('Kontur',s,bekannteBefehle,true) then begin i:=findeKontur(s,inf,@wertes,@konturen,true); if (i>=0) and konturen[i].init(syntaxTest,inf,@wertes,maxThreads) then continue; aufraeumen; halt(1); end; if istDasBefehl('lies Wert',s,bekannteBefehle,true) then begin if not liesWert(syntaxTest,s) then begin aufraeumen; halt(1); end; continue; end; if istDasBefehl('Dateiende',s,bekannteBefehle,false) then break; bekannteBefehle.sort; gibAus('Befehl '''+s+''' ist unverständlich in '''+paramstr(1)+'''!'#10'Ich kenne:'#10+bekannteBefehle.text,3); aufraeumen; halt(1); until false; werteAufraeumen; end; aufraeumen; if not behalteLogs then cleanupLog(threadID); end.