path: root/fhunit.pas

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;
    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;
    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, 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
  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('<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;

function tMessPunkte.sonnigkeit: extended;
var
  i:      longint;
  a,e,fA: extended;
  fAZ:    tZeit;
begin
  result:=0;
  i:=werte.bisekt(werte.last.zeit-1);
  while i<werte.count do begin
    result:=result+werte[i].mW[mgGlobalStrahlung]*(werte[i].zeit-werte[i-1].zeit);
    inc(i);
  end;
  uZeit2mZeit(werte.last.zeit,fAZ);
  fAZ[zgTag]:=21;  // Frühlingsanfang
  fAZ[zgMonat]:=3;
  mZeit2uZeit(fAZ,fA);
  a:=50/180*pi; // Breitengrad
  e:=23.15/180*pi*sin((werte.last.zeit-fA)*2*pi/365); // eff. Neigung
  result:=result/(1367/pi*(sin(a)*sin(e)*arccos(-tan(a)*tan(e))+cos(a)*cos(e)*sqrt(1-sqr(tan(a)*tan(e)))));
end;

function tMessPunkte.maxWind: extended;
var
  i: longint;
begin
  result:=0;
  i:=werte.bisekt(werte.last.zeit-1/24*2);
  while i<werte.count do begin
    result:=max(result,werte[i].mW[mgWindGeschwindigkeit]);
    inc(i);
  end;
end;

function tMessPunkte.gesRegen: extended;
var
  i: longint;
begin
  result:=0;
  i:=werte.bisekt(werte.last.zeit-1/24*14);
  while i<werte.count do begin
    result:=result+werte[i].mW[mgNiederschlag]*(werte[i].zeit-werte[i-1].zeit);
    inc(i);
  end;
end;

function tMessPunkte.hintInfo: string;
var
  sk: extended;
begin
  result:=dateTimeToStr(werte.last.zeit)+' ';
  sk:=sonnigkeit*100;
  result:=result+inttostr(floor(sk))+',';
  sk:=(sk-floor(sk))*10;
  result:=result+char(ord('0')+floor(sk));
  sk:=(sk-floor(sk))*10;
  result:=result+char(ord('0')+floor(sk))+'%';
end;

function tMessPunkte.mehrInfos(was: tMessGroeszenSet): string;
var
  mG: tMessGroesze;
begin
  result:='';
  for mG:=high(mG) downto low(mG) do
    if mG in was then
      result:=result+#13+floattostr(werte.last.mW[mG])+maszEinheit[mG];
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;

procedure mZeit2uZeit(mZ: tZeit; out uZ: extended); inline;
begin
  uZ:=
    encodeDate(mZ[zgJahr],mZ[zgMonat],mZ[zgTag])+
    encodeTime(mZ[zgStunde],mZ[zgMin10]*10,0,0)
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.