etliche Prozeduren in ../units/*.pas ausgelagert

1 files changed, 4 insertions, 336 deletions

diff --git a/typenunit.pas b/typenunit.pas
index 54bfca2..20754c0 100644
--- a/typenunit.pas
+++ b/typenunit.pas
@@ -5,7 +5,7 @@ unit typenunit;
 interface
 
 uses
-  sysutils, agg_2D, FPimage, agg_basics, classes, Math, fileUnit;
+  sysutils, agg_2D, FPimage, agg_basics, classes, Math, mystringlistunit, lowlevelunit;
 
 const Speicherhappen = 32768; // Anzahl an mit einem Mal zu reservierender Arrayzellen
       myInf = 1e12;
@@ -16,32 +16,6 @@ type
   tExtraInfos = class;
   tCallBackGetValue = function(name: string): extended of object;
   tExprToFloat = function(syntaxtest: boolean; name: string): extended of object;
-  generic tArray<T> = array of T;
-  tLongintArray = specialize tArray<longint>;
-  pTLongintArray = ^tLongintArray;
-  tSingleArray = specialize tArray<single>;
-  pTSingleArray = ^tSingleArray;
-  tIntPoint = array['x'..'y'] of longint;
-  tExtPoint = array['x'..'y'] of extended;
-  t2x2Longint = array['x'..'y','x'..'y'] of longint;
-  t2x2Extended = array['x'..'y','x'..'y'] of extended;
-  tExtPointArray = specialize tArray<tExtPoint>;
-  pTExtPointArray = ^tExtPointArray;
-  tExtendedArray = specialize tArray<extended>;
-  pTExtendedArray = ^tExtendedArray;
-  tInt32Array = specialize tArray<int32>;
-  tByteArray = specialize tArray<byte>;
-  tStringArray = specialize tArray<string>;
-  tIntPointArray = specialize tArray<tIntPoint>;
-  tRGB = record
-    rgbBlue : byte;
-    rgbGreen: byte;
-    rgbRed  : byte;
-  end;
-  tRgbArray = array of tRGB;
-  tKodierung = (kUnbekannt,k32BitSignedInteger);
-  tWarnstufe = (wsStreng,wsLasch);
-  tGenauigkeit = (gSingle,gExtended);
   tIntegrationsRichtung = (irHorizontal,irEinfall,irAusfall);
   tGenerischeInputDateiInfo = class // nur zum Vererben gedacht, nie selbst instanziieren!
     Name,Fehlerbehebungskommando: string;
@@ -416,7 +390,7 @@ type
     procedure addFFT(hor,ver: boolean);
     procedure AddSpiegelung;
     function add(inh: tTransformation): boolean; overload;
-    function add(st: boolean; s: string; f: tInputFile; etf: tExprToFloat): 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;
@@ -428,33 +402,6 @@ type
     procedure berechneZielausdehnung(out grenzen: t2x2Longint);
   end;
 
-function ZeitDarstellen(t: extended): string;
-function myfloattostr(f: extended): string;
-function floattostrtrunc(f: extended; dig: longint; laessig: boolean): string;
-function binOpPos(op: char; s: string): integer;
-function fktPos(fkt,s: string): integer;
-procedure gibAus(s: string; ausgaben: byte);
-function strToGen(out gen: tGenauigkeit; s: string): boolean;
-function orFarben(a,b: tRGB): tRGB;
-function andFarben(a,b: tRGB): tRGB;
-function wertZuFarbe(x: extended; p: tRGBArray): tRGB;
-function tFPColor2tRgb(c: tFPColor): tRGB;
-function tRgb2tFPColor(c: tRGB): tFPColor;
-procedure myDebugLnThreadLog(s: string);
-function belegterSpeicher: longint;
-procedure cleanupLogs;
-procedure cleanupLog(tid: PtrUInt);
-procedure dumpExceptionCallStack(E: Exception);
-function startetMit(start: string; var s: string): boolean;
-function endetMit(ende: string; var s: string): boolean;
-function trimAll(s: string): string;
-function erstesArgument(var s: string): string; overload;
-function erstesArgument(var s: string; Trenner: string): string; overload;
-function mydatetimetostr(t: tDateTime): string;
-function tExtPointToStr(p: tExtPoint): string;
-function tIntPointToStr(p: tIntPoint): string;
-procedure fehler(s: string);
-
 implementation
 
 // tGenerischeInputDateiInfo ***************************************************
@@ -1847,7 +1794,7 @@ begin
  result:=true;
 end;
 
-function tTransformationen.add(st: boolean; s: string; f: tInputFile; etf: tExprToFloat): boolean;
+function tTransformationen.add(st: boolean; s: string; f: tMyStringlist; etf: tExprToFloat): boolean;
 var i:   longint;
 begin
  result:=false;
@@ -1859,7 +1806,7 @@ begin
      parameter[0]:=0;
      parameter[1]:=0;
      repeat
-       if not f.gibZeile(s) then begin
+       if not f.readln(s) then begin
          gibAus('Unerwartetes Dateiende!',3);
          exit;
        end;
@@ -2012,284 +1959,5 @@ begin
      end;
 end;
 
-// allgemeine Funktionen *******************************************************
-
-function floattostrtrunc(f: extended; dig: longint; laessig: boolean): string;
-begin
-  result:=inttostr(round(f*power(10,dig)));
-  result:=copy(result,1,length(result)-dig)+'.'+copy(result,length(result)-dig+1,dig);
-  if laessig then
-    while result[length(result)]='0' do
-      delete(result,length(result),1);
-  if result[length(result)]='.' then
-    delete(result,length(result),1);
-end;
-
-function myfloattostr(f: extended): string;
-begin
- result:=floattostr(f);
- if pos('E',result)>0 then
-   result:=copy(result,1,pos('E',result)-1)+' x 10^'+copy(result,pos('E',result)+1,length(result));
-end;
-
-function ZeitDarstellen(t: extended): string;
-var schreibe: boolean;
-begin
-  result:='(';
-  schreibe:=t>=1;
-  if schreibe then begin
-    result:=result+inttostr(floor(t))+' Tage ';
-    t:=t-floor(t);
-  end;
-  t:=t*24;
-  schreibe:=schreibe or (t>=1);
-  if schreibe then begin
-    result:=inttostr(floor(t))+':';
-    t:=t-floor(t);
-  end;
-  t:=t*60;
-  schreibe:=schreibe or (t>=1);
-  if schreibe then begin
-    result:=inttostr(floor(t))+':';
-    t:=t-floor(t);
-  end;
-  t:=t*60;
-  result:=result+inttostr(round(t))+' s)';
-end;
-
-function binOpPos(op: char; s: string): integer;
-begin
-  result:=0;
-  repeat
-    result:=result+max(1,pos(op,copy(s,result+1,length(s)-result)));
-  until ((result>1) and not (s[result-1] in ['+','-','*','/','(','E','e'])) or (result>length(s)) or (s[result]<>op);
-  if (result>length(s)) or (s[result]<>op) then result:=0;
-end;
-
-function fktPos(fkt,s: string): integer;
-var tmp: longint;
-begin
-  result:=pos(fkt,s);
-  while (result<>0) and ((result+length(fkt)>length(s)) or not (s[result+length(fkt)] in [' ','('])) do begin
-    tmp:=pos(fkt,copy(s,result+1,length(s)));
-    if tmp=0 then result:=0
-    else result:=result + tmp;
-  end;
-end;
-
-procedure gibAus(s: string; ausgaben: byte);
-begin
-  if odd(ausgaben) then myDebugLnThreadLog(s);
-  if odd(ausgaben div 2) then writeln(s);
-end;
-
-function strToGen(out gen: tGenauigkeit; s: string): boolean;
-begin
-  result:=true;
-  if (s='float') or (s='single') then
-   begin
-    gen:=gSingle;
-    exit;
-   end;
-  if s='extended' then
-   begin
-    gen:=gExtended;
-    exit;
-   end;
-  gibAus('Kenne Genauigkeitstyp '''+s+''' nicht!',3);
-  result:=false;
-end;
-
-function mischeFarben(a,b: tRGB; x: extended): tRGB;
-begin
- result.rgbRed:=min(255,max(0,round(a.rgbRed*(1-x)+b.rgbRed*x)));
- result.rgbGreen:=min(255,max(0,round(a.rgbGreen*(1-x)+b.rgbGreen*x)));
- result.rgbBlue:=min(255,max(0,round(a.rgbBlue*(1-x)+b.rgbBlue*x)));
-end;
-
-function orFarben(a,b: tRGB): tRGB;
-begin
- result.rgbRed:=a.rgbRed or b.rgbRed;
- result.rgbGreen:=a.rgbGreen or b.rgbGreen;
- result.rgbBlue:=a.rgbBlue or b.rgbBlue;
-end;
-
-function andFarben(a,b: tRGB): tRGB;
-begin
- result.rgbRed:=a.rgbRed and b.rgbRed;
- result.rgbGreen:=a.rgbGreen and b.rgbGreen;
- result.rgbBlue:=a.rgbBlue and b.rgbBlue;
-end;
-
-function wertZuFarbe(x: extended; p: tRGBArray): tRGB;
-var i: longint;
-begin
- x:=min(1,max(0,x))*(length(p)-1);
- i:=floor(x);
- if i>=(length(p)-1) then begin
-   result.rgbRed:=p[length(p)-1].rgbRed;
-   result.rgbGreen:=p[length(p)-1].rgbGreen;
-   result.rgbBlue:=p[length(p)-1].rgbBlue;
-   exit;
- end;
- if i<0 then begin
-   result.rgbRed:=p[0].rgbRed;
-   result.rgbGreen:=p[0].rgbGreen;
-   result.rgbBlue:=p[0].rgbBlue;
-   exit;
- end;
- x:=x-i;
- result:=mischeFarben(p[i],p[i+1],x);
-end;
-
-function tFPColor2tRgb(c: tFPColor): tRGB;
-begin
- result.rgbRed:=c.red;
- result.rgbGreen:=c.green;
- result.rgbBlue:=c.blue;
-end;
-
-function tRgb2tFPColor(c: tRGB): tFPColor;
-begin
- result.red:=c.rgbRed;
- result.green:=c.rgbGreen;
- result.blue:=c.rgbBlue;
-end;
-
-procedure myDebugLnThreadLog(s: string);
-var f:  textfile;
-    id: PtrUInt;
-begin
- id:=getThreadID;
- assignfile(f,'Log'+inttostr(id));
- if fileexists('Log'+inttostr(id)) then append(f)
- else rewrite(f);
- writeln(f,inttostr(id)+': '+s);
- closefile(f);
-end;
-
-function belegterSpeicher: longint;
-var f:    textFile;
-    s:    string;
-begin
- s:='/proc/'+inttostr(getProcessId)+'/smaps';
- result:=0;
- if not fileexists(s) then exit;
- assignfile(f,s);
- reset(f);
- while not eof(f) do begin
-   readln(f,s);
-   if (leftStr(s,4)='Rss:') and (rightStr(s,3)=' kB') then begin
-     delete(s,1,4);
-     delete(s,length(s)-2,3);
-     s:=trim(s);
-     result:=result+strtoint(s);
-   end;
- end;
- closefile(f);
-end;
-
-procedure cleanupLogs;
-var sr:  tSearchRec;
-    err: longint;
-begin
- err:=findfirst('Log*',$3f,sr);
- while err=0 do begin
-   deletefile(sr.name);
-   err:=findnext(sr);
- end;
- findclose(sr);
-end;
-
-procedure cleanupLog(tid: PtrUInt);
-var s:    string;
-    Zeit: extended;
-begin
- s:='Log'+inttostr(tid);
- Zeit:=now+1/24/60/60;
- while (not fileexists(s)) and (Zeit>now) do
-   sleep(100);
- if fileexists(s) then
-   deletefile(s)
- else begin
-   gibAus('Datei '''+s+''' kann nicht gelöscht werden, da sie nicht existiert!',3);
-   raise exception.create('Datei '''+s+''' kann nicht gelöscht werden, da sie nicht existiert!');
- end;
-end;
-
-procedure dumpExceptionCallStack(E: Exception);
-var
-  I: Integer;
-  Frames: PPointer;
-  Report: string;
-begin
- Report := 'Program exception! ' + LineEnding +
-   'Stacktrace:' + LineEnding + LineEnding;
- if E <> nil then begin
-   Report := Report + 'Exception class: ' + E.ClassName + LineEnding +
-   'Message: ' + E.Message + LineEnding;
- end;
- Report := Report + BackTraceStrFunc(ExceptAddr);
- Frames := ExceptFrames;
- for I := 0 to ExceptFrameCount - 1 do
-   Report := Report + LineEnding + BackTraceStrFunc(Frames[I]);
- gibAus(Report,3);
-end;
-
-function startetMit(start: string; var s: string): boolean;
-begin
- result:=leftStr(s,length(start))=start;
- if result then
-   s:=trim(rightStr(s,length(s)-length(start)));
-end;
-
-function endetMit(ende: string; var s: string): boolean;
-begin
- result:=rightStr(s,length(ende))=ende;
- if result then
-   s:=trim(leftStr(s,length(s)-length(ende)));
-end;
-
-function trimAll(s: string): string;
-begin
- result:=s;
- while pos(' ',result)>0 do
-   delete(result,pos(' ',result),1);
-end;
-
-function erstesArgument(var s: string): string;
-begin
- result:=erstesArgument(s,' ');
-end;
-
-function erstesArgument(var s: string; Trenner: string): string;
-begin
- result:=copy(s,1,pos(Trenner,s+Trenner)-1);
- delete(s,1,length(result)+length(Trenner));
- s:=trim(s);
- result:=trim(result);
-end;
-
-function mydatetimetostr(t: tDateTime): string;
-begin
- result:=formatDateTime('YYYY.MM.DD_hh.mm.ss',t);
-end;
-
-function tExtPointToStr(p: tExtPoint): string;
-begin
- result:=floattostr(p['x'])+';'+floattostr(p['y']);
-end;
-
-function tIntPointToStr(p: tIntPoint): string;
-begin
- result:=inttostr(p['x'])+';'+inttostr(p['y']);
-end;
-
-procedure fehler(s: string);
-begin
- gibAus(s,1);
- raise exception.create(s);
-end;
-
 end.