summaryrefslogtreecommitdiff
path: root/fhunit.pas
diff options
context:
space:
mode:
Diffstat (limited to 'fhunit.pas')
-rw-r--r--fhunit.pas583
1 files changed, 574 insertions, 9 deletions
diff --git a/fhunit.pas b/fhunit.pas
index 02c9d6d..fcfa1b6 100644
--- a/fhunit.pas
+++ b/fhunit.pas
@@ -5,19 +5,91 @@ unit fhunit;
interface
uses
- Classes, SysUtils, Graphics;
+ CThreads, Classes, SysUtils, Graphics, ExtCtrls, Process, lowLevelUnit;
type
- tMessgroesze = (mgTemperatur,mgLuftfeuchte,mgWindgeschwindigkeit,mgWindrichtung,
+ tMessGroesze = (mgTemperatur,mgLuftfeuchte,mgWindgeschwindigkeit,mgWindrichtung,
mgNiederschlag,mgGlobalstrahlung,mgLuftdruck);
- tZeitgroesze = (zgJahr,zgMonat,zgTag,zgStunde,zgMin10);
- tMesswerte = array[tMessgroesze] of extended;
- tZeit = array[tZeitgroesze] of integer;
- tMesspunkt = record
- zeit: tZeit;
- mW: tMesswerte;
+ 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; inline;
+ procedure setzeZeit; inline;
+ function rMW(mG: tMessGroesze): extended; inline;
+ public
+ constructor create;
+ destructor destroy; override;
+ function lade(s: string): boolean;
+ function schreibe: string;
+ property zeit: extended
+ read _uZeit;
+ property mW[mG: tMessGroesze]: extended
+ read rMW;
+ 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 last: tMessPunkt;
+ function count: longint;
+ property items[i: longint]: tMessPunkt
+ read rItem; default;
+ function minMaxY(startZeit,stopZeit: extended): tMessWerteExtPoints;
+ end;
+
+ tMessPunkteUpdateThread = class(tThread)
+ private
+ _besitzer: tMessPunkte;
+ antwort: string;
+ ladeProzess: tProcess;
+ beendet,
+ warGueltig: boolean;
+ nZeit: extended;
+ _tNum,_tAnz: longint;
+ procedure uebernehmen;
+ procedure nZeitNullen; inline;
+ 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;
end;
+procedure uZeit2mZeit(uZ: extended; out mZ: tZeit); inline;
+function strZuMZeit(s: string; out mZ: tZeit): boolean;
+
const
messNamen: array[tMessgroesze] of string =
('Temperatur','Luftfeuchte','Windgeschwindigkeit','Windrichtung',
@@ -25,12 +97,505 @@ const
maszEinheit: array[tMessgroesze] of string =
('°C','%','m/s','°','mm','W/m²','mbar');
monatsNamen: array[1..12] of string =
- ('Januar','Februar','März','April','Mai','Juni','Juli',
+ ('Januar','Februar','M'#$e4'rz','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, systemUnit;
+
+// 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
+ _uZeit:=
+ encodeDate(_mZeit[zgJahr],_mZeit[zgMonat],_mZeit[zgTag])+
+ encodeTime(_mZeit[zgStunde],_mZeit[zgMin10]*10,0,0)
+end;
+
+procedure tMessPunkt.setzeZeit;
+begin
+ uZeit2mZeit(_uZeit,_mZeit);
+end;
+
+function tMessPunkt.rMW(mG: tMessGroesze): extended;
+begin
+ result:=_mW[mG];
+end;
+
+function tMessPunkt.lade(s: string): boolean;
+var
+ zG: tZeitGroesze;
+ mG: tMessGroesze;
+ t: string;
+ istZahl: boolean;
+ i: longint;
+begin
+ result:=false;
+ if pos('<html>',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('<BODY',uppercase(s))-1);
+ s:=copy(s,1,pos('</BODY>',uppercase(s)));
+ delete(s,1,pos('<CENTER>',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;
+ _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;
+
+// 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
+ 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<ma do begin
+ neu:=(mi+ma) div 2;
+ if (neu>=count) or (items[neu].zeit<zeit) then begin
+ inc(neu);
+ mi:=neu;
+ continue;
+ end;
+ if items[neu].zeit>zeit 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
+ nm.free;
+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) and (items[i].zeit<=stopZeit) do begin
+ for mG:=low(mG) to high(mG) do begin
+ result[mG,'x']:=min(result[mG,'x'],items[i].mW[mG]);
+ result[mG,'y']:=max(result[mG,'y'],items[i].mW[mG]);
+ end;
+ inc(i);
+ end;
+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;
+ suspended:=false;
+end;
+
+destructor tMessPunkteUpdateThread.destroy;
+begin
+ 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;
+end;
+
+procedure tMessPunkteUpdateThread.nZeitNullen;
+var
+ lIch: longint;
+begin
+ if beenden then exit;
+ lIch:=_besitzer.werte.count-1;
+ while round(_besitzer.werte[lIch].zeit*24*6) mod _tAnz <> _tNum do
+ dec(lIch);
+ nZeit:=_besitzer.werte[lIch].zeit + _tAnz*1/24/6;
+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('--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.fh-jena.de/station/datenbank/php_alt/abfrage1.php');
+ 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(10);
+ end;
+ ladeProzess.closeOutput;
+ ladeProzess.free;
+
+ if not beenden then begin
+ setlength(antwort,bytesRead);
+
+ synchronize(@uebernehmen);
+
+ if (nZeit<=now) or warGueltig then
+ nZeit:=nZeit + _tAnz*1/24/6
+ else begin
+ synchronize(@nZeitNullen);
+ for cnt:=0 to 599 do begin
+ if beenden then
+ break;
+ sleep(100);
+ end;
+ end;
+ end;
+ end;
+ ladeProzess:=nil;
+ beendet:=true;
+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
+ f: textfile;
+ 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;
+ assignfile(f,von);
+ reset(f);
+ while not eof(f) do begin
+ readln(f,s);
+ werte.add(s);
+ end;
+ closefile(f);
+ 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
+ dateischonda: boolean;
+ f: textfile;
+ i: longint;
+begin
+ dateischonda:=fileexists(nach);
+ if dateischonda then
+ assignfile(f,mkTemp(nach+'.XXXXXX'))
+ else
+ assignfile(f,nach);
+ rewrite(f);
+ for i:=0 to werte.count-1 do
+ writeln(f,werte[i].schreibe);
+ closefile(f);
+ if dateischonda then begin
+ deletefile(nach);
+ rename(f,nach);
+ 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 (i<werte.count) and (werte[i].zeit<=stopZeit) do begin
+ bild.canvas.lineTo(
+ wertZuX(werte[i].zeit,startZeit,stopZeit,bild.width),
+ wertZuY(werte[i].mW[mG],miMa[mG],bild.height)
+ );
+ inc(i);
+ end;
+ end;
+end;
+
+procedure tMessPunkte.mutBeenden;
+var
+ i: longint;
+begin
+ for i:=0 to length(muts)-1 do
+ muts[i].beenden:=true;
+end;
+
+// allgemeine Funktionen *******************************************************
+
+procedure uZeit2mZeit(uZ: extended; out mZ: tZeit); inline;
+var
+ mi,se,hu: word;
+begin
+ decodeDate(uZ,mZ[zgJahr],mZ[zgMonat],mZ[zgTag]);
+ decodeTime(uZ,mZ[zgStunde],mi,se,hu);
+ mZ[zgMin10]:=round(mi/10);
+end;
+
+function strZuMZeit(s: string; out mZ: tZeit): boolean;
+var
+ t: string;
+ i: longint;
+begin
+ result:=false;
+ s:=trim(s);
+ if pos('.',s)=0 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[zgTag]:=strtoint(t);
+ t:=erstesArgument(s);
+ mZ[zgMonat]:=1;
+ while (mZ[zgMonat]<=12) and (monatsNamen[mZ[zgMonat]]<>t) 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;
+ result:=(strtoint(t) mod 10) = 0;
+end;
+
end.