290 lines
8.3 KiB
ObjectPascal
290 lines
8.3 KiB
ObjectPascal
|
{
|
||
|
|
BASS simple synth
|
||
|
|
Copyright (c) 2001-2008 Un4seen Developments Ltd.
|
||
|
|
|
||
|
|
C++ to Delphi with use API adapted by Evgeny Melnikov
|
||
|
|
Required Delphi 5 or above
|
||
|
|
|
||
|
|
http://dsoft1961.narod.ru
|
||
|
|
mail angvelem@gmail.com
|
||
|
|
}
|
||
|
|
|
||
|
|
program synth;
|
||
|
|
|
||
|
|
{$APPTYPE CONSOLE}
|
||
|
|
|
||
|
|
uses
|
||
|
|
Windows, Bass in '../bass.pas';
|
||
|
|
|
||
|
|
const
|
||
|
|
PI = 3.14159265358979323846;
|
||
|
|
TABLESIZE = 2048;
|
||
|
|
KEYS = 20;
|
||
|
|
MAXVOL = 4000; // higher value = longer fadeout
|
||
|
|
akey : array[0..KEYS - 1] of Word = (
|
||
|
|
ord('Q'), ord('2'), ord('W'), ord('3'), ord('E'),
|
||
|
|
ord('R'), ord('5'), ord('T'), ord('6'), ord('Y'),
|
||
|
|
ord('7'), ord('U'), ord('I'), ord('9'), ord('O'),
|
||
|
|
ord('0'), ord('P'), 219, 187, 221);
|
||
|
|
|
||
|
|
var
|
||
|
|
info : BASS_INFO;
|
||
|
|
SineTable : array[0..TABLESIZE - 1] of Integer; // sine table
|
||
|
|
aVol : array[0..KEYS - 1] of Integer = ( // keys' volume & pos
|
||
|
|
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
|
||
|
|
aPos : array[0..KEYS - 1] of Integer = (
|
||
|
|
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
|
||
|
|
|
||
|
|
//------------------ Auxiliary functions -------------------
|
||
|
|
|
||
|
|
function Format(const Format : String; const Args : array of const ) : String;
|
||
|
|
var
|
||
|
|
I : Integer;
|
||
|
|
FormatBuffer : array[0..High(Word)] of Char;
|
||
|
|
Arr, Arr1 : PDWORD;
|
||
|
|
PP : PDWORD;
|
||
|
|
begin
|
||
|
|
Arr := NIL;
|
||
|
|
if High(Args) >= 0 then
|
||
|
|
GetMem(Arr, (High(Args) + 1) * SizeOf(Pointer));
|
||
|
|
Arr1 := Arr;
|
||
|
|
for I := 0 to High(Args) do
|
||
|
|
begin
|
||
|
|
PP := @Args[I];
|
||
|
|
PP := Pointer(PP^);
|
||
|
|
Arr1^ := DWORD(PP);
|
||
|
|
inc(Arr1);
|
||
|
|
end;
|
||
|
|
I := wvsprintf(@FormatBuffer[0], PChar(Format), PChar(Arr));
|
||
|
|
SetLength(Result, I);
|
||
|
|
Result := FormatBuffer;
|
||
|
|
if Arr <> NIL then
|
||
|
|
FreeMem(Arr);
|
||
|
|
end;
|
||
|
|
|
||
|
|
//---------------------------------------------------------
|
||
|
|
|
||
|
|
function IntPower(const Base : Extended; const Exponent : Integer) : Extended;
|
||
|
|
asm
|
||
|
|
mov ecx, eax
|
||
|
|
cdq
|
||
|
|
fld1 { Result := 1 }
|
||
|
|
xor eax, edx
|
||
|
|
sub eax, edx { eax := Abs(Exponent) }
|
||
|
|
jz @@3
|
||
|
|
fld Base
|
||
|
|
jmp @@2
|
||
|
|
@@1: fmul ST, ST { X := Base * Base }
|
||
|
|
@@2: shr eax,1
|
||
|
|
jnc @@1
|
||
|
|
fmul ST(1),ST { Result := Result * X }
|
||
|
|
jnz @@1
|
||
|
|
fstp st { pop X from FPU stack }
|
||
|
|
cmp ecx, 0
|
||
|
|
jge @@3
|
||
|
|
fld1
|
||
|
|
fdivrp { Result := 1 / Result }
|
||
|
|
@@3:
|
||
|
|
fwait
|
||
|
|
end;
|
||
|
|
|
||
|
|
//---------------------------------------------------------
|
||
|
|
|
||
|
|
function Power(const Base, Exponent : Extended) : Extended;
|
||
|
|
begin
|
||
|
|
if Exponent = 0.0 then
|
||
|
|
Result := 1.0 { n**0 = 1 }
|
||
|
|
else if (Base = 0.0) and (Exponent > 0.0) then
|
||
|
|
Result := 0.0 { 0**n = 0, n > 0 }
|
||
|
|
else if (Frac(Exponent) = 0.0) and (Abs(Exponent) <= MaxInt) then
|
||
|
|
Result := IntPower(Base, Integer(Trunc(Exponent)))
|
||
|
|
else
|
||
|
|
Result := Exp(Exponent * Ln(Base))
|
||
|
|
end;
|
||
|
|
|
||
|
|
//==========================================================
|
||
|
|
//==========================================================
|
||
|
|
|
||
|
|
// display error messages
|
||
|
|
procedure Error(Text : String);
|
||
|
|
begin
|
||
|
|
WriteLn(Format('Error(%d): %s', [BASS_ErrorGetCode, Text]));
|
||
|
|
BASS_Free;
|
||
|
|
ExitProcess(0);
|
||
|
|
end;
|
||
|
|
|
||
|
|
//---------------------------------------------------------
|
||
|
|
|
||
|
|
// stream writer
|
||
|
|
function WriteStream(Handle : HSTREAM; Buffer : Pointer; Len : DWORD; User : Pointer) : DWORD; stdcall;
|
||
|
|
type
|
||
|
|
BufArray = array[0..0] of SmallInt;
|
||
|
|
var
|
||
|
|
I, J, K : Integer;
|
||
|
|
f : Single;
|
||
|
|
Buf : ^BufArray absolute Buffer;
|
||
|
|
begin
|
||
|
|
FillChar(Buffer^, Len, 0);
|
||
|
|
for I := 0 to KEYS - 1 do
|
||
|
|
begin
|
||
|
|
if aVol[I] = 0 then
|
||
|
|
Continue;
|
||
|
|
f := Power(2.0, (I + 3) / 12.0) * TABLESIZE * 440.0 / info.freq;
|
||
|
|
for K := 0 to (Len div 4 - 1) do
|
||
|
|
begin
|
||
|
|
if aVol[I] = 0 then
|
||
|
|
Continue;
|
||
|
|
inc(aPos[I]);
|
||
|
|
J := Round(SineTable[Round(aPos[I] * f) and pred(TABLESIZE)] * aVol[I] / MAXVOL);
|
||
|
|
inc(J, Buf[K * 2]);
|
||
|
|
if J > 32767 then
|
||
|
|
J := 32767
|
||
|
|
else if J < -32768 then
|
||
|
|
J := -32768;
|
||
|
|
// left and right channels are the same
|
||
|
|
Buf[K * 2 + 1] := J;
|
||
|
|
Buf[K * 2] := J;
|
||
|
|
if aVol[I] < MAXVOL then
|
||
|
|
dec(aVol[I]);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
Result := Len;
|
||
|
|
end;
|
||
|
|
|
||
|
|
//---------------------------------------------------------
|
||
|
|
|
||
|
|
var
|
||
|
|
Stream : HSTREAM;
|
||
|
|
KeyIn : INPUT_RECORD;
|
||
|
|
bKey : Integer;
|
||
|
|
I, BufLen : DWORD;
|
||
|
|
J : HFX;
|
||
|
|
St : String;
|
||
|
|
fx : array[0..8] of HFX = (0, 0, 0, 0, 0, 0, 0, 0, 0); // effect handles
|
||
|
|
|
||
|
|
const
|
||
|
|
fxname : array[0..8] of String = (
|
||
|
|
'CHORUS', 'COMPRESSOR', 'DISTORTION',
|
||
|
|
'ECHO', 'FLANGER', 'GARGLE',
|
||
|
|
'I3DL2REVERB','PARAMEQ', 'REVERB');
|
||
|
|
|
||
|
|
begin
|
||
|
|
WriteLn('BASS Simple Sinewave Synth');
|
||
|
|
WriteLn('--------------------------');
|
||
|
|
|
||
|
|
// check the correct BASS was loaded
|
||
|
|
if HIWORD(BASS_GetVersion) <> BASSVERSION then
|
||
|
|
begin
|
||
|
|
WriteLn('An incorrect version of BASS.DLL was loaded');
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// 10ms update period
|
||
|
|
BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10);
|
||
|
|
|
||
|
|
// setup output - get latency
|
||
|
|
if not BASS_Init(-1, 44100, BASS_DEVICE_LATENCY, 0, NIL) then
|
||
|
|
Error('Can''t initialize device');
|
||
|
|
|
||
|
|
// build sine table
|
||
|
|
for I := 0 to TABLESIZE - 1 do
|
||
|
|
SineTable[I] := Round((sin(2.0 * PI * I / TABLESIZE) * 7000.0));
|
||
|
|
|
||
|
|
BASS_GetInfo(info);
|
||
|
|
// default buffer size = update period + 'minbuf'
|
||
|
|
BASS_SetConfig(BASS_CONFIG_BUFFER, 10 + info.minbuf);
|
||
|
|
BufLen := BASS_GetConfig(BASS_CONFIG_BUFFER);
|
||
|
|
// if the device's output rate is unknown default to 44100 Hz
|
||
|
|
if info.freq = 0 then info.freq := 44100;
|
||
|
|
// create a stream, stereo so that effects sound nice
|
||
|
|
Stream := BASS_StreamCreate(info.freq, 2, 0, @WriteStream, NIL);
|
||
|
|
|
||
|
|
WriteLn(Format('device latency: %dms', [info.latency]));
|
||
|
|
WriteLn(Format('device minbuf: %dms', [info.minbuf]));
|
||
|
|
if info.dsver < 8 then
|
||
|
|
St := 'disabled'
|
||
|
|
else
|
||
|
|
St := 'enabled';
|
||
|
|
WriteLn(Format('ds version: %d (effects %s)', [info.dsver, St]));
|
||
|
|
WriteLn('press these keys to play:'#13#10);
|
||
|
|
WriteLn(' 2 3 5 6 7 9 0 =');
|
||
|
|
WriteLn(' Q W ER T Y UI O P[ ]'#13#10);
|
||
|
|
WriteLn('press -/+ to de/increase the buffer');
|
||
|
|
WriteLn('press spacebar to quit'#13#10);
|
||
|
|
if info.dsver >= 8 then // DX8 effects available
|
||
|
|
WriteLn('press F1-F9 to toggle effects'#13#10);
|
||
|
|
Write(Format('using a %dms buffer'#13, [BufLen]));
|
||
|
|
|
||
|
|
BASS_ChannelPlay(Stream, False);
|
||
|
|
|
||
|
|
while (ReadConsoleInput(GetStdHandle(STD_INPUT_HANDLE), KeyIn, 1, I)) do
|
||
|
|
begin
|
||
|
|
if KeyIn.EventType <> KEY_EVENT then
|
||
|
|
Continue;
|
||
|
|
|
||
|
|
if KeyIn.Event.KeyEvent.wVirtualKeyCode = VK_SPACE then
|
||
|
|
Break;
|
||
|
|
|
||
|
|
if KeyIn.Event.KeyEvent.bKeyDown then
|
||
|
|
begin
|
||
|
|
case KeyIn.Event.KeyEvent.wVirtualKeyCode of
|
||
|
|
VK_SUBTRACT,
|
||
|
|
VK_ADD :
|
||
|
|
begin
|
||
|
|
// recreate stream with smaller/larger buffer
|
||
|
|
BASS_StreamFree(Stream);
|
||
|
|
if KeyIn.Event.KeyEvent.wVirtualKeyCode = VK_SUBTRACT then
|
||
|
|
// smaller buffer
|
||
|
|
BASS_SetConfig(BASS_CONFIG_BUFFER, BufLen - 1)
|
||
|
|
else
|
||
|
|
// larger buffer
|
||
|
|
BASS_SetConfig(BASS_CONFIG_BUFFER, BufLen + 1);
|
||
|
|
BufLen := BASS_GetConfig(BASS_CONFIG_BUFFER);
|
||
|
|
Write(Format('using a %dms buffer'#9#9#13, [BufLen]));
|
||
|
|
Stream := BASS_StreamCreate(info.freq, 2, 0, @WriteStream, NIL);
|
||
|
|
// set effects on the new stream
|
||
|
|
for I := 0 to 8 do
|
||
|
|
if fx[I] > 0 then
|
||
|
|
fx[I] := BASS_ChannelSetFX(Stream, BASS_FX_DX8_CHORUS + I, 0);
|
||
|
|
BASS_ChannelPlay(Stream, False);
|
||
|
|
end;
|
||
|
|
|
||
|
|
VK_F1..VK_F9 :
|
||
|
|
begin
|
||
|
|
I := KeyIn.Event.KeyEvent.wVirtualKeyCode - VK_F1;
|
||
|
|
if fx[I] > 0 then
|
||
|
|
begin
|
||
|
|
BASS_ChannelRemoveFX(Stream, fx[I]);
|
||
|
|
fx[I] := 0;
|
||
|
|
Write(Format('effect %s = OFF'#9#9#13, [fxname[I]]));
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
// set the effect, not bothering with parameters (use defaults)
|
||
|
|
J := BASS_ChannelSetFX(Stream, BASS_FX_DX8_CHORUS + I, 0);
|
||
|
|
if J > 0 then
|
||
|
|
begin
|
||
|
|
fx[I] := J;
|
||
|
|
Write(Format('effect %s = ON'#9#9#13, [fxname[I]]));
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
for bKey := 0 to KEYS - 1 do
|
||
|
|
if KeyIn.Event.KeyEvent.wVirtualKeyCode = aKey[bKey] then
|
||
|
|
begin
|
||
|
|
if KeyIn.Event.KeyEvent.bKeyDown and (aVol[bKey] <> MAXVOL) then
|
||
|
|
begin
|
||
|
|
aPos[bKey] := 0;
|
||
|
|
aVol[bKey] := MAXVOL; // start key
|
||
|
|
end
|
||
|
|
else if not KeyIn.Event.KeyEvent.bKeyDown and (aVol[bKey] > 0) then
|
||
|
|
dec(aVol[bKey]); // trigger key fadeout
|
||
|
|
// Break;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
BASS_Free;
|
||
|
|
end.
|