{
Players содержит классы для проигрывания звука в формате импульсно-кодовой
модуляции (ИКМ, PCM) и MIDI.
Copyright © 2016, 2019, 2022–2023 Малик Разработчик
Это свободная программа: вы можете перераспространять её и/или
изменять её на условиях Меньшей Стандартной общественной лицензии 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.
