unit fhunit; {$mode objfpc}{$H+} interface uses CThreads, Classes, SysUtils, Graphics, ExtCtrls, Process, lowLevelUnit; type tMessGroesze = (mgTemperatur,mgLuftfeuchte,mgWindgeschwindigkeit,mgWindrichtung, mgNiederschlag,mgGlobalstrahlung,mgLuftdruck); tMessGroeszenSet = set of tMessGroesze; tZeitGroesze = (zgJahr,zgMonat,zgTag,zgStunde,zgMin10); tMessWerte = array[tMessGroesze] of extended; tMessWerteExtPoints = array[tMessGroesze] of tExtPoint; tZeit = array[tZeitGroesze] of word; tMessPunkte = class; tMessPunkt = class private _mZeit: tZeit; _uZeit: extended; _mW: tMessWerte; procedure setzeUZeit; procedure setzeZeit; function rMW(mG: tMessGroesze): extended; public constructor create; destructor destroy; override; function merge(mP: tMessPunkt): integer; function lade(s: string): boolean; function schreibe: string; property zeit: extended read _uZeit; property mW[mG: tMessGroesze]: extended read rMW; procedure dump(p: pExtended); procedure pmud(p: pExtended); function size: longint; end; tMessPunkteListe = class private inhalt: tFPList; function rItem(i: longint): tMessPunkt; function bisekt(zeit: extended): longint; public constructor create; destructor destroy; override; function add(s: string): boolean; function append(s: string): boolean; function last: tMessPunkt; function count: longint; property items[i: longint]: tMessPunkt read rItem; default; function hat(zeit: extended): boolean; function hatNichtNull(zeit: extended): boolean; function minMaxY(startZeit,stopZeit: extended): tMessWerteExtPoints; procedure dump(p: pointer); procedure pmud(p: pointer; version,len: longint); function size: longint; function statistics: string; end; tMessPunkteUpdateThread = class(tThread) private _besitzer: tMessPunkte; antwort: string; ladeProzess: tProcess; beendet, warGueltig, synchronized: boolean; nZeit: extended; _tNum,_tAnz: longint; procedure uebernehmen; procedure nZeitNullen; procedure nZeitDuplikateAuslassen; procedure mySynchronize(aMethod: TThreadMethod); public beenden: boolean; constructor create(besitzer: tMessPunkte; tNum,tAnz: longint); destructor destroy; override; procedure execute; override; end; tMessPunkte = class private bild: tImage; werte: tMessPunkteListe; muts: array of tMessPunkteUpdateThread; public constructor create(zeichenFlaeche: tImage); destructor destroy; override; function einlesen(was: string): boolean; procedure laden(von: string); procedure speichern(nach: string); procedure achsenZeichnen(zuZeichnen: tMessGroeszenSet; startZeit,stopZeit: extended); procedure graphenZeichnen(zuZeichnen: tMessGroeszenSet; startZeit,stopZeit: extended); procedure mutBeenden; function sonnigkeit: extended; function maxWind: extended; function gesRegen: extended; function hintInfo: string; function mehrInfos(was: tMessGroeszenSet): string; function statistics: string; end; procedure uZeit2mZeit(uZ: extended; out mZ: tZeit); procedure mZeit2uZeit(mZ: tZeit; out uZ: extended); function strZuMZeit(s: string; out mZ: tZeit): boolean; const messNamen: array[tMessGroesze] of string = ('Temperatur','Luftfeuchte','Windgeschwindigkeit','Windrichtung', 'Niederschlag','Globalstrahlung','Luftdruck'); maszEinheit: array[tMessGroesze] of string = ('°C','%','m/s','°','mm','W/m²','mbar'); monatsNamen: array[1..12] of string = ('Januar','Februar','M'#$e4'rz','April','Mai','Juni','Juli', 'August','September','Oktober','November','Dezember'); monatsNamen_: array[1..12] of string = ('Januar','Februar','M%E4rz','April','Mai','Juni','Juli', 'August','September','Oktober','November','Dezember'); farben: array[tMessGroesze] of tColor = ($0000DF,$CFAF7F,$007FFF,$FF00FF,$FFAF3F,$3FAFAF,$AFAFAF); implementation uses unit1, math, myStringListUnit, fileUnit; // tMessPunkt ****************************************************************** constructor tMessPunkt.create; var zg: tZeitGroesze; mg: tMessGroesze; begin inherited create; for zg:=low(zg) to high(zg) do _mZeit[zg]:=0; _uZeit:=0; for mg:=low(mg) to high(mg) do _mW[mg]:=0; end; destructor tMessPunkt.destroy; begin inherited destroy; end; procedure tMessPunkt.setzeUZeit; begin mZeit2uZeit(_mZeit,_uZeit); end; procedure tMessPunkt.setzeZeit; begin uZeit2mZeit(_uZeit,_mZeit); end; function tMessPunkt.rMW(mG: tMessGroesze): extended; begin result:=_mW[mG]; end; function tMessPunkt.merge(mP: tMessPunkt): integer; var mG: tMessGroesze; begin result:=0; if not isNan(mP.zeit) then begin if isNan(zeit) then begin result:=1; _uZeit:=mP.Zeit; setzeZeit; end else begin if zeit <> mP.zeit then begin writeln('Inkonsistenz: ' + schreibe + ' -> ' + mP.schreibe); result:=-1; exit; end; end; end; for mG:=low(tMessGroesze) to high(tMessGroesze) do begin if isNan(mP.mW[mG]) then continue; if isNan(mW[mG]) then begin result:=1; _mW[mG]:=mP.mW[mG]; continue; end; if mW[mG] <> mP.mW[mG] then begin writeln('Inkonsistenz: ' + schreibe + ' -> ' + mP.schreibe); result:=-1; exit; end; end; end; function tMessPunkt.lade(s: string): boolean; var zG: tZeitGroesze; mG: tMessGroesze; t: string; istZahl: boolean; i: longint; begin result:=false; if pos('',s)=0 then begin // Format wie in letztes_Wetter.txt {$WARNINGS-} if decimalSeparator<>',' then while pos(',',s)>0 do s[pos(',',s)]:=decimalSeparator; {$WARNINGS+} for zG:=low(zG) to high(zG) do _mZeit[zG]:=strtoint(erstesArgument(s,#9)); for mG:=high(mG) downto low(mG) do _mW[mG]:=strtofloat(erstesArgument(s,#9)); while _mZeit[zgStunde]>=24 do begin _mZeit[zgStunde]:=_mZeit[zgStunde]-24; inc(_mZeit[zgTag]); if _mZeit[zgTag]>30+byte(_mZeit[zgMonat] in [1,3,5,7,8,10,12])-(2-byte(_mZeit[zgJahr] mod 4 = 0))*byte(_mZeit[zgMonat]=2) then begin _mZeit[zgTag]:=1; inc(_mZeit[zgMonat]); if _mZeit[zgMonat]>12 then begin _mZeit[zgMonat]:=1; inc(_mZeit[zgJahr]); end; end; end; setzeUZeit; end else begin // Format wie im Netz delete(s,1,pos('',uppercase(s))); delete(s,1,pos('
',uppercase(s))); delete(s,1,pos('>',s)); s:=trim(s); t:=trim(leftStr(s,pos('<',s)-1)); if not strZuMZeit(t,_mZeit) then exit; {$WARNINGS-} if decimalSeparator<>'.' then while pos('.',s)>0 do s[pos('.',s)]:=decimalSeparator; {$WARNINGS+} for mG:=low(mG) to high(mG) do begin delete(s,1,pos(uppercase(messNamen[mG]),uppercase(s))); delete(s,1,pos('>',s)); t:=trim(leftStr(s,pos('<',S)-1)); istZahl:=t<>''; for i:=1 to length(t) do istZahl:=istZahl and (t[i] in ['0'..'9','.',',','-']); if not istZahl then exit; if (t='--') and (mG=mgGlobalstrahlung) then _mW[mG]:=0 else if t='--' then _mW[mG]:=nan else _mW[mG]:=strtofloat(t); end; setzeUZeit; end; result:=true; end; function tMessPunkt.schreibe: string; var zG: tZeitGroesze; mG: tMessGroesze; begin result:=''; for zG:=low(zG) to high(zG) do result:=result+#9+inttostr(_mZeit[zG]); for mG:=high(mG) downto low(mG) do result:=result+#9+floattostr(mW[mG]); result:=trim(result); end; procedure tMessPunkt.dump(p: pExtended); begin move(_uZeit,p^,sizeof(extended)); move(_mW[low(tMessGroesze)],(p+1)^,length(_mW)*sizeof(_mW[low(tMessGroesze)])); end; procedure tMessPunkt.pmud(p: pExtended); begin move(p^,_uZeit,sizeof(_uZeit)); move((p+1)^,_mW[low(tMessGroesze)],length(_mW)*sizeof(_mW[low(tMessGroesze)])); setzeZeit; end; function tMessPunkt.size: longint; begin result:=(1+length(_mW))*sizeof(extended); end; // tMessPunkteListe ************************************************************ constructor tMessPunkteListe.create; begin inherited create; inhalt:=tFPList.create; end; destructor tMessPunkteListe.destroy; begin inhalt.free; inherited destroy; end; function tMessPunkteListe.rItem(i: longint): tMessPunkt; begin if i>=count then raise exception.create('i zu groß! ('+inttostr(i)+' von '+inttostr(count)+')'); result:=tMessPunkt(inhalt[i]); end; function tMessPunkteListe.bisekt(zeit: extended): longint; var mi,ma,neu: longint; begin mi:=0; neu:=mi; ma:=count; while mi=count) or (round((items[neu].zeit - zeit) * 6 * 24) < 0) then begin inc(neu); mi:=neu; continue; end; if round((items[neu].zeit - zeit) * 6 * 24) > 0 then begin ma:=neu; continue; end; result:=neu; exit; end; result:=neu; end; function tMessPunkteListe.add(s: string): boolean; var nm: tMessPunkt; i: longint; begin result:=false; nm:=tMessPunkt.create; if not nm.lade(s) then begin nm.free; exit; end; i:=bisekt(nm.zeit); result:=true; if (i>=count) or (items[i].zeit<>nm.zeit) then inhalt.Insert(i,nm) else begin items[i].merge(nm); nm.free; end; end; function tMessPunkteListe.append(s: string): boolean; var nm: tMessPunkt; begin result:=false; nm:=tMessPunkt.create; if not nm.lade(s) then begin nm.free; exit; end; result:=true; inhalt.add(nm); end; function tMessPunkteListe.last: tMessPunkt; begin result:=items[count-1]; end; function tMessPunkteListe.count: longint; begin result:=inhalt.count; end; function tMessPunkteListe.minMaxY(startZeit,stopZeit: extended): tMessWerteExtPoints; var i: longint; mG: tMessGroesze; begin i:=bisekt(startZeit); for mG:=low(mG) to high(mG) do begin result[mG,'x']:=items[i].mW[mG]; result[mG,'y']:=result[mG,'x']; end; while (i=count) then exit; result:= round((items[i].zeit - zeit) * 6 * 24) = 0; end; function tMessPunkteListe.hatNichtNull(zeit: extended): boolean; var i: longint; mG: tMessGroesze; begin result:=false; i:=bisekt(zeit); if (i<0) or (i>=count) then exit; for mG:=low(tMessGroesze) to high(tMessGroesze) do if isNan(items[i].mW[mG]) then exit; result:= round((items[i].zeit - zeit) * 6 * 24) = 0; end; function tMessPunkteListe.statistics: string; var i,gaps,gap,nans: longint; mG: tMessGroesze; begin if count=0 then begin result:='leer'; exit; end; result:=''; gaps:=0; gap:=0; nans:=0; for i:=count-1 downto 1 do begin if round((items[i].zeit - items[i-1].zeit) * 6 * 24) <> 1 then begin inc(gaps); gap:=gap + round((items[i].zeit - items[i-1].zeit) * 6 * 24 - 1); result:=result + dateTimeToStr(items[i-1].zeit) + ' -> ' + dateTimeToStr(items[i].zeit) + #10; end; for mG:=low(tMessGroesze) to high(tMessGroesze) do if isNan(items[i].mW[mG]) then inc(nans); end; result:=result + intToStr(count) + ' Werte von ' + dateTimeToStr(items[0].zeit) + ' bis ' + dateTimeToStr(items[count-1].zeit); if gaps>0 then result:=result + #10 + intToStr(gaps) + ' Lücken, ' + intToStr(gap) + ' Messwerte'; if nans>0 then result:=result + #10 + intToStr(nans) + ' NaNs'; end; // tMessPunkteUpdateThread ***************************************************** constructor tMessPunkteUpdateThread.create(besitzer: tMessPunkte; tNum,tAnz: longint); begin inherited create(true); _besitzer:=besitzer; fillchar(antwort,sizeof(antwort),#0); setlength(antwort,0); ladeProzess:=nil; beendet:=false; _tNum:=tNum; _tAnz:=tAnz; beenden:=false; warGueltig:=false; nZeitNullen; nZeitDuplikateAuslassen; suspended:=false; end; destructor tMessPunkteUpdateThread.destroy; begin beenden:=true; while not beendet do sleep(100); setlength(antwort,0); inherited destroy; end; procedure tMessPunkteUpdateThread.uebernehmen; begin if beenden then exit; warGueltig:=_besitzer.einlesen(antwort); setlength(antwort,0); if (not warGueltig) or (20*random<1) then form1.zeichnen; synchronized:=true; end; procedure tMessPunkteUpdateThread.nZeitNullen; begin if beenden then exit; nZeit:= _besitzer.werte[0].zeit + _tNum * 1 / 24 / 6; synchronized:=true; end; procedure tMessPunkteUpdateThread.nZeitDuplikateAuslassen; begin while _besitzer.werte.hatNichtNull(nZeit) do begin if beenden then exit; nZeit:= nZeit + _tAnz * 1 / 24 / 6; end; synchronized:=true; end; procedure tMessPunkteUpdateThread.mySynchronize(aMethod: TThreadMethod); begin synchronized:=false; queue(aMethod); while not beenden and not synchronized do sleep(100); end; procedure tMessPunkteUpdateThread.execute; var bytesToRead,bytesRead,cnt: longint; mZeit: tZeit; 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('--max-time'); ladeProzess.parameters.add('60'); ladeProzess.parameters.add('--data'); uZeit2mZeit(nZeit,mZeit); ladeProzess.parameters.add( 'tag='+inttostr(mZeit[zgTag])+'&'+ 'monat='+Monatsnamen_[mZeit[zgMonat]]+'&'+ 'jahr='+inttostr(mZeit[zgJahr])+'&'+ 'stunde='+inttostr(mZeit[zgStunde])+'&'+ 'minute='+inttostr(10*mZeit[zgMin10])+'&'+ 'submit=Abfrage starten'); ladeProzess.parameters.add('http://wetter.mb.eah-jena.de/station/datenbank/php_alt/abfrage1a.php'); 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(10); end; ladeProzess.closeOutput; ladeProzess.free; if not beenden then begin setlength(antwort,bytesRead); mySynchronize(@uebernehmen); if (nZeit<=now) or warGueltig then nZeit:=nZeit + _tAnz*1/24/6 else begin mySynchronize(@nZeitNullen); for cnt:=0 to 599 do begin if beenden then break; sleep(100); end; end; mySynchronize(@nZeitDuplikateAuslassen); end; end; ladeProzess:=nil; beendet:=true; end; procedure tMessPunkteListe.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 tMessPunkteListe.pmud(p: pointer; version,len: longint); var i,siz: longint; np: tMessPunkt; begin case version of 0: begin inhalt.clear; np:=tMessPunkt.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:=tMessPunkt.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 tMessPunkteListe.size: longint; begin result:=count; if result>0 then result:=result*items[0].size; end; // tMessPunkte ***************************************************************** constructor tMessPunkte.create(zeichenFlaeche: tImage); begin inherited create; bild:=zeichenFlaeche; werte:=tMessPunkteListe.create; fillchar(muts,sizeof(muts),#0); setlength(muts,0); end; destructor tMessPunkte.destroy; var i: longint; begin werte.free; for i:=0 to length(muts)-1 do muts[i].free; setlength(muts,0); inherited destroy; end; function tMessPunkte.einlesen(was: string): boolean; begin result:=werte.add(was); end; procedure tMessPunkte.laden(von: string); var sl: tMyStringList; pt: pointer; len: longint; s: string; i: longint; begin if not fileexists(von) then begin writeln('Messwertedatei '''+von+''' existiert nicht!'); raise exception.create('Messwertedatei '''+von+''' existiert nicht!'); exit; end; s:=''; 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; while sl.readln(s) do werte.append(s); sl.free; end else werte.pmud(pt+2*sizeof(longint),(pLongint(pt)+1)^,len-2*sizeof(longint)); freemem(pt); writeln('Messwerte geladen:' + #10 + werte.statistics); if length(muts)=0 then begin setlength(muts,20); for i:=0 to length(muts)-1 do muts[i]:=tMessPunkteUpdateThread.create(self,i,length(muts)); end; end; procedure tMessPunkte.speichern(nach: string); var sl: tMyStringList; pt: pointer; i: longint; begin if rightstr(nach,4)='.txt' then begin // Rückfallebene: Text sl:=tMyStringList.create; for i:=0 to werte.count-1 do sl.add(werte[i].schreibe); sl.saveToFile(nach); sl.free; end else begin i:=werte.size; getmem(pt,i+2*sizeof(longint)); pLongint(pt)^:=314159265; // magische Zahl (pLongint(pt)+1)^:=0; // Version werte.dump(pt+2*sizeof(longint)); saveToGeneric(nach,pt,i+2*sizeof(longint)); freemem(pt); end; end; procedure tMessPunkte.achsenZeichnen(zuZeichnen: tMessGroeszenSet; startZeit,stopZeit: extended); var mG: tMessGroesze; miMa: tMessWerteExtPoints; dY,cY: extended; begin miMa:=werte.minMaxY(startZeit,stopZeit); for mG:=high(mG) downto low(mG) do if mG in zuZeichnen then begin bild.canvas.pen.color:=farben[mG]; dY:=power(10,ceil(ln(max(1e-9,miMa[mG,'y']-miMa[mG,'x']))/ln(10))); repeat if max(1e-9,miMa[mG,'y']-miMa[mG,'x'])/dY>=3 then continue; dY:=dY/10*3; if max(1e-9,miMa[mG,'y']-miMa[mG,'x'])/dY>=3 then continue; dY:=dY/3; until max(1e-9,miMa[mG,'y']-miMa[mG,'x'])/dY>=3; cY:=ceil(miMa[mG,'x']/dY)*dY; while cY<=miMa[mG,'y'] do begin bild.canvas.moveTo(-10,wertZuY(cY,miMa[mG],bild.height)); bild.canvas.lineTo(bild.width+10,wertZuY(cY,miMa[mG],bild.height)); cY:=cY+dY; end; end; end; procedure tMessPunkte.graphenZeichnen(zuZeichnen: tMessGroeszenSet; startZeit,stopZeit: extended); var mG: tMessGroesze; miMa: tMessWerteExtPoints; i: longint; begin miMa:=werte.minMaxY(startZeit,stopZeit); for mG:=high(mG) downto low(mG) do if mG in zuZeichnen then begin bild.canvas.pen.color:=farben[mG]; i:=werte.bisekt(startZeit); bild.canvas.moveTo( -10, wertZuY(werte[i].mW[mG],miMa[mG],bild.height) ); while (it) do inc(mZ[zgMonat]); if mZ[zgMonat]>12 then exit; t:=erstesArgument(s); if t='' then exit; for i:=1 to length(t) do if not (t[i] in ['0'..'9']) then exit; mZ[zgJahr]:=strtoint(t); t:=erstesArgument(s,':'); if t='' then exit; for i:=1 to length(t) do if not (t[i] in ['0'..'9']) then exit; mZ[zgStunde]:=strtoint(t); t:=erstesArgument(s); if t='' then exit; for i:=1 to length(t) do if not (t[i] in ['0'..'9']) then exit; mZ[zgMin10]:=strtoint(t) div 10; while mZ[zgStunde]>=24 do begin mZ[zgStunde]:=mZ[zgStunde]-24; inc(mZ[zgTag]); if mZ[zgTag]>30+byte(mZ[zgMonat] in [1,3,5,7,8,10,12])-(2-byte(mZ[zgJahr] mod 4 = 0))*byte(mZ[zgMonat]=2) then begin mZ[zgTag]:=1; inc(mZ[zgMonat]); if mZ[zgMonat]>12 then begin mZ[zgMonat]:=1; inc(mZ[zgJahr]); end; end; end; result:=(strtoint(t) mod 10) = 0; end; end.