unit pegelunit; {$mode objfpc}{$H+} interface uses cthreads, Classes, SysUtils, Graphics, ExtCtrls, lowlevelunit, Process; type tPegelStaende = class; tPegelZeitGroesze = (pzgJahr,pzgMonat,pzgTag,pzgStunde,pzgMin15); tPegelZeit = array[tPegelZeitgroesze] of word; tPegelStation = (psBlankenstein,psKaulsdorf,psSaalfeld,psRudolstadt, psRothenstein,psCamburg,psMoeschlitz,psProbstzella,psKaulsdorfEichicht, psKatzhuette,psSchwarzburg,psFreienorla); tPegelStationsSet = set of tPegelStation; tPegelStand = class private _zeit: tPegelZeit; _uZeit: extended; _hoehe: longint; procedure setzeUZeit; procedure setzeZeit; public constructor create; destructor destroy; override; function schreibe: string; procedure lade(s: string); property zeit: extended read _uzeit; property hoehe: longint read _hoehe; procedure dump(p: pointer); procedure pmud(p: pointer); function size: longint; end; tPegelListe = class private inhalt: tFPList; function rItem(i: longint): tPegelStand; function bisekt(zeit: extended): longint; public constructor create; destructor destroy; override; procedure add(s: string); function last: tPegelStand; function count: longint; property items[i: longint]: tPegelStand read rItem; default; function minMaxY(startZeit,stopZeit: extended): tPoint; procedure dump(p: pointer); procedure pmud(p: pointer; version,len: longint); function size: longint; end; tPegelUpdateThread = class(tThread) private _besitzer: tPegelStaende; antwort: string; ladeProzess: tProcess; beendet, synchronized: boolean; nPegel: tPegelStation; procedure uebernehmen; procedure mySynchronize(aMethod: TThreadMethod); public beenden: boolean; constructor create(besitzer: tPegelStaende); destructor destroy; override; procedure execute; override; end; tPegelStaende = class private bild: tImage; werte: array[tPegelStation] of tPegelListe; put: tPegelUpdateThread; public constructor create(zeichenFlaeche: tImage); destructor destroy; override; procedure einlesen(was: string); procedure laden(von: string); procedure speichern(nach: string); procedure achsenZeichnen(zuZeichnen: tPegelStationsSet; startZeit,stopZeit: extended); procedure graphenZeichnen(zuZeichnen: tPegelStationsSet; startZeit,stopZeit: extended); procedure putBeenden; function hintInfo: string; end; implementation uses math, unit1, myStringListUnit, fileUnit; const pegelStationsNamen: array[tPegelstation] of array[0..2] of string = (('Blankenstein','Blankenstein-Ros.','Blankenstein-Rosenthal'), ('Kaulsdorf','',''), ('Saalfeld-Remschütz','',''), ('Rudolstadt','',''), ('Rothenstein','',''), ('Camburg-Stöben','',''), ('Möschlitz','',''), ('Probstzella','',''), ('Kaulsdorf-Eichicht','',''), ('Katzhütte','',''), ('Schwarzburg','',''), ('Freienorla','','')); pegelStationsNummern: array[tPegelstation] of extended = (57021,57025,57026,57027,57028,57033,57170,57200,57201,57211,57211.5,57240); pegelGrenzen: array[tPegelstation,0..4] of longint = ((0,210,230,270,310),(0,195,210,225,240),(0,200,230,260,290),(0,150,180,210,240), (160,250,290,330,370),(0,280,330,380,430),(0,180,200,220,240),(0,0,0,0,0), (0,130,170,210,230),(0,200,230,260,290),(0,130,150,170,190),(0,0,0,0,0)); pegelFarben: array[tPegelstation] of tColor = ($000000,$000000,$000000,$FF0000,$7F0000,$000000,$000000,$000000,$000000,$000000,$000000,$000000); // tPegelStand ***************************************************************** constructor tPegelStand.create; var pzg: tPegelZeitGroesze; begin inherited create; for pzg:=low(tPegelZeitGroesze) to high(tPegelZeitGroesze) do _zeit[pzg]:=0; _hoehe:=-1; end; destructor tPegelStand.destroy; begin inherited destroy; end; procedure tPegelStand.setzeUZeit; begin _uZeit:= encodeDate(_zeit[pzgJahr],_zeit[pzgMonat],_zeit[pzgTag])+ encodeTime(_zeit[pzgStunde],_zeit[pzgMin15]*15,0,0) end; procedure tPegelStand.setzeZeit; var mi,se,hu: word; begin decodeDate(_uZeit,_zeit[pzgJahr],_zeit[pzgMonat],_zeit[pzgTag]); decodeTime(_uZeit,_zeit[pzgStunde],mi,se,hu); _zeit[pzgMin15]:=round(mi/15); end; function tPegelStand.schreibe: string; var pzg: tPegelZeitGroesze; begin result:=''; for pzg:=low(tPegelZeitGroesze) to high(tPegelZeitGroesze) do result:=result+inttostr(_zeit[pzg])+' '; result:=result+inttostr(_hoehe); end; procedure tPegelStand.lade(s: string); var pzg: tPegelZeitGroesze; begin if pos(',',s)=0 then begin // Syntax wie in letzte_Pegel for pzg:=low(tPegelZeitGroesze) to high(tPegelZeitGroesze) do _zeit[pzg]:=strtoint(erstesArgument(s)); _hoehe:=strtoint(s); setzeUZeit; end else begin {$WARNINGS-} dateSeparator:='.'; shortDateFormat:='d.m.y'; {$WARNINGS+} _uZeit:=strToDateTime(erstesArgument(s,',')); _hoehe:=strtoint(s); setzeZeit; end; end; procedure tPegelStand.dump(p: pointer); begin pExtended(p)^:=_uZeit; pLongint(p+sizeof(extended))^:=_hoehe; end; procedure tPegelStand.pmud(p: pointer); begin _uZeit:=pExtended(p)^; _hoehe:=pLongint(p+sizeof(extended))^; setzeZeit; end; function tPegelStand.size: longint; begin result:=sizeof(extended)+sizeof(longint); end; // tPegelListe ***************************************************************** constructor tPegelListe.create; begin inherited create; inhalt:=tFPList.create; end; destructor tPegelListe.destroy; begin inhalt.free; inherited destroy; end; function tPegelListe.rItem(i: longint): tPegelStand; begin result:=tPegelStand(inhalt[i]); end; function tPegelListe.bisekt(zeit: extended): longint; var mi,ma,neu: longint; begin mi:=0; neu:=mi; ma:=count; while mi=count) or (items[neu].zeitzeit then begin ma:=neu; continue; end; result:=neu; exit; end; result:=neu; end; procedure tPegelListe.add(s: string); var np: tPegelStand; i: longint; begin np:=tPegelStand.create; np.lade(s); i:=bisekt(np.zeit); if (i>=count) or (items[i].zeit<>np.zeit) then inhalt.Insert(i,np) else np.free; end; function tPegelListe.last: tPegelStand; begin result:=items[count-1]; end; function tPegelListe.count: longint; begin result:=inhalt.count; end; function tPegelListe.minMaxY(startZeit,stopZeit: extended): tPoint; var i: longint; begin result.x:=last.hoehe; result.y:=result.x; for i:=max(0,bisekt(startZeit)-1) to count-2 do begin if items[i].zeit>stopZeit then break; result.x:=min(result.x,items[i].hoehe); result.y:=max(result.y,items[i].hoehe); end; end; procedure tPegelListe.dump(p: pointer); var i,siz: longint; begin if count=0 then exit; siz:=items[0].size; for i:=0 to count-1 do begin items[i].dump(p); p:=p+siz; end; end; procedure tPegelListe.pmud(p: pointer; version,len: longint); var i,siz: longint; np: tPegelStand; begin case version of 0: begin inhalt.clear; np:=tPegelStand.create; siz:=np.size; if len mod siz <> 0 then begin writeln('Datenlänge ('+inttostr(len)+' Byte) ist kein Vielfaches der Länge eines Datums ('+inttostr(siz)+' Byte)!'); raise exception.create('Datenlänge ('+inttostr(len)+' Byte) ist kein Vielfaches der Länge eines Datums ('+inttostr(siz)+' Byte)!'); end; np.pmud(p); p:=p+siz; inhalt.add(np); for i:=1 to (len div siz)-1 do begin np:=tPegelStand.create; np.pmud(p); p:=p+siz; inhalt.add(np); end; end; else begin writeln('Zu neue Dateiversion: Ich verstehe nur bis Version 0, es liegt aber Version '+inttostr(version)+' vor!'); raise exception.create('Zu neue Dateiversion: Ich verstehe nur bis Version 0, es liegt aber Version '+inttostr(version)+' vor!'); end; end{of case}; end; function tPegelListe.size: longint; begin result:=count; if result>0 then result:=result*items[0].size; end; // tPegelUpdateThread ********************************************************** constructor tPegelUpdateThread.create(besitzer: tPegelStaende); begin inherited create(true); _besitzer:=besitzer; beenden:=false; fillchar(antwort,sizeof(antwort),#0); setlength(antwort,0); ladeProzess:=nil; beendet:=false; nPegel:=low(tPegelStation); suspended:=false; end; destructor tPegelUpdateThread.destroy; begin beenden:=true; while not beendet do sleep(100); setlength(antwort,0); inherited destroy; end; procedure tPegelUpdateThread.uebernehmen; begin if beenden then exit; _besitzer.einlesen(antwort); setlength(antwort,0); form1.zeichnen; synchronized:=true; end; procedure tPegelUpdateThread.mySynchronize(aMethod: TThreadMethod); begin synchronized:=false; queue(aMethod); while not beenden and not synchronized do sleep(100); end; procedure tPegelUpdateThread.execute; var bytesToRead,bytesRead,cnt: longint; begin while not beenden do begin ladeProzess:=tProcess.create(nil); ladeProzess.options:=[poUsePipes]; ladeProzess.executable:='/usr/bin/curl'; ladeProzess.parameters.add('--max-time'); ladeProzess.parameters.add('60'); ladeProzess.parameters.add('-o'); ladeProzess.parameters.add('-'); ladeProzess.parameters.add('http://www.tlug-jena.de/hw.inc/txt/' + // 57028.0_w_28.txt inttostr(floor(pegelStationsNummern[nPegel]))+'.'+ inttostr(round(10*(pegelStationsNummern[nPegel]-floor(pegelStationsNummern[nPegel]))))+ '_w_28.txt'); bytesRead:=0; ladeProzess.execute; ladeProzess.closeInput; ladeProzess.closeStderr; while (ladeProzess.running) or (ladeProzess.output.numBytesAvailable>0) do begin if beenden then begin ladeProzess.terminate(0); break; end; bytesToRead:=ladeProzess.output.numBytesAvailable; if bytesToRead>0 then begin setlength(antwort,bytesRead + bufLengMin); bytesRead:=bytesRead+ladeProzess.output.read(antwort[bytesRead+1],min(bytesToRead,length(antwort)-bytesRead)); end else sleep(100); end; ladeProzess.closeOutput; ladeProzess.free; if not beenden then begin setlength(antwort,bytesRead); mySynchronize(@uebernehmen); if nPegel0 do delete(was,pos(#13,was),1); psda:=false; wsda:=false; pS:=low(tPegelStation); while was<>'' do begin t:=myUtf8Encode(erstesArgument(was,#10)); if length(t)=0 then continue; if startetMit('Pegelname:',t) then begin pS:=low(tPegelStation); gefunden:=false; while pS<=high(tPegelStation) do begin for i:=0 to length(pegelStationsNamen[psBlankenstein])-1 do gefunden:=gefunden or ((pegelStationsNamen[pS,i]<>'') and (pegelStationsNamen[pS,i]=t)); if gefunden then break; inc(pS); end; if not gefunden then begin writeln('Unbekannter Pegelname: '''+t+'''!'); for i:=1 to length(t) do write(ord(t[i]),' '); writeln; for i:=1 to length(pegelStationsNamen[psSaalfeld,0]) do write(ord(pegelStationsNamen[psSaalfeld,0][i]),' '); writeln; raise exception.create('Unbekannter Pegelname: '''+t+'''!'); end; psda:=true; continue; end; if t='Durchfluss [m3/s]' then begin wsda:=false; continue; end; if t='Wasserstand [cm]' then begin wsda:=true; continue; end; if not (wsda and psda) then continue; if pos('Fluss: ',t)=1 then continue; if pos('Flusseinzugsgebiet: ',t)=1 then continue; if startetMit('Stationsnummer: ',t) then begin {$WARNINGS-} if decimalSeparator<>'.' then while pos('.',t)>0 do t[pos('.',t)]:=decimalSeparator; {$WARNINGS+} if round(10*strtofloat(t))<>round(10*pegelStationsNummern[pS]) then begin writeln( 'erwartete Pegelstationsnummer ('+floattostr(pegelStationsNummern[pS])+ ') für '+pegelStationsNamen[pS,0]+' ist verschieden von der angegebenen Nummer ('+t+')!'); raise exception.create( 'erwartete Pegelstationsnummer ('+floattostr(pegelStationsNummern[pS])+ ') für '+pegelStationsNamen[pS,0]+' ist verschieden von der angegebenen Nummer ('+t+')!'); end; continue; end; if pos('Hinweise: ',t)=1 then continue; if pos('keine Werte',t)>0 then continue; werte[pS].add(t); end; end; procedure tPegelStaende.laden(von: string); var sl: tMyStringList; s: string; ps: tPegelstation; psda,gefunden: boolean; i,len: longint; pt: pointer; begin if not fileexists(von) then begin writeln('Pegeldatei '''+von+''' existiert nicht!'); raise exception.create('Pegeldatei '''+von+''' existiert nicht!'); exit; end; loadFromGeneric(von,pt,len); if pLongint(pt)^ <> 314159265 then begin // magische Zahl nicht gefunden -> Rückfallebene: Text! sl:=tMyStringList.create; setlength(s,len); move(pt^,s[1],length(s)); sl.text:=s; psda:=false; ps:=low(TPegelstation); while sl.readln(s) do begin if pos('Station: ',s)=1 then begin delete(s,1,pos(' ',s)); ps:=low(TPegelstation); gefunden:=false; while ps<=high(TPegelstation) do begin for i:=0 to length(Pegelstationsnamen[psBlankenstein])-1 do gefunden:=gefunden or ((Pegelstationsnamen[ps,i]<>'') and (Pegelstationsnamen[ps,i]=s)); if gefunden then break; inc(ps); end; if not gefunden then begin sl.free; writeln('Pegelstation '''+s+''' nicht gefunden '''+Pegelstationsnamen[psSaalfeld,0]+'''!'); raise exception.create('Pegelstation '''+s+''' nicht gefunden '''+Pegelstationsnamen[psSaalfeld,0]+'''!'); end; psda:=true; continue; end; if not psda then begin sl.free; writeln('Es wurde noch keine Pegelstation erwähnt!'); raise exception.create('Es wurde noch keine Pegelstation erwähnt!'); end; werte[ps].add(s); end; sl.free; end else begin case (pLongint(pt)+1)^ of 0: begin i:=2*sizeof(longint); for ps:=low(tPegelStation) to high(tPegelStation) do begin werte[ps].pmud(pt+i+sizeof(longint),(pLongint(pt)+1)^,pLongint(pt+i)^); i:=i+werte[ps].size+sizeof(longint); end; end; else begin writeln('Zu neue Dateiversion: Ich verstehe nur bis Version 0, es liegt aber Version '+inttostr((pLongint(pt)+1)^)+' vor!'); raise exception.create('Zu neue Dateiversion: Ich verstehe nur bis Version 0, es liegt aber Version '+inttostr((pLongint(pt)+1)^)+' vor!'); end; end{of case}; end; freemem(pt); if not assigned(put) then put:=tPegelUpdateThread.create(self); end; procedure tPegelStaende.speichern(nach: string); var sl: tMyStringList; ps: tPegelStation; pt: pointer; i,len: longint; begin if rightStr(nach,4)='.txt' then begin // Rückfallebene: Text sl:=tMyStringList.create; for ps:=low(tPegelStation) to high(tPegelStation) do begin sl.add('Station: '+Pegelstationsnamen[ps,0]); for i:=0 to werte[ps].Count-1 do sl.add(werte[ps][i].schreibe); end; sl.saveToFile(nach); sl.free; end else begin len:=2*sizeof(longint); for ps:=low(tPegelStation) to high(tPegelStation) do len:=len+werte[ps].size+sizeof(longint); getmem(pt,len); pLongint(pt)^:=314159265; // magische Zahl (pLongint(pt)+1)^:=0; // Version i:=2*sizeof(longint); for ps:=low(tPegelStation) to high(tPegelStation) do begin pLongint(pt+i)^:=werte[ps].size; i:=i+sizeof(longint); werte[ps].dump(pt+i); i:=i+werte[ps].size; end; saveToGeneric(nach,pt,len); freemem(pt); end; end; procedure tPegelStaende.achsenZeichnen(zuZeichnen: tPegelStationsSet; startZeit,stopZeit: extended); var pS: tPegelStation; i: longint; miMa: tPoint; begin for pS:=low(pS) to high(pS) do if pS in zuZeichnen then begin miMa:=werte[pS].minMaxY(startZeit,stopZeit); for i:=0 to length(pegelGrenzen[pS])-1 do if (pegelGrenzen[pS,i]>=miMa.x) and (pegelGrenzen[pS,i]<=miMa.y) then begin bild.canvas.pen.color:=pegelFarben[pS]; bild.canvas.moveTo(-10,wertZuY(pegelGrenzen[pS,i],miMa,bild.height)); bild.canvas.lineTo(bild.width+10,wertZuY(pegelGrenzen[pS,i],miMa,bild.height)); end; end; end; procedure tPegelStaende.graphenZeichnen(zuZeichnen: tPegelStationsSet; startZeit,stopZeit: extended); var pS: tPegelStation; miMa: tPoint; i: longint; begin for pS:=low(pS) to high(pS) do if pS in zuZeichnen then begin miMa:=werte[pS].minMaxY(startZeit,stopZeit); bild.canvas.pen.color:=pegelFarben[pS]; i:=max(0,werte[pS].bisekt(startZeit)-1); bild.canvas.moveTo(-10,wertZuY(werte[pS][i].hoehe,miMa,bild.height)); while (i