path: root/epost.lpr

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<length(wertes) do begin
       wertes[i].beendeLeseThreadWennFertig;
       if (wertes[i].bezeichner<>'') 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<length(Konturen) do begin
       if (Konturen[i].bezeichner<>'') 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.