Author Topic: BASS and Lazarus  (Read 70 times)

USERPC01

  • Posts: 26
BASS and Lazarus
« on: 10 Aug '18 - 19:54 »
How to use BASS and Lazarus (Free pascal compiler) (for Windows and Linux (Knoppix) ) for creating sound generator , output user defined  samples   ?  How to set bitrate , how to create  callback for procedure    for every sample  for obtaining value of n-th sample   ?
How to fix type mismatch for  inc(J, Buf[K*2] ) in the function WriteStream(Handle : HSTREAM; Buffer : Pointer; Len : DWORD; User : Pointer) : DWORD; stdcall;
for synth.lpr
Code: [Select]
{
    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, Math, 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);
 
  type DWord = LongWord;
 
 
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;
 
//---------------------------------------------------------
 
 
 
//==========================================================
//==========================================================
 
// 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,J1 :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
begin   Continue;   end;
 
      inc(aPos[I]);
      J := Round(SineTable[Round(aPos[I] * f) and pred(TABLESIZE)] * aVol[I] / MAXVOL);
      J1:=   Buf[K*2] ;
      inc(J,J1 );
      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.


USERPC01

  • Posts: 26
Re: BASS and Lazarus
« Reply #1 on: 10 Aug '18 - 19:58 »
How to use 
Code: [Select]
unit HiAsmUnit;
 
interface
uses kol,Share,Debug;
type
 THiAsmClass = class(TDebug)

   private
    _Freq,_Freq2,_Vol,_Vol2,_VolSN,_VolSN1,_VolSN2,_VolS,_VolS2,_VolN,_VolN1,_VolN2:single;
    _KHI, _KHI1, _KN  :single;
   THD_VAL,TSHD_VAL , UNOISE, _USH,_UH, _Us , _Us2 :single;
   _K1_1,_K1,_K2,_K3,_K4,_K5,_K6 ,_K7 :single;
    _Ks1,_Ks2,_Ks3,_Ks4,_Ks5,_Ks6 ,_Ks7 :single;
    THDSET,TSHDSET :single;
     SSNSET,SWNSET,SIGWN_VAL, SIGNS_VAL: real; 
    k:integer;
    knoise,ksignal,ksignal1,kharm,ksubharm :single;
    i,j ,stop,flagTHD,flagTSHD,flagTSSN,flagTSWN:integer;
       flagon   :integer                     
   public
 
    _data_Data:THI_Event;
    onSempl:THI_Event;
    onTSHD,onTHD , onS_WN, onS_NS,onERROR ,onSSNCONT_RUN, onSWNCONT_RUN :THI_Event;
    onVols2 ,onVolsn, onVolsn1, onVolsn2,onFreq1,onFreq2,onERROR1 :THI_Event;
    onTHD_GR_THDSET , onTHD_LO_THDSET, onTHD_EQ_THDSET  :THI_Event;
    onTSHD_GR_TSHDSET, onTSHD_LO_TSHDSET,onTSHD_EQ_TSHDSET  :THI_Event;
    onTHDCONT_RUN, onTSHDCONT_RUN  ,onChange ,onStop,onVols:THI_Event;
     onSSN_EQ_SSNSET,onSSN_GR_SSNSET,onSSN_LO_SSNSET :THI_Event;
      onSWN_EQ_SWNSET,onSWN_GR_SWNSET,onSWN_LO_SWNSET :THI_Event;
   
    procedure doStart(var _Data:TData; Index:word);
    procedure doFreq(var _Data:TData; Index:word);
    procedure doFreq2(var _Data:TData; Index:word);
    procedure doVol(var _Data:TData; Index:word);
    procedure doVol2(var _Data:TData; Index:word);
    procedure doVol_S_N(var _Data:TData; Index:word);
    procedure doVol_S_N1(var _Data:TData; Index:word);
    procedure doVol_S_N2(var _Data:TData; Index:word);
    procedure doTHDSET(var _Data:TData; Index:word);
    procedure doTSHDSET(var _Data:TData; Index:word);
    procedure doSSNSET(var _Data:TData; Index:word);
    procedure doSWNSET(var _Data:TData; Index:word);
    procedure doTHD(var _Data:TData; Index:word);
    procedure doTSHD(var _Data:TData; Index:word);
    procedure doS_NS(var _Data:TData; Index:word); 
    procedure doS_WN(var _Data:TData; Index:word);
    procedure doRECALC(var _Data:TData; Index:word);
    procedure doTHDCOMPARE(var _Data:TData; Index:word);
       
        procedure doStop(var _Data:TData; Index:word);
        procedure doOn(var _Data:TData; Index:word);
        procedure doCheckbox(var _Data:TData; Index:word);
    procedure doSempl(var _Data:TData; Index:word);
   
 end;
 
implementation
 
procedure THiAsmClass.doStart;  //start
 begin
  _Freq:=2*pi/44.1;
  _Freq2:=2*pi/44.1;
  k:=0;
  i:=0;
  _UH:=0;
  _USH:=0;
  _Us:=0;
   _Us2:=0;
   TSHD_VAL:=0;
   THD_VAL:=0;
   SIGWN_VAL:=0;
   SIGNS_VAL:=0;
  ksignal:=0.2*32767 ;
  ksignal1:=  0.2*32767 ;
  kharm:= 0.2*32767;
  ksubharm := 0.2*32767;
  knoise:= 0.2*32767;
  _VolSN:=0;
  _VolSN1:=0;
  _VolSN2:=0;
  _Vol:=0.5;
  _Vol2:=0;
  _VolS:=0.25*32767*_Vol;
    _VolS2:=0.25*32767*_Vol2;
  _VolN:=0.25*32767*_VolSN;
  _VolN1:=0.25*32767*_VolSN1;
  _VolN2:=0.25*32767*_VolSN2;
  _K1_1:=1;
  _K1:=1;
  _K2:=1;
  _K3:=1;
  _K4:=1;
  _K5:=1;
  _K6:=1;
  _K7:=1;
   _Ks1:=1;
  _Ks2:=1;
  _Ks3:=1;
  _Ks4:=1;
  _Ks5:=1;
  _Ks6:=1;
  _Ks7:=1;
  _KHI:=1;
  _KHI1:=1;
  _KN:=1;
  stop:=0;
   THDSET:=0 ;
   TSHDSET:=0;
   SSNSET:=0;
   SWNSET:=0;
   flagTHD:=0;
   flagTSHD:=0;
   flagTSSN:=0;
   flagTSWN:=0;
   
  randomize;
   
   _hi_onEvent(onERROR,0);   
 end;
 
    //*************************************
 
 
     // freq setting
procedure THiAsmClass.doFreq;   
 begin
  _Freq:=2*pi*ToInteger(_Data)/44100;
  _hi_onEvent(onFreq1 ,_Data);
   _hi_onEvent(onChange ,1);
 end;     
     // freq 2 setting
procedure THiAsmClass.doFreq2;   
 begin
  _Freq2:=2*pi*ToInteger(_Data)/44100;
   _hi_onEvent(onFreq2 ,_Data);
    _hi_onEvent(onChange ,1);
 end;
     // Volume 1 control
procedure THiAsmClass.doVol;
 begin
  _Vol:=ToInteger(_Data)/1000;
  _VolS:=ksignal*_Vol;
    _VolS2:=ksignal1*_Vol2;
  _VolN1:=kharm*_VolSN1;
  _VolN2:=ksubharm*_VolSN2;
  _VolN:=knoise*_VolSN;
  _hi_onEvent(onVols ,trunc(_Vol*1000)/10);
  _hi_onEvent(onChange ,1);     
 end;
 
      // Volume 2 control
procedure THiAsmClass.doVol2;
 begin
  _Vol2:=ToInteger(_Data)/1000;
  _VolS:=ksignal*_Vol;
  _VolS2:=ksignal1*_Vol2;
  _VolN1:=kharm*_VolSN1;
  _VolN2:=ksubharm*_VolSN2;
  _VolN:=knoise*_VolSN;
   _hi_onEvent(onVols2,trunc(_Vol2*1000)/10);
    _hi_onEvent(onChange ,1);
 end;
 
 
 
      //Noise signal Volume  control
procedure THiAsmClass.doVol_S_N;
 begin
  _VolSN:=ToInteger(_Data)/1000;
  _VolS:=ksignal*_Vol;
    _VolS2:=ksignal1*_Vol2;
  _VolN1:=kharm*_VolSN1;
  _VolN2:=ksubharm*_VolSN2;
  _VolN:=knoise*_VolSN;
   _hi_onEvent(onVolsn, trunc(_VolSN*1000)/10);
    _hi_onEvent(onChange ,1);
  end;
     //Noise signal Volume  control
procedure THiAsmClass.doVol_S_N1;
 begin
  _VolSN1:=ToInteger(_Data)/1000;
  _VolS:=ksignal*_Vol;
      _VolS2:=ksignal1*_Vol2;
  _VolN1:=kharm*_VolSN1;
  _VolN2:=ksubharm*_VolSN2;
  _VolN:=knoise*_VolSN;
     _hi_onEvent(onVolsn1, trunc(_VolSN1*1000)/10);
      _hi_onEvent(onChange ,1);
     
 end;
 
 
 
   //Noise signal Volume  control
procedure THiAsmClass.doVol_S_N2;
 begin
  _VolSN2:=ToInteger(_Data)/1000;
  _VolS:=ksignal*_Vol;
    _VolS2:=ksignal1*_Vol2;
  _VolN1:=kharm*_VolSN1;
  _VolN2:=ksubharm*_VolSN2;
   _VolN:=knoise*_VolSN;
   _hi_onEvent(onVolsn2, trunc(_VolSN2*1000)/10);
    _hi_onEvent(onChange ,1);
 end;
     //*************** THD setting
 procedure THiAsmClass.doTHDSET;
 begin
  THDSET:=ToReal(_Data);
  _hi_onEvent(onTHDCONT_RUN, 1);
   _hi_onEvent(onChange ,1); 
 end;
     //*************** TSHD setting
 procedure THiAsmClass.doTSHDSET;
 begin
  TSHDSET:=ToReal(_Data);
  _hi_onEvent(onTSHDCONT_RUN, 1);
   _hi_onEvent(onChange ,1);   
 end; 
 
      //*************** Signal/ Noise sin signal rate setting
 procedure THiAsmClass.doSSNSET;
 begin
  SSNSET:=ToReal(_Data);
  _hi_onEvent(onSSNCONT_RUN, 1);
   _hi_onEvent(onChange ,1);   
 end; 
 //      *************** Signal/ Chaotic(quasiwhite) Noise  signal rate setting
  procedure THiAsmClass.doSWNSET;
 begin
  SWNSET:=ToReal(_Data);
  _hi_onEvent(onSWNCONT_RUN, 1);
   _hi_onEvent(onChange ,1);   
 end;
 //**************
   procedure THiAsmClass.doTHD;
 begin
     if   ((_K1*_VolS)<>0) then
     begin
 _KHI:=1/sqrt((_K7*_K7)+(_K6*_K6)+(_K5*_K5)+(_K4*_K4)+(_K3*_K3)+(_K2*_K2));
THD_VAL:= Round(100*100*sqrt(sqr(_VolN1*_KHI)*((_K7*_K7)+(_K6*_K6)+(_K5*_K5)+(_K4*_K4)+(_K3*_K3)+(_K2*_K2)))/(_K1*_VolS)) div 100  ;
     end
    else  _hi_onEvent(onERROR,1)   ;
_hi_onEvent(onTHD,THD_VAL);
 
 end;
procedure THiAsmClass.doTSHD;
 
 begin
    if   ((_K1*_VolS)<>0) then
    begin
    _hi_onEvent(onERROR,0);
_KHI1:=1/sqrt((_Ks7*_Ks7)+(_Ks6*_Ks6)+(_Ks5*_Ks5)+(_Ks4*_Ks4)+(_Ks3*_Ks3)+(_Ks2*_Ks2));
TSHD_VAL:= Round(100*100*sqrt(sqr(_VolN2*_KHI1)*((_Ks7*_Ks7)+(_Ks6*_Ks6)+(_Ks5*_Ks5)+(_Ks4*_Ks4)+(_Ks3*_Ks3)+(_Ks2*_Ks2)))/(_K1*_VolS)) div 100   ;
   end
   else  _hi_onEvent(onERROR,1)   ;
_hi_onEvent(onTSHD,TSHD_VAL);
 
 
 end;
   

USERPC01

  • Posts: 26
Re: BASS and Lazarus
« Reply #2 on: 10 Aug '18 - 19:59 »
Code: [Select]
  //********
procedure THiAsmClass.doRECALC;
begin
  //********THD CALC
if (flagTHD=1) then 
 
   begin
     if   ((_K1*_VolS)<>0) then
     begin
    _KHI:=1/sqrt((_K7*_K7)+(_K6*_K6)+(_K5*_K5)+(_K4*_K4)+(_K3*_K3)+(_K2*_K2));
    THD_VAL:= (Round(100*100*sqrt(sqr(_VolN1*_KHI)*((_K7*_K7)+(_K6*_K6)+(_K5*_K5)+(_K4*_K4)+(_K3*_K3)+(_K2*_K2)))/(_K1*_VolS)) div 100)  ;
     end
               else  _hi_onEvent(onERROR,1)   ;
     _hi_onEvent(onTHD,THD_VAL);
     flagTHD:=0;
   end; 
      //********TSHD CALC
if (flagTSHD=1) then 
 
 begin
    if   ((_K1*_VolS)<>0) then
    begin
    _hi_onEvent(onERROR,0);
    _KHI1:=1/sqrt((_Ks7*_Ks7)+(_Ks6*_Ks6)+(_Ks5*_Ks5)+(_Ks4*_Ks4)+(_Ks3*_Ks3)+(_Ks2*_Ks2));
    TSHD_VAL:= (Round(100*100*sqrt(sqr(_VolN2*_KHI1)*((_Ks7*_Ks7)+(_Ks6*_Ks6)+(_Ks5*_Ks5)+(_Ks4*_Ks4)+(_Ks3*_Ks3)+(_Ks2*_Ks2)))/(_K1*_VolS)) div 100) ;
     end
     else  _hi_onEvent(onERROR,1)   ;
     _hi_onEvent(onTSHD,TSHD_VAL);
     flagTSHD:=0;
 end ;
      //************ S/SN recalc
if (flagTSSN=1) then 
 
 begin
 
       begin
       if   (_K1_1*_VolS2<>0) then
       begin
      _hi_onEvent(onERROR1,0); 
      SIGNS_VAL:= ( _K1*_VolS)/ (_K1_1*_VolS2);
       end
    else 
     begin
    _hi_onEvent(onERROR1,1);
     SIGNS_VAL:=9999;
     end;
     end;
 
   _hi_onEvent(onS_NS,SIGNS_VAL);
    flagTSSN:=0;
 end;
      //************ S/WN recalc                                                                                                             
 
if (flagTSWN=1) then 
 begin
    if   (_VolN*_KN<>0) then 
     begin
      _hi_onEvent(onERROR1,0);
      SIGWN_VAL:= ( _K1*_VolS)/ (_VolN*_KN);
      end
     
      else   
      begin
      _hi_onEvent(onERROR1,1)   ;
      SIGWN_VAL:=9999;
      end;
_hi_onEvent(onS_WN,SIGWN_VAL);
flagTSWN:=0;
 end;
   
//********
 end;
procedure THiAsmClass.doTHDCOMPARE;
 begin
flagon:=1;
       //*******THD PART
  flagTHD:=1 ;
if  (THD_VAL<>THDSET)then   else
 begin
  _hi_onEvent(onTHD_EQ_THDSET,1);
    //THD =THD nom
  _hi_onEvent(onTHD_LO_THDSET,0);
 _hi_onEvent(onTHD_GR_THDSET,0);
 
 end ;
if  (THD_VAL<THDSET)  then
 begin
 
 _hi_onEvent(onTHD_LO_THDSET,1);   //THD <THDset ,need to increment
 _hi_onEvent(onTHD_GR_THDSET,0);
  flagon:=0;
 end;
if  (THD_VAL>THDSET)  then
 begin
  _hi_onEvent(onTHD_GR_THDSET,1);    //THD <THDset ,need to decrement
  _hi_onEvent(onTHD_LO_THDSET,0);
  flagon:=0;
 end;
//************  TSHD PART
  flagTSHD:=1 ;
if  (TSHD_VAL<>TSHDSET) then else
 begin
 _hi_onEvent(onTSHD_EQ_TSHDSET,1);
   //NORM
 _hi_onEvent(onTSHD_GR_TSHDSET,0);
 _hi_onEvent(onTSHD_LO_TSHDSET,0);
 end;
if  (TSHD_VAL<TSHDSET) then
 begin
 _hi_onEvent(onTSHD_LO_TSHDSET,1);   // TSHD< TSHD set (need to icrement)
 _hi_onEvent(onTSHD_GR_TSHDSET,0);
  flagon:=0;
 end;
if  (TSHD_VAL>TSHDSET)  then
 begin
  _hi_onEvent(onTSHD_GR_TSHDSET,1);      // TSHD >THDset (need to decrement)
  _hi_onEvent(onTSHD_LO_TSHDSET,0);
   flagon:=0;
 end;
   //   ***S/SN part
  flagTSSN:=1 ;
   
if  (SIGNS_VAL<>SSNSET) then else
 begin
 _hi_onEvent(onSSN_EQ_SSNSET,1);  //NORM
 _hi_onEvent(onSSN_GR_SSNSET,0);
 _hi_onEvent(onSSN_LO_SSNSET,0);
//  flagon:=1;
 end;
 
if  (SIGNS_VAL<SSNSET) then
 begin
 _hi_onEvent(onSSN_LO_SSNSET,1);   // SSN< SSNset (need to icrement)
 _hi_onEvent(onSSN_GR_SSNSET,0);
//  flagon:=0;
 end;
if  (SIGNS_VAL>SSNSET)  then
 begin
 _hi_onEvent(onSSN_GR_SSNSET,1);      // SSN>SSNset (need to decrement)
  _hi_onEvent(onSSN_LO_SSNSET,0);
//   flagon:=0;
 end;

 //***** signal /white noise
 
  flagTSWN:=1 ;
 
if  (SIGWN_VAL<>SWNSET) then else
 begin
 _hi_onEvent(onSWN_EQ_SWNSET,1);  //NORM
   //  flagon:=1;
 _hi_onEvent(onSWN_GR_SWNSET,0);
 _hi_onEvent(onSWN_LO_SWNSET,0);
 end;
 
 
 
 
if  (SIGWN_VAL>SWNSET)  then
 begin
 _hi_onEvent(onSWN_GR_SWNSET,1);      // SWN>SWNset (need to decrement)
  _hi_onEvent(onSWN_LO_SWNSET,0);
   //flagon:=0;
 end;
 if  (SIGWN_VAL<SWNSET) then
 begin
 _hi_onEvent(onSWN_LO_SWNSET,1);   // SWN< SWNset (need to icrement)
 _hi_onEvent(onSWN_GR_SWNSET,0);
  //flagon:=0;
 end;
 
 //*****
 
 
 end; 
 
         
     // signal/ noise obtaining
procedure THiAsmClass.doS_WN;
 begin
    if   (_VolN*_KN<>0) then 
    begin
    _hi_onEvent(onERROR,0);
SIGWN_VAL:= ( _K1*_VolS)/ (_VolN*_KN);
      end     
      else 
      begin
       _hi_onEvent(onERROR,1)   ;
       SIGWN_VAL:=9999;
       end;
     _hi_onEvent(onS_WN,SIGWN_VAL);
 end;
   //******
   
   // signal/noise sin signal obtaining
 procedure THiAsmClass.doS_NS;
 begin
    if   (_K1_1*_VolS2<>0) then
    begin
   _hi_onEvent(onERROR,0); 
  SIGNS_VAL:= ( _K1*_VolS)/ (_K1_1*_VolS2);
  end
  else 
   begin
  _hi_onEvent(onERROR,1);
   SIGNS_VAL:=9999;
  end;
_hi_onEvent(onS_NS,SIGNS_VAL);
 end;
   //******
   //stop  flag procedure
   
 procedure THiAsmClass.doStop ;
 begin
 _hi_onEvent(onStop ,1) ;       
  stop:=1 ;
  end;
  // get sound after "sound off"
   procedure THiAsmClass.doOn ;
 begin
    _hi_onEvent(onStop ,1) ; 
    stop:=0 ;
  end; 
 
 
  procedure THiAsmClass.doCheckbox ;
 var checkb: integer;
 begin
 
 checkb:=ToInteger(_Data)  ;
 if (checkb<>1) then else
 flagon:=1 ;
  end;
 
 
    // sampling  procedure
 procedure THiAsmClass.doSempl;       
 begin 
    _KHI:=1/sqrt((_K7*_K7)+(_K6*_K6)+(_K5*_K5)+(_K4*_K4)+(_K3*_K3)+(_K2*_K2));
    _KHI1:=1/sqrt((_Ks7*_Ks7)+(_Ks6*_Ks6)+(_Ks5*_Ks5)+(_Ks4*_Ks4)+(_Ks3*_Ks3)+(_Ks2*_Ks2));
      k:=k+1;
      i:=i+1;
      if i>=0 then
      begin
       _Us:= _K1*_VolS*sin(k*_Freq);
       _Us2:= _K1_1*_VolS2*sin(k*_Freq2);
       _UH:=_VolN1*_KHI*(_K2*sin(2*k*_Freq)+_K3*sin(k*_Freq*3)+_K4*sin(k*_Freq*4)+_K5*sin(k*_Freq*5)+_K6*sin(k*_Freq*6)+_K7*sin(k*_Freq*7));
       _USH:=_VolN2*_KHI1*(_Ks2*sin(k*_Freq/2)+_Ks3*sin(k*_Freq/3)+_Ks4*sin(k*_Freq/4)+_Ks5*sin(k*_Freq/5)+_Ks6*sin(k*_Freq/6)+_Ks7*sin(k*_Freq/7));
       UNOISE:=_VolN*_KN*(0.5-random) ;
       if (stop<>1) then
      _hi_onEvent(onSempl,trunc(flagon*(_Us+_UH+_USH+UNOISE+_Us2)));
      end;
   end;    //******end of sampling proc.*******
   
 
end.



as the sample parsing procedure (rebuild for FPC from HiAsm)?
 

USERPC01

  • Posts: 26
Re: BASS and Lazarus
« Reply #3 on: 10 Aug '18 - 20:05 »
using

Code: [Select]
{ preset variables, init bass , set params using another methods of the class on TTrackBar moving  , Buttonx.onClick  }

{ call this method of the class every sample  using callback procedure from Bass.dll, Bass.pas   resources }
procedure SignalParser.doSample;       
 begin 
   // _KHI:=1/sqrt((_K7*_K7)+(_K6*_K6)+(_K5*_K5)+(_K4*_K4)+(_K3*_K3)+(_K2*_K2));
  //  _KHI1:=1/sqrt((_Ks7*_Ks7)+(_Ks6*_Ks6)+(_Ks5*_Ks5)+(_Ks4*_Ks4)+(_Ks3*_Ks3)+(_Ks2*_Ks2));
      k:=k+1;
      i:=i+1;
      if i>=0 then
      begin
       _Us:= _K1*_VolS*sin(k*_Freq);
       _Us2:= _K1_1*_VolS2*sin(k*_Freq2);
     //  _UH:=_VolN1*_KHI*(_K2*sin(2*k*_Freq)+_K3*sin(k*_Freq*3)+_K4*sin(k*_Freq*4)+_K5*sin(k*_Freq*5)+_K6*sin(k*_Freq*6)+_K7*sin(k*_Freq*7));
     //  _USH:=_VolN2*_KHI1*(_Ks2*sin(k*_Freq/2)+_Ks3*sin(k*_Freq/3)+_Ks4*sin(k*_Freq/4)+_Ks5*sin(k*_Freq/5)+_Ks6*sin(k*_Freq/6)+_Ks7*sin(k*_Freq/7));
     //  UNOISE:=_VolN*_KN*(0.5-random) ;
       if (stop<>1) then
   { insert  procedure for writting data to soundcard using Bass.dll}
      _hi_onEvent(onSempl,trunc(flagon*(_Us {+_UH+_USH+UNOISE+} _Us2)));
      end;
   end;    //******end of sampling proc.*******
   


USERPC01

  • Posts: 26
Re: BASS and Lazarus
« Reply #4 on: 10 Aug '18 - 20:38 »
How to create callback procedure  (how in the  BASS_RecordStart(44100, 2, 0, @RecordingCallback, nil);             function RecordingCallback(h: HRECORD; b: Pointer; l: DWord; u: Pointer): LongBool; stdcall; in the  rec level messer     , using BASS_SampleLoad  ,    FHandle := BASS_StreamCreate( Freq,  Channels,  Flags, @MakeSine, self);  THIBASS_StreamCreate(user).ReadWord; BASS_ChannelPlay( Channel^,  Restart = 0);    THIEventFromData  (rebuild ), ReadMTData(_Data,_data_Data); ) ?

USERPC01

  • Posts: 26
Re: BASS and Lazarus
« Reply #5 on: 10 Aug '18 - 21:43 »
See  unoisetest1.pas from  Noise Generator with BASS.dll for Lazarus   ,BASS_Init(-1, 44100, 0, Handle, nil)  ,NoiseStream := BASS_StreamCreate(44100, 2, 0, @MakeNoise, nil);  , function MakeNoise( handle: HSTREAM; buffer: Pointer; length: DWORD; user: Pointer): DWORD; stdcall;  , type  DWORD=LongWord; 

USERPC01

  • Posts: 26
Re: BASS and Lazarus
« Reply #6 on: 10 Aug '18 - 21:48 »
rebuild  this:
Code: [Select]
function MakeNoise( handle: HSTREAM; buffer: Pointer; length: DWORD; user: Pointer): DWORD; stdcall;
var
  buf : ^word;
  i, len : Integer;
begin
  buf := buffer;
  len := length div 2;
  for i := 0 to len - 1 do
  begin
    buf^ := 65538 - trunc(random(32767)); // Werte sind 'SIGNED'      //rebuild it for  doScale(Um*cos(k*n+fi0)), k- scale factor , obtains from fs,f0
    inc(buf);
  end;
  result := length;
end;

USERPC01

  • Posts: 26
Re: BASS and Lazarus
« Reply #7 on: 10 Aug '18 - 21:53 »
How to create AFR meter from this modules , using sweep -tone and BASS_RecordInit(-1);
  BASS_RecordStart(44100, 2, 0, @RecordingCallback, nil);   from rec.pas (rec.lpr)?