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; inline;
procedure setzeZeit; inline;
function rMW(mG: tMessGroesze): extended; inline;
public
constructor create;
destructor destroy; override;
function lade(s: string): boolean; inline;
function schreibe: string; inline;
property zeit: extended
read _uZeit;
property mW[mG: tMessGroesze]: extended
read rMW;
procedure dump(p: pExtended); inline;
procedure pmud(p: pExtended); inline;
function size: longint; inline;
end;
tMessPunkteListe = class
private
inhalt: tFPList;
function rItem(i: longint): tMessPunkt; inline;
function bisekt(zeit: extended): longint; inline;
public
constructor create;
destructor destroy; override;
function add(s: string): boolean; inline;
function append(s: string): boolean; inline;
function last: tMessPunkt;
function count: longint;
property items[i: longint]: tMessPunkt
read rItem; default;
function minMaxY(startZeit,stopZeit: extended): tMessWerteExtPoints;
procedure dump(p: pointer); inline;
procedure pmud(p: pointer; version,len: longint); inline;
function size: longint; inline;
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;
function sonnigkeit: extended;
function maxWind: extended;
function gesRegen: extended;
function hintInfo: string;
function mehrInfos(was: tMessGroeszenSet): string;
end;
procedure uZeit2mZeit(uZ: extended; out mZ: tZeit); inline;
procedure mZeit2uZeit(mZ: tZeit; out uZ: extended); inline;
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');
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.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;
_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 (items[neu].zeitzeit 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.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 _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;
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;
fi: file;
ma,mi: extended;
lw: longword;
begin
if not fileexists(von) then begin
writeln('Messwertedatei '''+von+''' existiert nicht!');
raise exception.create('Messwertedatei '''+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;
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);
assignfile(fi,'/tmp/temperatur.roh');
rewrite(fi,1);
ma:=werte[0].mW[mgTemperatur];
mi:=ma;
for i:=1 to werte.count-1 do begin
ma:=max(ma,werte[i].mW[mgTemperatur]);
mi:=min(mi,werte[i].mW[mgTemperatur]);
end;
for i:=0 to werte.count-1 do begin
lw:=round((werte[i].mW[mgTemperatur]-mi)/(ma+mi)*$ffffffff);
blockwrite(fi,lw,sizeof(lw));
end;
closefile(fi);
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;
result:=(strtoint(t) mod 10) = 0;
end;
end.