path: root/irdecoderunit.pas

unit irdecoderunit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, lesethreadunit, lowlevelunit, process, myStringListUnit;

type
  tKollapsArt = (
    kaIgnorieren, // kann nicht kollabieren
    kaToggle,     // 2x Befehl = 0x Befehl
    kaAddieren,   // Parameter sind zu addieren
    kaNurEinMal); // 2x Befehl = 1x Befehl

  tBefehl = class;

  tIRDecoder = class
  private
    ttySLeser:       tLeseProzess;
    letztesZeichen:  array[boolean] of longword;
    ersterEmpf,
      letzterEmpf:   boolean;
    eingabePuffer:   array of longword;
    eingabeLaenge:   int64;
    letzterBefehl,
      zustand:       longword;
    _watte,_debug:   boolean;
    debugDatei:      textfile;
    procedure init;
    procedure tastenDruckAnhaengen(lw: longword);
    procedure befehlAusfuehren(cmd,params: string);
    function findeZeichen(lw: longword): int64;
    function findeBefehl(lw: longword): int64;
    procedure befehlVlltEntprellen(num: longint);
  public
    constructor create(inputName, konfigName: string; watte, debug: boolean);
    destructor destroy; override;
    function zeileVerarbeitet: boolean;
    function befehlVerarbeitet: boolean;
    function gibAlleBefehle: string;
  end;

  tBefehl = class
    nummer,altZustand,              // Index des gesendeten Zeichens in zeichenTabelle, sowie alter
      neuZustand:      longword;    // und neuer Zustand
    einzelKlick,                    // gedrückt gehaltene Taste = Befehl mehrmals?
      kollapsTrenner:  boolean;     // Darf über diesen Befehl hinweg nicht kollabiert werden?
    cmd,params,                     // Befehl + Parameter
      neutralParams:   string;      // + Parameter, bei denen dieser Befehl entfällt
    kollapsArt:        tKollapsArt; // Wie kollabiert dieser Befehl?
    constructor create;
    destructor destroy; override;
  end;

procedure befehleKonfLesen(konfigName: string);
procedure sortiereZeichenTabelle(von,bis: int64);
procedure sortiereBefehlsTabelle(von,bis: int64);
function befehlsVergleich(b1,b2: int64): integer; inline; overload;
function befehlsVergleich(b1,b2Num,b2Zus: int64): integer; inline; overload;
function argumenteKompatibel(par1,par2: string; ka: tKollapsArt): boolean;

implementation

uses math, systemunit, matheunit;

var
  zeichenTabelle: array of longword;
  befehlsTabelle: array of tBefehl;

// tIRDecoder ******************************************************************

constructor tIRDecoder.create(inputName, konfigName: string; watte, debug: boolean);
var
  i:      longint;
  tmpDir: string;
begin
  inherited create;
  if (length(zeichenTabelle)=0) or (length(befehlsTabelle)=0) then begin
    setlength(zeichenTabelle,0);
    for i:=0 to length(befehlsTabelle)-1 do
      befehlsTabelle[i].free;
    setlength(befehlsTabelle,0);
    befehleKonfLesen(konfigName);
  end;

  _watte:=watte;
  _debug:=debug;

  if _debug then begin
    tmpDir:=trim(mkTemp('-d /tmp/fernbedienung.XXXXXX'));
    assignFile(debugDatei,tmpdir+'/debug');
    rewrite(debugDatei);
    closefile(debugDatei);
  end;

  ttySLeser:=tLeseProzess.create(inputName,1);
  fillchar(eingabePuffer,sizeof(eingabePuffer),#0);
  init;
end;

destructor tIRDecoder.destroy;
begin
  ttySLeser.free;
  inherited destroy;
end;

procedure tIRDecoder.init;
begin
  letzterBefehl:=$ffffffff;
  letztesZeichen[false]:=$ffffffff;
  letztesZeichen[true]:=$ffffffff;
  letzterEmpf:=false;
  ersterEmpf:=false;
  zustand:=0;
  setlength(eingabePuffer,0);
  eingabeLaenge:=0;
end;

procedure tIRDecoder.tastenDruckAnhaengen(lw: longword);
var
  empf: boolean;
begin
  if _debug then begin
    append(debugDatei);
    writeln(debugDatei,inttohex(lw,4));
    closeFile(debugDatei);
  end;

  empf:=odd(lw shr 1);
  lw:=((lw shr 1) and not 1) or byte(odd(lw));

  if _debug then begin
    append(debugDatei);
    writeln(debugDatei,'-> '+inttohex(lw,4),' ',byte(empf),' ',byte(letzterEmpf),' ',inttohex(letztesZeichen[empf],4),' ',byte(ersterEmpf));
    closeFile(debugDatei);
  end;

  if (empf=letzterEmpf) or (lw<>letztesZeichen[empf]) then
    ersterEmpf:=empf;

  if empf=ersterEmpf then begin
    if eingabeLaenge>=length(eingabePuffer) then
      setlength(eingabePuffer,eingabeLaenge+1024);
    eingabePuffer[eingabeLaenge]:=(findeZeichen(lw and not $08) shl 1) or byte((lw and $08) <> 0);
    inc(eingabeLaenge);
  end;

  letztesZeichen[empf]:=lw;
  letzterEmpf:=empf;
end;

procedure tIRDecoder.befehlAusfuehren(cmd,params: string);
var
  p: tProcess;
begin
  if _debug then begin
    append(debugDatei);
    writeln(debugDatei,'>> '+cmd+' '+params);
    closeFile(debugDatei);
  end;
  if _watte then
    writeln(cmd+' '+params)
  else begin
    p:=tProcess.create(nil);
    p.executable:=cmd;
    while params<>'' do
      p.parameters.add(erstesArgument(params));
    p.options:=p.options + [poWaitOnExit];
    p.execute;
    p.free;
  end;
end;

function tIRDecoder.findeZeichen(lw: longword): int64;
var
  mi,ma: int64;
begin
  mi:=0;
  ma:=length(zeichenTabelle)-1;
  while mi<ma do begin
    result:=(mi+ma) div 2;
    if zeichenTabelle[result]<lw then begin
      mi:=min(ma,result+1);
      continue;
    end;
    if zeichenTabelle[result]>lw then begin
      ma:=max(mi,result-1);
      continue;
    end;
    mi:=result;
    ma:=result;
    break;
  end;
  if mi<>ma then
    raise exception.create('Sanity-Check nicht bestanden: mi<>ma nach Bisektion!');
  result:=mi;
  if zeichenTabelle[result]<>lw then
    raise exception.create('Kann Tastencode '''+inttohex(lw,4)+''' nicht finden!');
end;

function tIRDecoder.findeBefehl(lw: longword): int64;
var
  mi,ma: int64;
begin
  mi:=0;
  ma:=length(befehlsTabelle)-1;
  while mi<ma do begin
    result:=(mi+ma+1) div 2;
    if befehlsVergleich(result,lw,zustand)>0 then begin
      ma:=max(mi,result-1);
      continue;
    end;
    if befehlsVergleich(result,lw,zustand)<0 then begin
      mi:=min(ma,result);
      continue;
    end;
    mi:=result;
    ma:=result;
    break;
  end;
  if mi<>ma then
    raise exception.create('Sanity-Check nicht bestanden: mi<>ma nach Bisektion!');
  result:=mi;
  if (befehlsTabelle[result].nummer<>lw) or (befehlsTabelle[result].altZustand>zustand) then
    raise exception.create('Kann Befehl Nummer '''+inttohex(lw,4)+''' im Zustand '+inttostr(zustand)+' nicht finden!');
end;

procedure tIRDecoder.befehlVlltEntprellen(num: longint);
var
  i,cnt: longint;
begin
  if not befehlsTabelle[findeBefehl(num) shr 1].einzelKlick then
    exit;
  cnt:=num+1;
  while (eingabeLaenge>cnt) and (eingabePuffer[cnt]=eingabePuffer[num]) do
    inc(cnt);
  dec(cnt);
  if cnt>num then begin
    for i:=cnt+1 to eingabeLaenge-1 do
      eingabePuffer[i-cnt+num]:=eingabePuffer[i];
    eingabeLaenge:=eingabeLaenge-cnt+num;
  end;
end;

function tIRDecoder.zeileVerarbeitet: boolean;
var
  s:      string;
  inByte: longword;
begin
  result:=ttySLeser.gibZeile(s);
  if not result then exit;

  if s='Ha!' then begin // Startzeichen
    writeln('Empfänger hat sich gemeldet!');
    init;
    exit;
  end;

  if (length(s)=3) and base64Decode(s,inByte) then begin
    tastenDruckAnhaengen(inByte);
    exit;
  end;

  writeln('Warnung: Kenne Kommando '''+s+''' nicht - komisch formatiert!');
end;

function tIRDecoder.befehlVerarbeitet: boolean;
var
  i,cnt:          longint;
  bef,bef2,zei:   longword;
  cmd,params,s,t: string;
begin
  repeat
    result:=eingabeLaenge>0;
    if not result then exit;

    zei:=eingabePuffer[0];
    bef:=findeBefehl(zei shr 1);
    befehlVlltEntprellen(0);

    for i:=1 to eingabeLaenge-1 do
      eingabePuffer[i-1]:=eingabePuffer[i];
    dec(eingabeLaenge);
  until (zei<>letzterBefehl) or not befehlsTabelle[bef].einzelKlick;
  letzterBefehl:=zei;

  cmd:=befehlsTabelle[bef].cmd;
  params:=befehlsTabelle[bef].params;
  zustand:=befehlsTabelle[bef].neuZustand;

  if befehlsTabelle[bef].kollapsArt<>kaIgnorieren then begin
    cnt:=0;
    while cnt<eingabeLaenge do begin
      bef2:=findeBefehl(eingabePuffer[cnt] shr 1);
      if (befehlsTabelle[bef].kollapsArt=befehlsTabelle[bef2].kollapsArt) and
         (cmd=befehlsTabelle[bef2].cmd) and
         (argumenteKompatibel(params,befehlsTabelle[bef2].params,befehlsTabelle[bef].kollapsArt)) then begin
        befehlVlltEntprellen(cnt);
        for i:=1 to eingabeLaenge-1 do
          eingabePuffer[i-1]:=eingabePuffer[i];
        dec(eingabeLaenge,1);
        case befehlsTabelle[bef].kollapsArt of
          kaToggle: begin
            result:=befehlVerarbeitet;
            exit;
          end;
          kaAddieren: begin
            s:=params;
            t:=befehlsTabelle[bef2].params;
            params:='';
            while s<>'' do
              params:=trim(params+' '+zusammenFassen(erstesArgument(s),erstesArgument(t)));
          end;
          kaNurEinMal: ;
          else
            raise exception.create('Weder Toggle, noch Addieren, noch NurEinMal, noch Ignorieren! Das ist komisch ...');
        end{of case};
        continue;
      end;
      if befehlsTabelle[bef2].kollapsTrenner then
        break;
      inc(cnt);
    end;
  end;

  if (cmd<>'nop') and (params<>befehlsTabelle[bef].neutralParams) then
    befehlAusfuehren(cmd,params);
end;

function tIRDecoder.gibAlleBefehle: string;
var
  bw:    longint;
  lw:    longword;
  b1,b2: boolean;
begin
  result:='';
  for bw:=0 to length(zeichenTabelle)-1 do begin
    lw:=zeichenTabelle[bw];
    lw:=((lw and not 1) shl 1) or byte(odd(lw));
    for b1:=false to true do
      for b2:=false to true do
        result:=result+base64Encode(lw or (byte(b1) shl 1) or (byte(b2) shl 4),3)+#10;
  end;
end;

// tBefehl *********************************************************************

constructor tBefehl.create;
begin
  inherited create;
  fillchar(cmd,sizeof(cmd),#0);
  cmd:='';
  fillchar(params,sizeof(params),#0);
  params:='';
  fillchar(neutralParams,sizeof(neutralParams),#0);
  neutralParams:='';
end;

destructor tBefehl.destroy;
begin
  cmd:='';
  params:='';
  neutralParams:='';
  inherited destroy;
end;

// allgemeine Funktionen *******************************************************

procedure befehleKonfLesen(konfigName: string);
var
  konfigDatei: tMyStringList;
  zeile,taste: string;
  cStat:       longword;
begin
  konfigDatei:=tMyStringList.create;
  konfigDatei.loadFromFile(konfigName);
  if not konfigDatei.unfoldMacros then
    raise exception.create('Fehler beim Entfalten der Makros in '''+konfigName+'''!');
  while konfigDatei.readln(zeile) do begin // Iteration über die Zeichen
    setlength(zeichenTabelle,length(zeichenTabelle)+1);
    if copy(zeile,length(zeile),1)<>':' then
      raise exception.create('Die erste Zeile einer Befehlsdefinition muss mit einem : enden, '''+zeile+''' tut das nicht!');
    delete(zeile,length(zeile),1);
    taste:=trim(zeile);
    zeichenTabelle[length(zeichenTabelle)-1]:=strtoint(taste);
    cStat:=0;
    repeat                                 // Iteration über die Befehle pro Zeichen
      if not konfigDatei.readln(zeile) then
        raise exception.create('Unerwartetes Dateiende in '''+konfigName+''' (Taste '+taste+')!');
      if zeile='Ende' then break;
      if startetMit('Befehl:',zeile) then begin
        setlength(befehlsTabelle,length(befehlsTabelle)+1);
        befehlsTabelle[length(befehlsTabelle)-1]:=tBefehl.create;
        befehlsTabelle[length(befehlsTabelle)-1].nummer:=length(zeichenTabelle)-1;
        befehlsTabelle[length(befehlsTabelle)-1].neutralParams:='';
        befehlsTabelle[length(befehlsTabelle)-1].altZustand:=cStat;
        befehlsTabelle[length(befehlsTabelle)-1].neuZustand:=cStat;
        inc(cStat);
        befehlsTabelle[length(befehlsTabelle)-1].kollapsArt:=kaIgnorieren;
        befehlsTabelle[length(befehlsTabelle)-1].einzelKlick:=true;
        befehlsTabelle[length(befehlsTabelle)-1].kollapsTrenner:=false;
        befehlsTabelle[length(befehlsTabelle)-1].cmd:=erstesArgument(zeile);
        befehlsTabelle[length(befehlsTabelle)-1].params:=zeile;
        continue;
      end;
      if startetMit('neutral:',zeile) then begin
        befehlsTabelle[length(befehlsTabelle)-1].neutralParams:=zeile;
        continue;
      end;
      if startetMit('altZustand:',zeile) then begin
        befehlsTabelle[length(befehlsTabelle)-1].altZustand:=strtoint(zeile);
        continue;
      end;
      if startetMit('neuZustand:',zeile) then begin
        befehlsTabelle[length(befehlsTabelle)-1].neuZustand:=strtoint(zeile);
        continue;
      end;
      if startetMit('einzelKlick:',zeile) then begin
        if zeile='ja' then befehlsTabelle[length(befehlsTabelle)-1].einzelKlick:=true
        else if zeile='nein' then befehlsTabelle[length(befehlsTabelle)-1].einzelKlick:=false
        else raise exception.create('''einzelKlick'' kann nur ''ja'' oder ''nein'' sein, nicht aber '''+zeile+'''!');
        continue;
      end;
      if startetMit('kollapsTrenner:',zeile) then begin
        if zeile='ja' then befehlsTabelle[length(befehlsTabelle)-1].kollapsTrenner:=true
        else if zeile='nein' then befehlsTabelle[length(befehlsTabelle)-1].kollapsTrenner:=false
        else raise exception.create('''kollapsTrenner'' kann nur ''ja'' oder ''nein'' sein, nicht aber '''+zeile+'''!');
        continue;
      end;
      if startetMit('kollapsArt:',zeile) then begin
        if zeile='ignorieren' then
          befehlsTabelle[length(befehlsTabelle)-1].kollapsArt:=kaIgnorieren
        else if zeile='toggle' then
          befehlsTabelle[length(befehlsTabelle)-1].kollapsArt:=kaToggle
        else if zeile='addieren' then
          befehlsTabelle[length(befehlsTabelle)-1].kollapsArt:=kaAddieren
        else if zeile='nurEinMal' then
          befehlsTabelle[length(befehlsTabelle)-1].kollapsArt:=kaNurEinMal
        else
          raise exception.create('Unbekannte kollapsArt '''+zeile+''' (Taste '+taste+')!');
        continue;
      end;
      raise exception.create('Verstehe Option '''+zeile+''' nicht in '''+konfigName+''' (Taste '+taste+')!');
    until false;
  end;
  konfigDatei.free;
  sortiereZeichenTabelle(0,length(zeichenTabelle)-1);
  sortiereBefehlsTabelle(0,length(befehlsTabelle)-1);
end;

procedure sortiereZeichenTabelle(von,bis: int64);
var
  li,re,pv,i: longint;
begin
  if von>=bis then exit;
  pv:=zeichenTabelle[von];
  re:=pv;
  for li:=von+1 to bis do begin
    pv:=min(pv,zeichenTabelle[li]);
    re:=max(re,zeichenTabelle[li]);
  end;
  pv:=(pv+re) div 2; // das Pivot-Element
  li:=von;
  re:=bis;
  while li<=re do begin
    while (li<bis) and (zeichenTabelle[li]<=pv) do
      inc(li);
    while (re>von) and (zeichenTabelle[re]>pv) do
      dec(re);
    if li>=re then break;
    i:=zeichenTabelle[re];
    zeichenTabelle[re]:=zeichenTabelle[li];
    zeichenTabelle[li]:=i;
    for i:=0 to length(befehlsTabelle)-1 do
      if befehlsTabelle[i].nummer=li then
        befehlsTabelle[i].nummer:=re
      else if befehlsTabelle[i].nummer=re then
        befehlsTabelle[i].nummer:=li;
    inc(li);
    dec(re);
  end;
  if li<>re+1 then
    raise exception.create('Sanity-Check nicht bestanden: li<>re+1 kann beim Quicksort nicht sein!');
  if re=bis then
    raise exception.create('Rechter Rand hat sich nicht verbessert!');
  if li=von then
    raise exception.create('Linker Rand hat sich nicht verbessert!');
  sortiereZeichenTabelle(von,re);
  sortiereZeichenTabelle(li,bis);
end;

procedure sortiereBefehlsTabelle(von,bis: int64);
var
  mi,ma,li,re,pv,pvZ,i: longint;
  tmp:                  tBefehl;
begin
  tmp:=nil;
  if von>=bis then exit;
  mi:=von;
  ma:=mi;
  for i:=von+1 to bis do begin
    if befehlsVergleich(mi,i)>0 then mi:=i;
    if befehlsVergleich(ma,i)<0 then ma:=i;
  end;
  pv:=(befehlsTabelle[mi].nummer+befehlsTabelle[ma].nummer) div 2;          // das
  pvZ:=(befehlsTabelle[mi].altZustand+befehlsTabelle[ma].altZustand) div 2; // Pivot-Element

  if befehlsVergleich(mi,pv,pvZ)<0 then begin
    pv:=befehlsTabelle[mi].nummer;
    pvZ:=befehlsTabelle[mi].altZustand;
  end;

  li:=von;
  re:=bis;
  while li<=re do begin
    while (li<=bis) and
          (befehlsVergleich(li,pv,pvZ)<=0) do
      inc(li);
    while (re>=von) and
          (befehlsVergleich(re,pv,pvZ)>0) do
      dec(re);
    if li>=re then break;
    tmp:=befehlsTabelle[re];
    befehlsTabelle[re]:=befehlsTabelle[li];
    befehlsTabelle[li]:=tmp;
    inc(li);
    dec(re);
  end;
  fillchar(tmp,sizeof(tBefehl),#0);
  if li<>re+1 then
    raise exception.create('Sanity-Check nicht bestanden: li<>re+1 kann beim Quicksort nicht sein!');
  if re=bis then
    raise exception.create('Rechter Rand hat sich nicht verbessert!');
  if li=von then
    raise exception.create('Linker Rand hat sich nicht verbessert!');
  sortiereBefehlsTabelle(von,re);
  sortiereBefehlsTabelle(li,bis);
end;

function befehlsVergleich(b1,b2: int64): integer;
begin
  result:=befehlsVergleich(b1,befehlsTabelle[b2].nummer,befehlsTabelle[b2].altZustand);
end;

function befehlsVergleich(b1,b2Num,b2Zus: int64): integer;
begin
  if befehlsTabelle[b1].nummer<b2Num then begin
    result:=-1;
    exit;
  end;
  if befehlsTabelle[b1].nummer>b2Num then begin
    result:=1;
    exit;
  end;
  if befehlsTabelle[b1].altZustand<b2Zus then begin
    result:=-1;
    exit;
  end;
  if befehlsTabelle[b1].altZustand>b2Zus then begin
    result:=1;
    exit;
  end;
  result:=0;
end;

function argumenteKompatibel(par1,par2: string; ka: tKollapsArt): boolean;
var
  s1,s2: string;
begin
  result:=false;
  case ka of
    kaToggle,kaNurEinMal:
      result:=par1=par2;
    kaAddieren: begin
      result:=true;
      while result and (par1<>'') and (par2<>'') do begin
        s1:=erstesArgument(par1);
        s2:=erstesArgument(par2);
        result:=
          result and
          ((s1=s2) or
           (istGanzZahl(s1) and istGanzZahl(s2)));
      end;
      result:=result and (par1=par2);
    end;
  end{of case};
end;

var i: longint;

initialization
  fillchar(befehlsTabelle,sizeof(befehlsTabelle),#0);
  setlength(befehlsTabelle,0);
  fillchar(zeichenTabelle,sizeof(zeichenTabelle),#0);
  setlength(zeichenTabelle,0);
finalization
  for i:=0 to length(befehlsTabelle)-1 do
    befehlsTabelle[i].free;
  setlength(befehlsTabelle,0);
  setlength(zeichenTabelle,0);
end.