Синхронный многоканальный синтезатор для работы с системной пищалкой

MultichannelSynthesizer.pas

unit MultichannelSynthesizer;

interface

uses
  SysUtils, Math, NotesInfo, NotesSerializer, BeeperWrapper, TimeManagement;

{
   * Tempo - длительность одной ячейки в секундах
   * SwitcherDelay - интервал в секундах между переключениями каналов
   * UsePrecisionDelay - использовать точную задержку переключения между каналами,
                         отстроив темп воспроизведения от времени задержки
}

//HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH
//                   Плеер с синхронизированными каналами
//HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH

type
  TChannel  = array of Single;
  TChannels = array of TChannel;

  TBeeperPlayer = class
    private
      FTempo: Double;
      FSwitcherDelay: Double;
      FUsePrecisionDelay: Boolean;
      FChannels: TChannels;
    public
      // Длительность "ячейки", в секундах:
      property Tempo: Double read FTempo write FTempo;

      // Интервал переключения между каналами, в секундах:
      property SwitcherDelay: Double read FSwitcherDelay write FSwitcherDelay;

      property UsePrecisionDelay: Boolean read FUsePrecisionDelay write FUsePrecisionDelay;
      property Channels: TChannels read FChannels write FChannels;

      constructor Create;
      destructor Destroy; override;

      // Формат записи: "4:C0 1:0 2:F3S" - 4 ячейки C0, 1 ячейка пустая, 2 ячейки F3S:
      procedure ParseChannelData(NoteText: string; var Channel: TChannel);

      // 12 полутонов - одна октава (плюс - повысить тон, минус - понизить):
      procedure TransposeChannel(var Channel: TChannel; SemitonesCount: Integer);

      procedure Play;
  end;

implementation

//HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH

{ TBeeperPlayer }

constructor TBeeperPlayer.Create;
begin
  FSwitcherDelay := 0.012;
  FTempo := 1.0;
  FUsePrecisionDelay := False;
end;

// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

destructor TBeeperPlayer.Destroy;
var
  I: Integer;
begin
  for I := 0 to Length(FChannels) - 1 do
    SetLength(FChannels[I], 0);
  SetLength(FChannels, 0);
  inherited;
end;

// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

{ Формат записи: "4:C0 1:0 2:F3S" - 4 ячейки C0, 1 ячейка пустая, 2 ячейки F3S }
procedure TBeeperPlayer.ParseChannelData(NoteText: string; var Channel: TChannel);

  procedure GetNoteAndDuration(NoteText: string; out Note: Single; out Duration: Integer);
  var
    DurationPos: Integer;
    DurationStr, NoteStr: string;
  begin
    NoteText := Trim(NoteText);

    DurationPos := Pos(':', NoteText);
    if DurationPos = 0 then
    begin
      Duration := 1;
      Note := NotesList.GetFrequency(NoteText);
    end
    else
    begin
      DurationStr := Copy(NoteText, 1, DurationPos - 1);
      NoteStr := Copy(NoteText, DurationPos + 1, Length(NoteText) - DurationPos);
      Duration := StrToInt(DurationStr);
      Note := NotesList.GetFrequency(NoteStr);
    end;
  end;

  procedure AddNoteToChannel(var Channel: TChannel; const Note: Single; Duration: Integer);
  var
    Position, Size, I: Integer;
  begin
    if Duration = 0 then Exit;

    Size := Length(Channel);
    Position := Size;
    Inc(Size, Duration);
    SetLength(Channel, Size);
    for I := Position to Size - 1 do
      Channel[I] := Note;
  end;

var
  TextLength: Integer;
  StartPos, EndPos: Integer;
  NoteStr: string;
  NoteFreq: Single;
  Duration: Integer;
begin
  SetLength(Channel, 0);

  TextLength := Length(NoteText);
  if TextLength = 0 then Exit;

  NoteText := UpperCase(Trim(NoteText));
  StartPos := Pos(' ', NoteText);

  if StartPos = 0 then
  begin
    GetNoteAndDuration(NoteText, NoteFreq, Duration);
    AddNoteToChannel(Channel, NoteFreq, Duration);
    Exit;
  end;

  if StartPos > 1 then
  begin
    NoteStr := Copy(NoteText, 1, StartPos - 1);
    GetNoteAndDuration(NoteStr, NoteFreq, Duration);
    AddNoteToChannel(Channel, NoteFreq, Duration);
  end;

  while StartPos <> 0 do
  begin
    EndPos := Pos(' ', NoteText, StartPos + 1);
    if EndPos = StartPos + 1 then
    begin
      StartPos := Pos(' ', NoteText, EndPos);
      Continue;
    end;

    if EndPos <> 0 then
      NoteStr := Copy(NoteText, StartPos + 1, EndPos - (StartPos + 1))
    else
      if StartPos < TextLength then
        NoteStr := Copy(NoteText, StartPos + 1, TextLength - StartPos)
      else
        Break;

    GetNoteAndDuration(NoteStr, NoteFreq, Duration);
    AddNoteToChannel(Channel, NoteFreq, Duration);

    StartPos := Pos(' ', NoteText, EndPos);
  end;
end;

// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

// Транспонирование [NewTone = OldTone * ((2 ^ 1/12) ^ SemitonesCount)]:
procedure TBeeperPlayer.TransposeChannel(var Channel: TChannel;
  SemitonesCount: Integer);
const
  ScalingCoeff: Double = 1.059463094359295; // Корень 12й степени из двойки
var
  Coeff: Double;
  ChannelLength: Integer;
  I: Integer;
begin
  ChannelLength := Length(Channel);
  if (SemitonesCount = 0) or (ChannelLength = 0) then Exit;

  Coeff := Power(ScalingCoeff, Abs(SemitonesCount));

  if SemitonesCount > 0 then
    for I := 0 to ChannelLength - 1 do Channel[I] := Channel[I] * Coeff
  else
    for I := 0 to ChannelLength - 1 do Channel[I] := Channel[I] / Coeff;
end;

// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

procedure TBeeperPlayer.Play;
var
  ElementCounter, ChannelCounter: Integer;
  ChannelsLength: array of Integer;
  ChannelsCount: Integer;
  MaximumLength: Integer;

  // Таймер каждой ноты:
  T1, T2: Double;
  Delta: Double;

  // Таймер точного переключателя каналов:
  SwitcherT1, SwitcherT2: Double;
  SwitcherDelta, InTimeDelta: Double;
  I: Integer;

  IsMute: Boolean;
  IsMultichannel: Boolean;

  // Последний ли канал в списке:
  function IsChannelLast(ChannelNumber: Integer): Boolean;
  begin
    Result := ChannelNumber = ChannelsCount - 1;
  end;

  // Доступна ли ячейка (не вышли ли за границы линии канала):
  function IsCellAvail(ChannelNumber, Position: Integer): Boolean;
  begin
    Result := Position < ChannelsLength[ChannelNumber];
  end;

  // Последняя ли ячейка в канале:
  function IsCellLast(ChannelNumber, Position: Integer): Boolean;
  begin
    Result := Position = ChannelsLength[ChannelNumber] - 1;
  end;

  // Пустая ли ячейка:
  function IsCellEmpty(ChannelNumber, Position: Integer): Boolean;
  begin
    Result := FChannels[ChannelNumber][Position] = 0;
  end;

  // Пустые ли ячейки всех каналов на данном отрезке:
  function IsEmptyCells(Position: Integer): Boolean;
  var
    I: Integer;
  begin
    Result := True;
    if ChannelsCount = 0 then Exit;

    for I := 0 to ChannelsCount - 1 do
    begin
      if Position >= ChannelsLength[I] then Continue;
      if FChannels[I][Position] <> 0 then Exit(False);
    end;
  end;

  function Max(A, B: Integer): Integer; inline;
  begin
    if A > B then Result := A else Result := B;
  end;

begin
  ChannelsCount := Length(FChannels);
  if ChannelsCount = 0 then Exit;
  IsMultichannel := ChannelsCount > 1;

  // Получаем длину каждого канала:
  MaximumLength := 0;
  SetLength(ChannelsLength, ChannelsCount);
  for ChannelCounter := 0 to ChannelsCount - 1 do
  begin
    ChannelsLength[ChannelCounter] := Length(FChannels[ChannelCounter]);
    MaximumLength := Max(MaximumLength, ChannelsLength[ChannelCounter]);
  end;

  if MaximumLength = 0 then Exit;

  // Запускаем цикл по всем элементам:
  for ElementCounter := 0 to MaximumLength - 1 do
  begin
    T1 := GetTimer;

    // Выключаем пищалку, если в каналах на даной позиции пусто:
    IsMute := IsEmptyCells(ElementCounter);
    if IsMute then StopBeeper else StartBeeper;

    // Пробегаемся по каналам:
    repeat
      for ChannelCounter := 0 to ChannelsCount - 1 do
      begin
        if ElementCounter >= ChannelsLength[ChannelCounter] then Continue;
        if FChannels[ChannelCounter][ElementCounter] = 0 then Continue;

        SetBeeperFrequency(FChannels[ChannelCounter][ElementCounter]);

        if IsMultichannel then
        begin
          if FUsePrecisionDelay then
          begin

            // Крутим цикл, пока укладываемся в интервал переключения:
            SwitcherT1 := GetTimer;
            repeat
              SwitcherT2 := GetTimer;
              SwitcherDelta := SwitcherT2 - SwitcherT1;
              Delta := SwitcherT2 - T1;
            until (SwitcherDelta > FSwitcherDelay) or (Delta > FTempo);

            // Если гарантированно не успеваем сделать ещё один цикл -
            // переключаемся на следующий канал и воспроизводим его всё оставшееся время:
            InTimeDelta := FTempo - Delta;
            if InTimeDelta < FSwitcherDelay then
            begin
              if not IsChannelLast(ChannelCounter) then
              begin
                // Ищем первый ненулевой канал:
                for I := ChannelCounter + 1 to ChannelsCount - 1 do
                begin
                  if IsCellAvail(I, ElementCounter) then
                    if not IsCellEmpty(I, ElementCounter) then
                    begin
                      // Если нашли ненулевую ячейку - отыгрываем оставшееся время:
                      SetBeeperFrequency(FChannels[I][ElementCounter]);
                      Break;
                    end;
                end;
              end;

              // Ждём оставшееся время:
              MicroSleep(InTimeDelta);
              Break;
            end;

          end
          else
          begin
            MicroSleep(FSwitcherDelay);
          end;
        end;
      end;

      T2 := GetTimer;
      Delta := T2 - T1;
    until Delta > FTempo;
  end;

  StopBeeper;
end;


end.