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; inline; procedure setzeZeit; inline; public constructor create; destructor destroy; override; function schreibe: string; procedure lade(s: string); property zeit: extended read _uzeit; property hoehe: longint read _hoehe; 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; end; tPegelUpdateThread = class(tThread) private _besitzer: tPegelStaende; antwort: string; ladeProzess: tProcess; beendet: boolean; nPegel: tPegelStation; procedure uebernehmen; 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 systemunit, math, unit1; const pegelStationsNamen: array[tPegelstation] of array[0..1] of string = (('Blankenstein','Blankenstein-Ros.'), ('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..3] of longint = ((210,230,270,310),(195,210,225,240),(200,230,260,290),(150,180,210,240), (250,290,330,370),(280,330,380,430),(180,200,220,240),(0,0,0,0), (130,170,210,230),(200,230,260,290),(130,150,170,190),(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; // 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; // 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 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; 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('-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 ladeProzess.terminate(0); 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); synchronize(@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 f: textfile; s: string; ps: tPegelstation; psda,gefunden: boolean; i: longint; begin if not fileexists(von) then begin writeln('Pegeldatei '''+von+''' existiert nicht!'); raise exception.create('Pegeldatei '''+von+''' existiert nicht!'); exit; end; assignfile(f,von); reset(f); psda:=false; ps:=low(TPegelstation); while not eof(f) do begin readln(f,s); 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 closefile(f); 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 writeln('Es wurde noch keine Pegelstation erwähnt!'); raise exception.create('Es wurde noch keine Pegelstation erwähnt!'); end; werte[ps].add(s); end; closefile(f); if not assigned(put) then put:=tPegelUpdateThread.create(self); end; procedure tPegelStaende.speichern(nach: string); var dateischonda: boolean; f: textfile; ps: tPegelStation; i: longint; begin dateischonda:=fileexists(nach); if dateischonda then assignfile(f,mkTemp(nach+'.XXXXXX')) else assignfile(f,nach); rewrite(f); for ps:=low(tPegelStation) to high(tPegelStation) do begin writeln(f,'Station: '+Pegelstationsnamen[ps,0]); for i:=0 to werte[ps].Count-1 do writeln(f,werte[ps][i].schreibe); end; closefile(f); if dateischonda then begin deletefile(nach); rename(f,nach); 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 3 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