path: root/pegelunit.pas

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;
    procedure setzeZeit;
  public
    constructor create;
    destructor destroy; override;
    function schreibe: string;
    procedure lade(s: string);
    property zeit: extended read _uzeit;
    property hoehe: longint read _hoehe;
    procedure dump(p: pointer);
    procedure pmud(p: pointer);
    function size: longint;
  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;
    procedure dump(p: pointer);
    procedure pmud(p: pointer; version,len: longint);
    function size: longint;
  end;

  tPegelUpdateThread = class(tThread)
  private
    _besitzer:      tPegelStaende;
    antwort:        string;
    ladeProzess:    tProcess;
    beendet,
      synchronized: boolean;
    nPegel:         tPegelStation;
    procedure uebernehmen;
    procedure mySynchronize(aMethod: TThreadMethod);
  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 math, unit1, myStringListUnit, fileUnit;

const
  pegelStationsNamen: array[tPegelstation] of array[0..2] of string =
    (('Blankenstein','Blankenstein-Ros.','Blankenstein-Rosenthal'),
    ('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..4] of longint =
    ((0,210,230,270,310),(0,195,210,225,240),(0,200,230,260,290),(0,150,180,210,240),
    (160,250,290,330,370),(0,280,330,380,430),(0,180,200,220,240),(0,0,0,0,0),
    (0,130,170,210,230),(0,200,230,260,290),(0,130,150,170,190),(0,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;

procedure tPegelStand.dump(p: pointer);
begin
  pExtended(p)^:=_uZeit;
  pLongint(p+sizeof(extended))^:=_hoehe;
end;

procedure tPegelStand.pmud(p: pointer);
begin
  _uZeit:=pExtended(p)^;
  _hoehe:=pLongint(p+sizeof(extended))^;
  setzeZeit;
end;

function tPegelStand.size: longint;
begin
  result:=sizeof(extended)+sizeof(longint);
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<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;

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;

procedure tPegelListe.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 tPegelListe.pmud(p: pointer; version,len: longint);
var
  i,siz: longint;
  np:    tPegelStand;
begin
  case version of
    0: begin
      inhalt.clear;

      np:=tPegelStand.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:=tPegelStand.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 tPegelListe.size: longint;
begin
  result:=count;
  if result>0 then
    result:=result*items[0].size;
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
  beenden:=true;
  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;
  synchronized:=true;
end;

procedure tPegelUpdateThread.mySynchronize(aMethod: TThreadMethod);
begin
  synchronized:=false;
  queue(aMethod);
  while not beenden and not synchronized do
    sleep(100);
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('--max-time');
    ladeProzess.parameters.add('60');
    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 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(100);
    end;
    ladeProzess.closeOutput;
    ladeProzess.free;

    if not beenden then begin
      setlength(antwort,bytesRead);

      mySynchronize(@uebernehmen);

      if nPegel<high(tPegelStation) then
        inc(nPegel)
      else begin
        nPegel:=low(tPegelStation);
        for cnt:=0 to 599 do begin
          if beenden then
            break;
          sleep(100);
        end;
      end;

      if not beenden then
        sleep(100);
    end;
  end;
  ladeProzess:=nil;
  beendet:=true;
end;

// tPegelStaende ***************************************************************

constructor tPegelStaende.create(zeichenFlaeche: tImage);
var
  ps: tPegelStation;
begin
  inherited create;
  bild:=zeichenFlaeche;
  for ps:=low(tPegelStation) to high(tPegelStation) do
    werte[ps]:=tPegelListe.create;
  put:=nil;
end;

destructor tPegelStaende.destroy;
var
  ps: tPegelStation;
begin
  for ps:=low(tPegelStation) to high(tPegelStation) do
    werte[ps].free;
  put.free;
  inherited destroy;
end;

procedure tPegelStaende.einlesen(was: string);
var
  t:                  string;
  PS:                 TPegelstation;
  psda,wsda,gefunden: boolean;
  i:                  longint;
begin
  while pos(#13,was)>0 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
  sl:            tMyStringList;
  s:             string;
  ps:            tPegelstation;
  psda,gefunden: boolean;
  i,len:         longint;
  pt:            pointer;
begin
  if not fileexists(von) then begin
    writeln('Pegeldatei '''+von+''' existiert nicht!');
    raise exception.create('Pegeldatei '''+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;

    psda:=false;
    ps:=low(TPegelstation);
    while sl.readln(s) do begin
      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
          sl.free;
          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
        sl.free;
        writeln('Es wurde noch keine Pegelstation erwähnt!');
        raise exception.create('Es wurde noch keine Pegelstation erwähnt!');
      end;
      werte[ps].add(s);
    end;
    sl.free;
  end
  else begin
    case (pLongint(pt)+1)^ of
      0: begin
        i:=2*sizeof(longint);
        for ps:=low(tPegelStation) to high(tPegelStation) do begin
          werte[ps].pmud(pt+i+sizeof(longint),(pLongint(pt)+1)^,pLongint(pt+i)^);
          i:=i+werte[ps].size+sizeof(longint);
        end;
      end;
      else begin
        writeln('Zu neue Dateiversion: Ich verstehe nur bis Version 0, es liegt aber Version '+inttostr((pLongint(pt)+1)^)+' vor!');
        raise exception.create('Zu neue Dateiversion: Ich verstehe nur bis Version 0, es liegt aber Version '+inttostr((pLongint(pt)+1)^)+' vor!');
      end;
    end{of case};
  end;
  freemem(pt);

  if not assigned(put) then
    put:=tPegelUpdateThread.create(self);
end;

procedure tPegelStaende.speichern(nach: string);
var
  sl:    tMyStringList;
  ps:    tPegelStation;
  pt:    pointer;
  i,len: longint;
begin
  if rightStr(nach,4)='.txt' then begin // Rückfallebene: Text
    sl:=tMyStringList.create;
    for ps:=low(tPegelStation) to high(tPegelStation) do begin
      sl.add('Station: '+Pegelstationsnamen[ps,0]);
      for i:=0 to werte[ps].Count-1 do
        sl.add(werte[ps][i].schreibe);
    end;
    sl.saveToFile(nach);
    sl.free;
  end
  else begin
    len:=2*sizeof(longint);
    for ps:=low(tPegelStation) to high(tPegelStation) do
      len:=len+werte[ps].size+sizeof(longint);
    getmem(pt,len);
    pLongint(pt)^:=314159265; // magische Zahl
    (pLongint(pt)+1)^:=0;     // Version
    i:=2*sizeof(longint);
    for ps:=low(tPegelStation) to high(tPegelStation) do begin
      pLongint(pt+i)^:=werte[ps].size;
      i:=i+sizeof(longint);
      werte[ps].dump(pt+i);
      i:=i+werte[ps].size;
    end;
    saveToGeneric(nach,pt,len);
    freemem(pt);
  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 length(pegelGrenzen[pS])-1 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<werte[pS].count) and (werte[pS][i].zeit<=stopZeit) do begin
        bild.canvas.lineTo(
          wertZuX(werte[pS][i].zeit,startZeit,stopZeit,bild.width),
          wertZuY(werte[pS][i].hoehe,miMa,bild.height));
        inc(i);
      end;
    end;
end;

procedure tPegelStaende.putBeenden;
begin
  put.beenden:=true;
end;

function tPegelStaende.hintInfo: string;
begin
  result:=inttostr(werte[psRothenstein].last.hoehe)+'cm';
end;

end.