{
  Download.pas: tape file downloading. 
}

unit Download;

interface

function InitInput: Boolean;
procedure DoneInput;
function DownloadFile: Boolean;

implementation

uses
  Windows, MMSystem, SysUtils, Math, BKFile, Common, Config;

var
  Hdr1, Hdr2: TWaveHdr;
  HdrPtr1, HdrPtr2: PWaveHdr;

  waveIn: HWaveIn = 0;
  SyncEvent: THandle = 0;
  BufPos,
  BasicWidth: Integer;

function InitHeader(var Hdr: TWaveHdr): Boolean;
begin
  Hdr.dwBufferLength := AudioBufSize * SizeOf(TSample);
  GetMem(Hdr.lpData, Hdr.dwBufferLength);
  if MMFailed(waveInPrepareHeader(WaveIn, @Hdr, SizeOf(TWaveHdr))) then
    begin
      ErrorMsg('InitHeader: waveInPrepareHeader failed.');
      Result := False;
    end
  else
    Result := True;
end;

procedure FreeHeader(var Hdr: TWaveHdr);
begin
  if Hdr.dwFlags and WHDR_PREPARED = 0 then Exit;
  waveInUnprepareHeader(WaveIn, @Hdr, SizeOf(TWaveHdr));
  FreeMem(Hdr.lpData);
end;

function FlipBuf: Boolean;
var
  p: PWaveHdr;
begin
  Result := False;

  if MMFailed(waveInAddBuffer(WaveIn, HdrPtr2, SizeOf(TWaveHdr))) then
    begin
      ErrorMsg('FlipBuf: waveInAddBuffer failed.');
      Exit;
    end;

  if
    WaitForSingleObject(SyncEvent, AudioBufSize * 2000 div AudioSmpRate) <> WAIT_OBJECT_0
  then
    begin
      ErrorMsg('FlipBuf: Callback event timeout.');
      Exit;
    end;

  p := HdrPtr1;
  HdrPtr1 := HdrPtr2;
  HdrPtr2 := p;
  Result := True;
end;

function InitInput: Boolean;
var
  Fmt: TWaveFormatEx;
begin
  Result := False;

  SyncEvent := CreateEvent(nil, False, False, nil);
  if SyncEvent = 0 then
    begin
      ErrorMsg('InitInput: CreateEvent failed.');
      Exit;
    end;

  Fmt.cbSize := SizeOf(Fmt);
  Fmt.wFormatTag := WAVE_FORMAT_PCM;
  Fmt.nSamplesPerSec := AudioSmpRate;
  Fmt.wBitsPerSample := 16;
  Fmt.nChannels := 2;
  Fmt.nBlockAlign := Fmt.nChannels * 2;
  Fmt.nAvgBytesPerSec := Fmt.nBlockAlign * Fmt.nSamplesPerSec;
  WaveIn := 0;
  if
    MMFailed(
      waveInOpen(@WaveIn, WAVE_MAPPER, @Fmt, SyncEvent, 0, CALLBACK_EVENT)
    )
  then
    ErrorMsg('InitInput: waveInOpen failed.')
  else
    begin
      Hdr1.dwFlags := 0;
      Hdr2.dwFlags := 0;
      if InitHeader(Hdr1) and InitHeader(Hdr2) then
        begin
          HdrPtr1 := @Hdr1;
          HdrPtr2 := @Hdr2;
          BufPos := 0;
          if FlipBuf then
            if MMFailed(waveInStart(WaveIn)) then
              ErrorMsg('InitInput: waveInStart failed.')
            else
              begin
                Result := True;
                Exit;
              end;
      end;
    end;
  DoneInput;
end;

procedure DoneInput;
begin
  if SyncEvent <> 0 then
    begin
      if WaveIn <> 0 then
        begin
          waveInReset(WaveIn);
          FreeHeader(Hdr1);
          FreeHeader(Hdr2);
          waveInClose(WaveIn);
        end;
      CloseHandle(SyncEvent);
    end;
end;

function Measure(w: Integer): Boolean;
begin
  Result := Abs(2 * (w - BasicWidth) div BasicWidth) < 1;
end;

function GetPulse: Integer;
var
  p: PSample;
  i, u: Integer;
begin
  Result := 0;
  while not Stopped do
    begin
      p := @PBuffer(HdrPtr2.lpData)[BufPos];
      for i := BufPos to HdrPtr2.dwBytesRecorded shr 2 - 1 do
        begin
          u := (p.l * LeftGain + p.r * RightGain) div AudioMaxAmp;
          if Threshold * (u - Threshold) >= 0 then
            begin
              Threshold := (Threshold + u div 4) div 2;
              Inc(Result);
            end
          else
            if Result <> 0 then
              begin
                BufPos := i + 1;
                Exit;
              end;
          Inc(p);
        end;
      if not FlipBuf then
        begin
          Result := 0;
          Exit;
        end;
      BufPos := 0;
    end;
  Result := 0;
end;

function Tuneup: Boolean;
var
  i, n, s, w: Integer;
begin
  Result := False;
  repeat
    for i := 1 to 2048 do
      if GetPulse = 0 then Exit;
    n := 0;
    s := 0;
    repeat
      w := GetPulse;
      if w = 0 then Exit;
      Inc(n);
      Inc(s, w);
      BasicWidth := s div n;
    until not Measure(w);
  until Measure(w shr 2) and Measure(GetPulse shr 1) and Measure(GetPulse);
  Result := True;
end;

function DetectSync: Boolean;
var
  i, w: Integer;
begin
  Result := False;
  for i := 2 downto 0 do
    begin
      w := GetPulse;
      if w = 0 then Exit;
      if not Measure(w shr i) then
        begin
          ErrorMsg('Sync. sequence is broken.');
          Exit;
        end;
    end;
  Result := True;
end;

function GetBlock(var Buf; Count: Integer): Boolean;
label
  Error;
var
  i, j,
  w1, w2, b: Integer;
  p: PByte;
begin
  Result := False;
  p := @Buf;
  for i := 1 to Count do
    begin
      b := 0;
      for j := 1 to 8 do
        begin
          w1 := GetPulse;
          if w1 = 0 then Exit;
          w2 := GetPulse;
          if w2 = 0 then Exit;
          if not Measure(w2) then goto Error;
          b := b shr 1;
          if Measure(w1 shr 1) then
            b := b or $80
          else
            if not Measure(w1) then goto Error;
        end;
      p^ := b;
      Inc(p);
    end;
  Result := True;
  Exit;
Error:
  ErrorMsg('Unmatched pulse width.');
end;

function GetFileHeader(var Hdr: TBKFileHeader): Boolean;
begin
  if not GetBlock(Hdr, SizeOf(TBKFileHeader)) then
    begin
      Result := False;
      Exit;
    end;
  PrintFileHeader(Hdr);
  Result := True;
end;

function GetFileData(var Buf; Size: Integer): Boolean;
var
  i, b: Integer;
  p: PChar;
  cs: Word;
begin
  Result := False;
  p := @Buf;
  i := Size;
  StartProgress;
  while i > 0 do
    begin
      if i < 256 then b := i else b := 256;
      if not GetBlock(p^, b) then Exit;
      Inc(p, b);
      Dec(i, b);
      PrintProgress(Size - i, Size);
    end;
  Writeln;

  if not GetBlock(cs, 2) then Exit;
  if cs <> CheckSum(Buf, Size) then ErrorMsg('Ñhecksum mismatch.');

  i := GetPulse;
  if i = 0 then Exit;
  if i < BasicWidth * 6 then ErrorMsg('EOF marker not found.');

  Result := True;
end;

function DownloadFile: Boolean;
var
  i: Integer;
  f: TBKFile;
begin
  Result := False;
  if not TuneUp then Exit;
  for i := 1 to 8 do
    if GetPulse = 0 then Exit;
  if not DetectSync then Exit;
  if not GetFileHeader(f.Header) then Exit;
  for i := 1 to 8 do
    if GetPulse = 0 then Exit;
  if not DetectSync then Exit;
  if not GetFileData(f.Data, f.Header.Len) then Exit;
  SaveBKFile(f);
  Result := True;
end;

end.