Status remote decoder

Program remote;
{
This program extracts binary sequences from WAV files for the Status
  remote control or similar devices. It can display handset ID so you can
  use pihat to simulate communications with already paired remote switches.
  WAV audio format must be recorded as PCM 44.1kHz / 48kHz Stereo or Mono.

  There several ways to capture audio such as tapping into the remote control
  circuit board, use a coil microphone or telephone pickup coil (untested).
  If you have an FM radio which lacks *AFC drift control then it should be
  possible tune to one of the remote control's transmission harmonics.
  If audio contains lots of background noise then use the -f1 -f2 parameter,
  if no data can be found you'll need to retune your radio and re-record.

  *AFC technology is used to lock onto an FM signal to prevent tuning drift
  it does not play nicely with AM broadcasts such as the Status remote
  control and thus audio could degrade as a result.
}

{$i-}

uses crt;

var
   f_read : file;
   read_buffer : array [1..8192] of byte;
   wav_buffer : array [1..4] of byte;
   read_offset, bytes_read : word;
   stereo, bit16, show_status : boolean;
   filter_mode : byte;
   last_msg : string;
Procedure open_wav;
begin
  assign(f_read,paramstr(1));
  filemode := 2;
  reset(f_read,1);
  if ioresult <> 0 then
  begin
    writeln;
    writeln('Error cannot open: ',paramstr(1));
    halt(0);
  end;
  read_offset := 0;
end;

Procedure close_wav;
begin
  close(f_read);
end;

Function read_byte(var data:byte):boolean;
var
   loop : byte;
begin
  if read_offset = 0 then BlockRead(f_read,read_buffer,Sizeof(read_buffer),bytes_read);
  if bytes_read = 0 then read_byte := true
  else
  begin
    if (bytes_read < Sizeof(read_buffer)) and (read_offset = bytes_read) then read_byte := true
    else
    begin
      inc(read_offset);
      data := read_buffer[read_offset];
      if read_offset = (Sizeof(read_buffer)) then read_offset := 0;
      read_byte := false;
    end;
  end;
end;

Function audio_filter(data,method:byte):byte;
var lpf : byte;
    hpf : integer;
begin
  if (method = 0) then lpf := data;
  if (method = 1) then lpf := (data + wav_buffer[1]) div 2;
  if (method = 2) then
  begin
    lpf := (data + wav_buffer[1] + wav_buffer[2] +
                   wav_buffer[3] + wav_buffer[4]) div 5;
    if data > lpf then hpf := data - lpf
                  else hpf := lpf - data;
    hpf := hpf div 2;
    if data > lpf then lpf := lpf + hpf
                  else lpf := lpf - hpf;
  end;
  wav_buffer[4] := wav_buffer[3];
  wav_buffer[3] := wav_buffer[2];
  wav_buffer[2] := wav_buffer[1];
  wav_buffer[1] := data;
  audio_filter := lpf;
end;

Function read_wav(var data:byte):boolean;
var
   mono8, left8, right8 : byte;
   mono16, left16, right16 : word;
   eof : boolean;
begin
  eof := read_byte(mono8);
  if stereo and not bit16 then { stereo 8bit }
  begin
    left8 := mono8;
    if not eof then eof := read_byte(right8);
    mono8 := (left8 + right8) div 2; { stereo -> mono }
  end;
  if bit16 then { 16bit audio }
  begin
    mono16 := mono8;
    if not eof then eof := read_byte(mono8);
    mono16 := mono16 + mono8 * 256;
    mono16 := mono16 xor 32768;
    if stereo then { stereo 16bit }
    begin
      left16 := mono16;
      if not eof then eof := read_byte(mono8);
      right16 := mono8;
      if not eof then eof := read_byte(mono8);
      right16 := right16 + mono8 * 256;
      right16 := right16 xor 32768;
      mono16 := (left16 + right16) div 2; { stereo -> mono }
    end;
    mono8 := mono16 div 256; { 16bit -> 8bit }
  end;
  data := audio_filter(mono8,filter_mode);
  read_wav := eof;
end;

Procedure help;
begin
  writeln('Remote control binary decoder - redhawk 2013');
  writeln('usage: remote audio.wav [options]');
  writeln('[options]: -s -f1 -f2');
  writeln('-s = decode Status binary data');
  writeln('-f(n) = apply audio filter(n)');
  halt;
end;

Procedure wav_error(error_type:byte);
begin
exit;
  case error_type of
    0 : writeln('Not a valid WAV file');
    1 : writeln('WAV format not PCM');
    2 : writeln('Sample rate not 44.1kHz or 48kHz');
    3 : writeln('Only 8bit or 16bit sample files are supported');
    4 : writeln('WAV header missing "data" tag');
  end;
  close_wav;
  halt;
end;

Procedure verify_wav;
var
   loop, data : byte;
   eof : boolean;
   header_test : string;
   format_test : word;
begin
  header_test := '';
  for loop := 1 to 4 do
  begin
    eof := read_byte(data);
    if eof then wav_error(0);
    header_test := header_test + chr(data);
  end;
  for loop := 1 to 4 do eof := read_byte(data);
  for loop := 1 to 8 do
  begin
    eof := read_byte(data);
    header_test := header_test + chr(data);
  end;
  if header_test <> 'RIFFWAVEfmt ' then wav_error(0);
  for loop := 1 to 4 do eof := read_byte(data);
  eof := read_byte(data);
  format_test := data;
  eof := read_byte(data);
  format_test := format_test + data * 256;
  if format_test <> 1 then wav_error(1); { not PCM }
  eof := read_byte(data);
  format_test := data;
  eof := read_byte(data);
  format_test := format_test + data * 256;
  if format_test = 2 then stereo := true else stereo := false;
  eof := read_byte(data);
  format_test := data;
  eof := read_byte(data);
  format_test := format_test + data * 256;
  if ((format_test = 44100) or (format_test = 48000)) then else wav_error(2);
  eof := read_byte(data);
  format_test := data;
  eof := read_byte(data);
  format_test := format_test + data * 256;
  if format_test <> 0 then wav_error(2); { wrong sample rate }
  for loop := 1 to 6 do eof := read_byte(data);
  eof := read_byte(data);
  format_test := data;
  eof := read_byte(data);
  format_test := format_test + data * 256;
  if format_test = 16 then bit16 := true
  else
  begin
    bit16 := false;
    if format_test <> 8 then wav_error(3); { not 8bit or 16bit }
  end;
  header_test := '';
  for loop := 1 to 4 do
  begin
    eof := read_byte(data);
    header_test := header_test + chr(data);
  end;
  if header_test <> 'data' then wav_error(4);
  for loop := 1 to 4 do eof := read_byte(data);
end;

Function normalise(data:byte;dc_offset:integer;wav_norm:byte):byte;
var idata : longint;
    amp : integer;
begin
  idata := data - dc_offset - 128;
  amp := 10000 div (wav_norm + 1);
  idata := (idata * amp) div 100;
  idata := idata + 128;
  if idata > 255 then idata := 255;
  if idata < 0 then idata := 0;
  normalise := idata;
end;

Procedure decode_status(data:string);
var
   loop, state, channel : byte;
   handset_id : longint;
begin
  if not show_status then writeln(data)
  else
  begin
    handset_id := 0;
    channel := 0;
    if ((length(data) = 25) and (last_msg <> data)) then
    begin
      for loop := 2 to 20 do
      begin
        handset_id := handset_id * 2;
        handset_id := handset_id + (ord(data[loop]) - 48);
      end;
      state := ord(data[21]) - 48;
      for loop := 22 to 24 do
      begin
        channel := channel * 2;
        channel := channel + (ord(data[loop]) - 48);
      end;
      write(data, ' --brand=5 --id=',handset_id);
      write(' --channel=',channel);
      if channel = 0 then writeln(' (all off)')
                     else writeln(' --state=',state);
      last_msg := data;
    end;
  end;
end;

Function data2bin(data : byte):char;
var
   bin : byte;
begin
  bin := data div 30;
  if bin > 1 then bin := 0;
  data2bin := chr(bin + 48);
end;

Procedure profile_wav(var _wav_norm:word;var _dc_offset:longint);
var
   count, data, wav_max, wav_min : byte;
   dc_offset, lcount : longint;
   wav_norm, wav_buffer_start : word;
   eof : boolean;
begin
  for count := 1 to 4 do wav_buffer[count] := 128;
  lcount := 0;
  dc_offset := 0;
  wav_min := 128;
  wav_max := 128;
  wav_buffer_start := read_offset;
  repeat
    eof := read_wav(data);
    if not eof then
    begin
      dc_offset := dc_offset + (data - 127);
      lcount := lcount + 1;
      if data < wav_min then wav_min := data;
      if data > wav_max then wav_max := data;
    end;
  until eof;
  dc_offset := dc_offset div lcount;
  wav_min := 255 - wav_min;
  wav_min := wav_min + dc_offset;
  wav_max := wav_max - dc_offset;
  if wav_max > wav_min then wav_norm := wav_max
                       else wav_norm := wav_min;
  wav_norm := ((wav_norm - 128) * 100) div 128;
  read_offset := 0;
  seek(f_read,wav_buffer_start);
  _wav_norm := wav_norm;
  _dc_offset := dc_offset;
end;

Function param_option(data:string):boolean;
var
   loop : byte;
   test : boolean;
begin
  test := false;
  if paramcount > 1 then for loop := 1 to paramcount
    do if paramstr(loop) = data then test := true;
  param_option := test;
end;

Procedure main;
const
     trigger_threshold = 32;
var
   bin, data, last_data, last_data2 : byte;
   count, wav_norm : word;
   trigger_type : integer;
   dc_offset : longint;
   eof, trigger_pos, trigger_neg, capture : boolean;
   msg : string;
begin
  if (paramcount > 0) then count := 1
                      else count := 0;
  if param_option('-s') then show_status := true
                        else show_status := false;
  if show_status then count := count + 1;
  if param_option('-f1') then filter_mode := 1
                         else filter_mode := 0;
  if param_option('-f2') then filter_mode := 2;
  if filter_mode <> 0 then count := count + 1;
  if ((paramcount < 1) or (paramcount >count)) then help;
  open_wav;
  verify_wav;
  profile_wav(wav_norm,dc_offset);
  capture := false;
  trigger_type := -1;
  count := 0;
  msg := '';
  last_msg := '';
  for count := 1 to 4 do wav_buffer[count] := 128;
  eof := read_wav(data);
  last_data2 := normalise(data,dc_offset,wav_norm);
  eof := read_wav(data);
  last_data := normalise(data,dc_offset,wav_norm);
  repeat
    eof := read_wav(data);
    data := normalise(data,dc_offset,wav_norm);
    if not eof then
    begin
      if data > (last_data2 + trigger_threshold) then trigger_pos := true
                                                 else trigger_pos := false;
      if data < (last_data2 - trigger_threshold) then trigger_neg := true
                                                 else trigger_neg := false;
      if trigger_type = -1 then
      begin
        if trigger_pos or trigger_neg then count := 0;
        if trigger_pos then trigger_type := 0;
        if trigger_neg then trigger_type := 1;
        capture := true;
      end;
      if trigger_pos or trigger_neg then
      begin
        if trigger_type = 0 then
        begin
          if not trigger_neg then
          begin
            capture := true;
            count := 0;
          end else
          if capture then
          begin
            msg := msg + data2bin(count);
            capture := false;
          end
        end;
        if trigger_type = 1 then
        begin
          if not trigger_pos then
          begin
            capture := true;
            count := 0;
          end else
          if capture then
          begin
            msg := msg + data2bin(count);
            capture := false;
          end;
        end;
      end;
      if count = 200 then
      begin
        if msg <> '' then decode_status(msg);
        msg := '';
        trigger_type := -1;
      end;
      count := count + 1;
      last_data2 := last_data;
      last_data := data;
    end;
  until eof;
  if msg <> '' then decode_status(msg);
  close_wav;
end;

Begin
  main{};
end.