{
    Players содержит классы для проигрывания звука в формате импульсно-кодовой
    модуляции (ИКМ, PCM) и MIDI.

    Copyright © 2016, 2019, 2022 Малик Разработчик

    Это свободная программа: вы можете перераспространять её и/или
    изменять её на условиях Меньшей Стандартной общественной лицензии GNU в том виде,
    в каком она была опубликована Фондом свободного программного обеспечения;
    либо версии 3 лицензии, либо (по вашему выбору) любой более поздней версии.

    Эта программа распространяется в надежде, что она может быть полезна,
    но БЕЗО ВСЯКИХ ГАРАНТИЙ; даже без неявной гарантии ТОВАРНОГО ВИДА
    или ПРИГОДНОСТИ ДЛЯ ОПРЕДЕЛЁННЫХ ЦЕЛЕЙ. Подробнее см. в Меньшей Стандартной
    общественной лицензии GNU.

    Вы должны были получить копию Меньшей Стандартной общественной лицензии GNU
    вместе с этой программой. Если это не так, см.
    <http://www.gnu.org/licenses/>.
}

unit Players;

{$MODE DELPHI}
{$ASMMODE INTEL}

interface

uses
    Windows,
    MMSystem,
    Classes,
    LMessages,
    Lang,
    IntelMMX,
    Timers;

{%region public }
const
    PLAYER_PCM_LISTENER_GUID = '{74C86B60-AC5B-4E8D-8ACD-29A50B5C150D}';
    PLAYER_MIDI_LISTENER_GUID = '{74C86B60-AC5B-4E8D-8ACD-29A50B5C150E}';

type
    PlayerPCMListener = interface;
    PlayerMIDIListener = interface;
    Player = class;
    PlayerPCM = class;
    PlayerMIDI = class;

    PlayerPCMListener = interface(_Interface) [PLAYER_PCM_LISTENER_GUID]
        procedure loadPCMBlock(player: PlayerPCM; blockIndex: int);
    end;

    PlayerMIDIListener = interface(_Interface) [PLAYER_MIDI_LISTENER_GUID]
        procedure endMIDITrack(player: PlayerMIDI);
    end;

    Player = class(_Object)
    strict private
        class procedure deallocateHWND(wnd: Windows.HWND);
        class function allocateHWND(const wndProc: Classes.TWndMethod): Windows.HWND;
    protected
        const PM_BLOCK_END = int(LMessages.LM_USER + 1);
    public
        const FREED = int(0);
        const STARTED = int(1);
        const STOPPED = int(2);
        const MUTE_VOLUME = int(0);
        const MAX_VOLUME = int(127);

    strict private
        wndHandle: Windows.HWND;
    protected
        invalidData: boolean;
        noDevices: boolean;
        state: int;
        volume: int;
        procedure endCurrentBlockPlaying(); virtual; abstract;
        procedure sendMessage(message: int); virtual;
        procedure wndProc(var theMessage: LMessages.TLMessage); virtual;
        procedure notifyEndCurrentBlockPlaying();
        function getWindowHandle(): Windows.HWND;
    public
        constructor create();
        destructor destroy; override;
        function start(): int; virtual; abstract;
        function stop(): int; virtual; abstract;
        function reset(): int; virtual; abstract;
        function getCurrentBlockPosition(): int; virtual; abstract;
        function setCurrentBlockPosition(position: int): int; virtual; abstract;
        function loadBlock(const src: long_Array1d; offset, length: int): int; virtual; abstract;
        function isInvalidData(): boolean; virtual;
        function isNoDevices(): boolean; virtual;
        function getState(): int; virtual;
        function getVolume(): int; virtual;
        function getCurrentBlockIndex(): int; virtual;
        function setVolume(volume: int): int; virtual;
    end;

    PlayerPCM = class(Player)
    strict private
        const BLOCKS_COUNT = int(2);
        const GAMMA_VALUE = real(20000.0);
        const EXPONENT = real(1.e+0005 / (2.2 * GAMMA_VALUE));
        class procedure changeAmplitude(const src: shortMMX; var dst: shortMMX; multiplier: int);
        class function power(base, exp: real): real;
    public
        const MIN_BLOCK_LENGTH = int($00000100);
        const MAX_BLOCK_LENGTH = int($00010000);

    strict private
        waveOut: MMSystem.HWAVEOUT;
        waveOutCallResult: MMSystem.MMRESULT;
        waveFormat: MMSystem.WAVEFORMATEX;
        waveHeader: MMSystem.WAVEHDR;
    strict private
        changing: boolean;
        sampleAlign: int;
        currentBlockIndex: int;
        currentBlockPosition: int;
        dataPlayingIndex: int;
        dataPlaying: long_Array2d;
        dataSource: long_Array2d;
        dataLength: int_Array1d;
        listener: PlayerPCMListener;
        procedure startBlock();
        procedure stopBlock();
        procedure resetBlock();
        procedure applyVolume(); overload;
        procedure applyVolume(dataIndex: int); overload;
        function correctLength(length: int): int;
    private
        procedure callback(waveOut: MMSystem.HWAVEOUT; msg, param1, param2: int);
    protected
        procedure endCurrentBlockPlaying(); override;
    public
        constructor create(samplesPerSecond, bitsPerSample, channelsCount, blockLength: int; listener: PlayerPCMListener);
        destructor destroy; override;
        function start(): int; override;
        function stop(): int; override;
        function reset(): int; override;
        function getCurrentBlockIndex(): int; override;
        function getCurrentBlockPosition(): int; override;
        function setCurrentBlockPosition(position: int): int; override;
        function setVolume(volume: int): int; override;
        function loadBlock(const src: long_Array1d; offset, length: int): int; override;
    end;

    PlayerMIDI = class(Player, Runnable)
    strict private
        const TERMINATE = int(0);
        const MIDI_MESSAGE = int(1);
        const LOAD_BLOCK = int(2);
        const PLAYBACK_START = int(3);
        const PLAYBACK_STOP = int(4);
        const PLAYBACK_SET_POS = int(5);
        const PLAYBACK_RESET = int(6);
        const MIDI_MESSAGE_END_TRACK = int($00ff2f00);
    strict private
        class function shortMsg(playerFormattedMessage: int): DWORD;
    private
        class var MIDI_OUT: MMSystem.HMIDIOUT;

    strict private
        midiOutCallResult: MMSystem.MMRESULT;
    strict private
        terminated: boolean;
        currentBlockPosition: int;
        queueTail: int;
        queueHead: int;
        queueEvents: long_Array1d;
        dataPlaying: long_Array1d;
        listener: PlayerMIDIListener;
        procedure setEvent(event, parameter: int);
        procedure waitEvent(milliseconds: long);
        procedure allNotesOff();
    protected
        procedure endCurrentBlockPlaying(); override;
    public
        constructor create(listener: PlayerMIDIListener);
        destructor destroy; override;
        procedure sendMessage(message: int); override;
        function start(): int; override;
        function stop(): int; override;
        function reset(): int; override;
        function getCurrentBlockPosition(): int; override;
        function setCurrentBlockPosition(position: int): int; override;
        function loadBlock(const src: long_Array1d; offset, length: int): int; override;
        procedure run(); virtual;
    end;
{%endregion}

implementation

{$T-}

{%region routine }
    procedure PlayerPCM_callback(waveOut: MMSystem.HWAVEOUT; msg: int; player: PlayerPCM; param1, param2: int); stdcall;
    begin
        player.callback(waveOut, msg, param1, param2);
    end;
{%endregion}

{%region Player }
    class procedure Player.deallocateHWND(wnd: Windows.HWND);
    var
        inst: Pointer;
    begin
        inst := intToPointer(Windows.getWindowLong(wnd, Windows.GWL_WNDPROC));
        Windows.destroyWindow(wnd);
        if inst <> @Windows.defWindowProc then begin
            Classes.freeObjectInstance(inst);
        end;
    end;

    class function Player.allocateHWND(const wndProc: Classes.TWndMethod): Windows.HWND;
    var
        utilWindowClass: Windows.TWNDCLASS;
        tempWindowClass: Windows.TWNDCLASS;
        hinst: Windows.HANDLE;
        registered: boolean;
    begin
        hinst := Windows.HANDLE(System.hInstance());
        with utilWindowClass do begin
            style := 0;
            lpfnWndProc := Windows.defWindowProc;
            cbClsExtra := 0;
            cbWndExtra := 0;
            hInstance := hinst;
            hIcon := 0;
            hCursor := 0;
            hbrBackground := 0;
            lpszMenuName := nil;
            lpszClassName := 'Player';
        end;
        initialize(tempWindowClass);
        fillChar(tempWindowClass, sizeof(Windows.TWNDCLASS), 0);
        registered := Windows.getClassInfo(hinst, utilWindowClass.lpszClassName, tempWindowClass);
        if (not registered) or (@tempWindowClass.lpfnWndProc <> @Windows.defWindowProc) then begin
            if registered then begin
                Windows.unregisterClass(utilWindowClass.lpszClassName, hinst);
            end;
            Windows.registerClass(utilWindowClass);
        end;
        result := Windows.createWindowEx(Windows.WS_EX_TOOLWINDOW, utilWindowClass.lpszClassName, '', Windows.WS_POPUP, 0, 0, 0, 0, 0, 0, hinst, nil);
        if @wndProc <> nil then begin
            Windows.setWindowLong(result, Windows.GWL_WNDPROC, pointerToInt(Classes.makeObjectInstance(wndProc)));
        end;
    end;

    constructor Player.create();
    begin
        inherited create();
        self.wndHandle := allocateHWND(wndProc);
        self.invalidData := false;
        self.noDevices := false;
        self.state := FREED;
        self.volume := MAX_VOLUME;
    end;

    destructor Player.destroy;
    begin
        deallocateHWND(wndHandle);
        inherited destroy;
    end;

    procedure Player.sendMessage(message: int);
    begin
    end;

    procedure Player.wndProc(var theMessage: LMessages.TLMessage);
    begin
        if (int(theMessage.msg) = PM_BLOCK_END) and (int(theMessage.wParam) = int(MMSystem.WOM_DONE)) and (state = STARTED) then begin
            endCurrentBlockPlaying();
        end;
    end;

    procedure Player.notifyEndCurrentBlockPlaying();
    begin
        Windows.postMessage(wndHandle, PM_BLOCK_END, MMSystem.WOM_DONE, 0);
    end;

    function Player.getWindowHandle(): Windows.HWND;
    begin
        result := wndHandle;
    end;

    function Player.isInvalidData(): boolean;
    begin
        result := invalidData;
    end;

    function Player.isNoDevices(): boolean;
    begin
        result := noDevices;
    end;

    function Player.getState(): int;
    begin
        result := state;
    end;

    function Player.getVolume(): int;
    begin
        result := volume;
    end;

    function Player.getCurrentBlockIndex(): int;
    begin
        result := 0;
    end;

    function Player.setVolume(volume: int): int;
    begin
        result := min(max(MUTE_VOLUME, volume), MAX_VOLUME);
        self.volume := result;
    end;
{%endregion}

{%region PlayerPCM }
    class procedure PlayerPCM.changeAmplitude(const src: shortMMX; var dst: shortMMX; multiplier: int); assembler; nostackframe;
    asm
                mov     eax, [esp+$04] { eax := multiplier }
                lea     esp, [esp-$08]
                mov     word [esp+$00], ax
                mov     word [esp+$02], ax
                mov     word [esp+$04], ax
                mov     word [esp+$06], ax
                movq    mm0, [edx+$00] { mm0 := src }
                paddsw  mm0, mm0
                movq    mm1, mm0
                pmulhw  mm0, [esp+$00]
                pmullw  mm1, [esp+$00]
                psllw   mm0, $01
                psrlw   mm1, $0f
                por     mm0, mm1
                movq    qword[ecx+$00], mm0 { dst := mm0 }
                lea     esp, [esp+$08]
    end;

    class function PlayerPCM.power(base, exp: real): real;
    begin
        if cmpgReal(base, 0.0) > 0 then begin
            result := pow2(exp * log2(base));
            exit;
        end;
        result := 0.0;
    end;

    constructor PlayerPCM.create(samplesPerSecond, bitsPerSample, channelsCount, blockLength: int; listener: PlayerPCMListener);
    var
        f1: boolean;
        f2: boolean;
        i: int;
        p: long_Array2d;
        s: long_Array2d;
        l: int_Array1d;
    begin
        inherited create();
        i := int(MMSystem.waveOutGetNumDevs());
        f1 := (listener = nil) or
            (
                (samplesPerSecond <>  8000) and
                (samplesPerSecond <> 16000) and
                (samplesPerSecond <> 48000) and
                (samplesPerSecond <> 11025) and
                (samplesPerSecond <> 22050) and
                (samplesPerSecond <> 44100)
            ) or (
                (bitsPerSample <> 16)
            ) or (
                (channelsCount < 1) or
                (channelsCount > 2)
            ) or (
                (blockLength < MIN_BLOCK_LENGTH) or
                (blockLength > MAX_BLOCK_LENGTH)
            )
        ;
        f2 := i = 0;
        if f1 or f2 then begin
            self.invalidData := f1;
            self.noDevices := f2;
            exit;
        end;
        i := (bitsPerSample * channelsCount) shr 3;
        p := long_Array2d_create(BLOCKS_COUNT);
        s := long_Array2d_create(BLOCKS_COUNT);
        l := int_Array1d_create(BLOCKS_COUNT);
        self.waveOut := 0;
        self.waveOutCallResult := 0;
        with self.waveFormat do begin
            wFormatTag := WORD(MMSystem.WAVE_FORMAT_PCM);
            nChannels := WORD(channelsCount);
            nSamplesPerSec := DWORD(samplesPerSecond);
            nAvgBytesPerSec := DWORD(samplesPerSecond * i);
            nBlockAlign := WORD(i);
            wBitsPerSample := WORD(bitsPerSample);
            cbSize := WORD(0);
        end;
        with self.waveHeader do begin
            lpData := PChar(nil);
            dwBufferLength := DWORD(0);
            dwBytesRecorded := DWORD(0);
            dwUser := DWORD_PTR(0);
            dwFlags := DWORD(0);
            dwLoops := DWORD(0);
            lpNext := PWAVEHDR(nil);
            reserved := DWORD_PTR(0);
        end;
        self.changing := false;
        self.sampleAlign := i;
        self.currentBlockIndex := 0;
        self.currentBlockPosition := 0;
        self.dataPlayingIndex := 0;
        self.dataPlaying := p;
        self.dataSource := s;
        self.dataLength := l;
        self.listener := listener;
        for i := 0 to BLOCKS_COUNT - 1 do begin
            p[i] := long_Array1d_create(blockLength);
            s[i] := long_Array1d_create(blockLength);
            l[i] := 0;
        end;
        self.waveOutCallResult := MMSystem.waveOutOpen(@self.waveOut, MMSystem.WAVE_MAPPER, @self.waveFormat, pointerToInt(@PlayerPCM_callback), pointerToInt(self), MMSystem.CALLBACK_FUNCTION);
    end;

    destructor PlayerPCM.destroy;
    var
        waveOut: MMSystem.HWAVEOUT;
    begin
        waveOut := self.waveOut;
        if waveOut <> 0 then begin
            if state = STARTED then begin
                resetBlock();
            end;
            MMSystem.waveOutClose(waveOut);
        end;
        inherited destroy;
    end;

    procedure PlayerPCM.startBlock();
    var
        waveOut: MMSystem.HWAVEOUT;
        waveHeader: MMSystem.PWAVEHDR;
        i: int;
        p: int;
    begin
        waveOut := self.waveOut;
        waveHeader := @self.waveHeader;
        i := self.dataPlayingIndex;
        p := self.currentBlockPosition;
        waveHeader.lpData := PChar(@(dataPlaying[i][p]));
        waveHeader.dwBufferLength := DWORD((dataLength[i] - p) shl 3);
        waveOutCallResult := MMSystem.waveOutPrepareHeader(waveOut, waveHeader, sizeof(MMSystem.WAVEHDR));
        waveOutCallResult := MMSystem.waveOutWrite(waveOut, waveHeader, sizeof(MMSystem.WAVEHDR));
    end;

    procedure PlayerPCM.stopBlock();
    var
        waveOut: MMSystem.HWAVEOUT;
        time: MMSystem.MMTIME;
    begin
        waveOut := self.waveOut;
        time.wType := UINT(MMSystem.TIME_SAMPLES);
        time.sample := DWORD(0);
        changing := true;
        waveOutCallResult := MMSystem.waveOutGetPosition(waveOut, @time, sizeof(MMSystem.MMTIME));
        waveOutCallResult := MMSystem.waveOutReset(waveOut);
        waveOutCallResult := MMSystem.waveOutUnprepareHeader(waveOut, @waveHeader, sizeof(MMSystem.WAVEHDR));
        changing := false;
        inc(currentBlockPosition, (int(time.sample) * sampleAlign) div 8);
    end;

    procedure PlayerPCM.resetBlock();
    var
        waveOut: MMSystem.HWAVEOUT;
    begin
        waveOut := self.waveOut;
        changing := true;
        waveOutCallResult := MMSystem.waveOutReset(waveOut);
        waveOutCallResult := MMSystem.waveOutUnprepareHeader(waveOut, @waveHeader, sizeof(MMSystem.WAVEHDR));
        changing := false;
        currentBlockPosition := 0;
    end;

    procedure PlayerPCM.applyVolume();
    var
        i: int;
    begin
        for i := 0 to BLOCKS_COUNT - 1 do begin
            applyVolume(i);
        end;
    end;

    procedure PlayerPCM.applyVolume(dataIndex: int);
    var
        i: int;
        mul: int;
        len: int;
        src: long_Array1d;
        dst: long_Array1d;
    begin
        mul := int(round(128.0 * 255.0 * power(toReal(volume shl 1) / 255.0, EXPONENT)));
        len := dataLength[dataIndex];
        src := dataSource[dataIndex];
        dst := dataPlaying[dataIndex];
        try
            for i := 0 to len - 1 do begin
                changeAmplitude(shortMMX(src[i]), shortMMX(dst[i]), mul);
            end;
        finally
            returnToFPU();
        end;
    end;

    function PlayerPCM.correctLength(length: int): int;
    var
        maxlen: int;
    begin
        maxlen := System.length(dataPlaying[0]);
        if length < 0 then begin
            length := 0;
        end;
        if length > maxlen then begin
            length := maxlen;
        end;
        result := length;
    end;

    procedure PlayerPCM.callback(waveOut: MMSystem.HWAVEOUT; msg, param1, param2: int);
    begin
        if (not changing) and (msg = MMSystem.WOM_DONE) then begin
            notifyEndCurrentBlockPlaying();
        end;
    end;

    procedure PlayerPCM.endCurrentBlockPlaying();
    var
        i: int;
        block: int;
        dataLength: int_Array1d;
    begin
        i := self.dataPlayingIndex;
        block := self.currentBlockIndex;
        dataLength := self.dataLength;
        dataLength[i] := 0;
        i := (i + 1) mod BLOCKS_COUNT;
        dataPlayingIndex := i;
        currentBlockIndex := block + 1;
        resetBlock();
        if dataLength[i] > 0 then begin
            startBlock();
            listener.loadPCMBlock(self, block + 2);
            exit;
        end;
        currentBlockIndex := 0;
        state := FREED;
        listener.loadPCMBlock(self, -1);
    end;

    function PlayerPCM.start(): int;
    var
        state: int;
    begin
        state := self.state;
        if state = STOPPED then begin
            startBlock();
            self.state := STARTED;
            result := STARTED;
            exit;
        end;
        result := state;
    end;

    function PlayerPCM.stop(): int;
    var
        state: int;
    begin
        state := self.state;
        if state = STARTED then begin
            stopBlock();
            self.state := STOPPED;
            result := STOPPED;
            exit;
        end;
        result := state;
    end;

    function PlayerPCM.reset(): int;
    var
        i: int;
        dataLength: int_Array1d;
    begin
        case state of
        STARTED: begin
            resetBlock();
        end;
        STOPPED: begin
            currentBlockPosition := 0;
        end;
        else
            result := FREED;
            exit;
        end;
        dataLength := self.dataLength;
        currentBlockIndex := 0;
        dataPlayingIndex := 0;
        for i := 0 to BLOCKS_COUNT - 1 do begin
            dataLength[i] := 0;
        end;
        state := FREED;
        result := FREED;
    end;

    function PlayerPCM.getCurrentBlockIndex(): int;
    begin
        result := currentBlockIndex;
    end;

    function PlayerPCM.getCurrentBlockPosition(): int;
    var
        time: MMSystem.MMTIME;
    begin
        case state of
        STARTED: begin
            time.wType := UINT(MMSystem.TIME_SAMPLES);
            time.sample := DWORD(0);
            waveOutCallResult := MMSystem.waveOutGetPosition(waveOut, @time, sizeof(MMSystem.MMTIME));
            result := currentBlockPosition + ((int(time.sample) * sampleAlign) div 8);
        end;
        STOPPED: begin
            result := currentBlockPosition;
        end;
        else
            result := 0;
        end;
    end;

    function PlayerPCM.setCurrentBlockPosition(position: int): int;
    begin
        case state of
        STARTED: begin
            stopBlock();
            result := min(max(0, position), dataLength[dataPlayingIndex]);
            currentBlockPosition := result;
            startBlock();
        end;
        STOPPED: begin
            result := min(max(0, position), dataLength[dataPlayingIndex]);
            currentBlockPosition := result;
        end;
        else
            result := 0;
        end;
    end;

    function PlayerPCM.setVolume(volume: int): int;
    var
        oldVolume: int;
        newVolume: int;
    begin
        oldVolume := self.volume;
        newVolume := min(max(MUTE_VOLUME, volume), MAX_VOLUME);
        if abs(oldVolume - newVolume) < 8 then begin
            result := oldVolume;
            exit;
        end;
        self.volume := newVolume;
        case state of
        STARTED: begin
            stopBlock();
            applyVolume();
            startBlock();
        end;
        STOPPED: begin
            applyVolume();
        end;
        end;
        result := newVolume;
    end;

    function PlayerPCM.loadBlock(const src: long_Array1d; offset, length: int): int;
    var
        lim: int;
        len: int;
        i: int;
    begin
        lim := offset + length;
        len := System.length(src);
        if (lim > len) or (lim < offset) or (offset < 0) or (offset > len) then begin
            raise ArrayIndexOutOfBoundsException.create('PlayerPCM.loadBlock: индекс выходит из диапазона.');
        end;
        case state of
        FREED: begin
            result := correctLength(length);
            i := dataPlayingIndex;
            arraycopy(src, offset, dataSource[i], 0, result);
            dataLength[i] := result;
            applyVolume(i);
            startBlock();
            state := STARTED;
            listener.loadPCMBlock(self, currentBlockIndex + 1);
        end;
        STARTED, STOPPED: begin
            result := correctLength(length);
            i := (dataPlayingIndex + 1) mod BLOCKS_COUNT;
            arraycopy(src, offset, dataSource[i], 0, result);
            dataLength[i] := result;
            applyVolume(i);
        end;
        else
            result := 0;
        end;
    end;
{%endregion}

{%region PlayerMIDI }
    class function PlayerMIDI.shortMsg(playerFormattedMessage: int): DWORD; assembler; nostackframe;
    asm
                lea     eax, [edx+$00] { eax := playerFormattedMessage }
                bswap   eax
                shr     eax, $08 { result := eax >>> 8 }
    end;

    constructor PlayerMIDI.create(listener: PlayerMIDIListener);
    var
        f1: boolean;
        f2: boolean;
        i: int;
    begin
        inherited create();
        i := int(MMSystem.midiOutGetNumDevs());
        f1 := listener = nil;
        f2 := i = 0;
        if f1 or f2 then begin
            self.invalidData := f1;
            self.noDevices := f2;
            exit;
        end;
        self.midiOutCallResult := 0;
        self.terminated := false;
        self.currentBlockPosition := 0;
        self.queueTail := 0;
        self.queueHead := 0;
        self.queueEvents := long_Array1d_create(129);
        self.dataPlaying := nil;
        self.listener := listener;
        startThread(self, 'MIDI-проигрыватель');
    end;

    destructor PlayerMIDI.destroy;
    begin
        setEvent(TERMINATE, 0);
        while not terminated do begin
            Windows.sleep(1);
        end;
        inherited destroy;
    end;

    procedure PlayerMIDI.setEvent(event, parameter: int);
    var
        h: int;
        q: long_Array1d;
        len: int;
        newh: int;
    begin
        h := self.queueHead;
        q := self.queueEvents;
        len := length(q);
        newh := (h + 1) mod len;
        if newh <> queueTail then begin
            q[h] := buildLong(event, parameter);
            self.queueHead := newh;
        end;
    end;

    procedure PlayerMIDI.waitEvent(milliseconds: long);
    var
        t: int;
    begin
        t := self.queueTail;
        while (t = queueHead) and (milliseconds > getMilliseconds()) do begin
            Windows.sleep(1);
        end;
    end;

    procedure PlayerMIDI.allNotesOff();
    var
        midiOut: MMSystem.HMIDIOUT;
        i: int;
    begin
        midiOut := MIDI_OUT;
        for i := $0 to $f do begin
            midiOutCallResult := MMSystem.midiOutShortMsg(midiOut, shortMsg($00b07800 + (i shl 16)));
        end;
    end;

    procedure PlayerMIDI.endCurrentBlockPlaying();
    begin
        state := STOPPED;
        currentBlockPosition := 0;
        listener.endMIDITrack(self);
    end;

    procedure PlayerMIDI.sendMessage(message: int);
    begin
        setEvent(MIDI_MESSAGE, message);
    end;

    function PlayerMIDI.start(): int;
    var
        state: int;
    begin
        state := self.state;
        if state = STOPPED then begin
            setEvent(PLAYBACK_START, 0);
            self.state := STARTED;
            result := STARTED;
            exit;
        end;
        result := state;
    end;

    function PlayerMIDI.stop(): int;
    var
        state: int;
    begin
        state := self.state;
        if state = STARTED then begin
            setEvent(PLAYBACK_STOP, 0);
            self.state := STOPPED;
            result := STOPPED;
            exit;
        end;
        result := state;
    end;

    function PlayerMIDI.reset(): int;
    begin
        setEvent(PLAYBACK_RESET, 0);
        currentBlockPosition := 0;
        dataPlaying := nil;
        state := FREED;
        result := FREED;
    end;

    function PlayerMIDI.getCurrentBlockPosition(): int;
    begin
        result := currentBlockPosition;
    end;

    function PlayerMIDI.setCurrentBlockPosition(position: int): int;
    begin
        if state = FREED then begin
            result := 0;
            exit;
        end;
        result := min(max(0, position), length(dataPlaying));
        currentBlockPosition := result;
        setEvent(PLAYBACK_SET_POS, result);
    end;

    function PlayerMIDI.loadBlock(const src: long_Array1d; offset, length: int): int;
    var
        lim: int;
        len: int;
        data: long_Array1d;
    begin
        lim := offset + length;
        len := System.length(src);
        if (lim > len) or (lim < offset) or (offset < 0) or (offset > len) then begin
            raise ArrayIndexOutOfBoundsException.create('PlayerMIDI.loadBlock: индекс выходит из диапазона.');
        end;
        data := long_Array1d_create(length);
        arraycopy(src, offset, data, 0, length);
        currentBlockPosition := 0;
        dataPlaying := data;
        setEvent(LOAD_BLOCK, 0);
        state := STARTED;
        result := length;
    end;

    procedure PlayerMIDI.run();
    var
        { общие данные для проигрывания }
        useTime: boolean;
        milliseconds: long;
        midiPosition: int;
        midiEvents: long_Array1d;
        midiLength: int;
        midiState: int;
        midiVolumeMultiplier: real;
        midiOut: MMSystem.HMIDIOUT;
        { данные очереди событий }
        i: int;
        t: int;
        q: long_Array1d;
        len: int;
        element: long;
        parameter: int;
        maxVolume: int;
        noteVolume: int;
        millisRemaining: long;
        { промежуточные данные для проигрывания }
        playData: long;
        playTime: long;
        nextTime: long;
        message: int;
    begin
        { поля terminated, currentBlockPosition и queueTail должны изменяться этим методом }
        useTime := false;
        milliseconds := 0;
        midiPosition := 0;
        midiEvents := nil;
        midiLength := 0;
        midiState := FREED;
        midiVolumeMultiplier := 1.0 / MAX_VOLUME;
        midiOut := MIDI_OUT;
        t := self.queueTail;
        q := self.queueEvents;
        len := length(q);
        millisRemaining := 0;
        repeat
            { ожидание события или истечения времени }
            if useTime then begin
                waitEvent(milliseconds);
            end else begin
                waitEvent(MAX_LONG);
            end;
            { обработка события из очереди }
            if t <> self.queueHead then begin
                element := q[t];
                t := (t + 1) mod len;
                self.queueTail := t;
                parameter := int(element shr 32);
                case int(element) of
                TERMINATE: begin
                    allNotesOff();
                    break;
                end;
                MIDI_MESSAGE: begin
                    case (parameter shr 16) and $ff of
                    $80..$fe: begin
                        midiOutCallResult := MMSystem.midiOutShortMsg(midiOut, shortMsg(parameter));
                    end;
                    end;
                    continue;
                end;
                LOAD_BLOCK: begin
                    useTime := true;
                    milliseconds := getMilliseconds();
                    midiPosition := 0;
                    midiEvents := self.dataPlaying;
                    midiLength := length(midiEvents);
                    midiState := STARTED;
                    maxVolume := 1;
                    for i := 0 to midiLength - 1 do begin
                        message := int(midiEvents[i]) and $00ffffff;
                        case message shr 16 of
                        $90..$9f: begin
                            noteVolume := message and $7f;
                            if maxVolume < noteVolume then begin
                                maxVolume := noteVolume;
                            end;
                        end;
                        end;
                    end;
                    midiVolumeMultiplier := 1.0 / toReal(maxVolume);
                end;
                PLAYBACK_START: begin
                    { Начало кода, который появился из-за того, что нельзя размещать ещё один MMSystem.HMIDIOUT методом MMSystem.midiOutOpen (этот метод возвращает MMSystem.MMSYSERR_ALLOCATED в таком случае) }
                    parameter := midiPosition;
                    for i := 0 to parameter - 1 do begin
                        message := int(midiEvents[i]) and $00ffffff;
                        case message shr 16 of
                        $c0..$cf, $e0..$ef: begin
                            midiOutCallResult := MMSystem.midiOutShortMsg(midiOut, shortMsg(message));
                        end;
                        end;
                    end;
                    { Конец кода }
                    if midiState = STOPPED then begin
                        useTime := true;
                        milliseconds := getMilliseconds() + millisRemaining;
                        midiState := STARTED;
                    end;
                    continue;
                end;
                PLAYBACK_STOP: begin
                    if midiState = STARTED then begin
                        allNotesOff();
                        useTime := false;
                        millisRemaining := milliseconds - getMilliseconds();
                        midiState := STOPPED;
                    end;
                    continue;
                end;
                PLAYBACK_SET_POS: begin
                    parameter := min(parameter, midiLength);
                    midiPosition := max(parameter, 0);
                    millisRemaining := 0;
                    for i := 0 to parameter - 1 do begin
                        message := int(midiEvents[i]) and $00ffffff;
                        case message shr 16 of
                        $c0..$cf, $e0..$ef: begin
                            midiOutCallResult := MMSystem.midiOutShortMsg(midiOut, shortMsg(message));
                        end;
                        end;
                    end;
                    if midiState <> STARTED then begin
                        continue;
                    end;
                    allNotesOff();
                end;
                PLAYBACK_RESET: begin
                    if midiState <> FREED then begin
                        allNotesOff();
                        useTime := false;
                        midiPosition := 0;
                        midiEvents := nil;
                        midiLength := 0;
                        midiState := FREED;
                        millisRemaining := 0;
                    end;
                    continue;
                end;
                else
                    continue;
                end;
            end;
            { обработка MIDI-событий, наступающих в одно и то же время }
            self.currentBlockPosition := midiPosition;
            if midiPosition < midiLength then begin
                playData := midiEvents[midiPosition];
            end else begin
                playData := MIDI_MESSAGE_END_TRACK;
            end;
            playTime := (playData shr 24) and $000000ffffffffff;
            repeat
                message := int(playData) and $00ffffff;
                case message of
                $00800000..$008fffff, $00a00000..$00feffff: begin
                    midiOutCallResult := MMSystem.midiOutShortMsg(midiOut, shortMsg(message));
                end;
                $00900000..$009fffff: begin
                    message := (message and $00ffff00) or toInt(toReal((message and $7f) * self.volume) * midiVolumeMultiplier);
                    midiOutCallResult := MMSystem.midiOutShortMsg(midiOut, shortMsg(message));
                end;
                MIDI_MESSAGE_END_TRACK: begin
                    allNotesOff();
                    useTime := false;
                    midiPosition := 0;
                    midiState := STOPPED;
                    notifyEndCurrentBlockPlaying();
                    break;
                end;
                end;
                inc(midiPosition);
                if midiPosition < midiLength then begin
                    playData := midiEvents[midiPosition];
                end else begin
                    playData := (playTime shl 24) or long(MIDI_MESSAGE_END_TRACK);
                end;
                nextTime := (playData shr 24) and $000000ffffffffff;
                if playTime < nextTime then begin
                    inc(milliseconds, nextTime - playTime);
                    break;
                end;
            until false;
        until false;
        self.terminated := true;
    end;
{%endregion}

initialization {%region}
    MMSystem.midiOutOpen(@PlayerMIDI.MIDI_OUT, MMSystem.MIDI_MAPPER, 0, 0, MMSystem.CALLBACK_NULL);
{%endregion}

finalization {%region}
    MMSystem.midiOutClose(PlayerMIDI.MIDI_OUT);
{%endregion}

end.

