Playing with the Beep function

[Roland Stowasser]

Hello,

this was my little homework for the weekend. I was not aware that you can still use the Beep function. It may not work with 64-bit versions of Win XP and Win Vista. The function can still be used for small gimmicks.

This little app plays two melodies. I named it TheBeeper.o2bas:

Code: [Select]

$ filename "TheBeeper.exe"

'uses rtl32
'uses rtl64

uses console

! SetConsoleCursorInfo lib "kernel32.dll" (sys hConsoleOutput, CONSOLE_CURSOR_INFO *lpConsoleCursorInfo) as bool
! SetConsoleWindowInfo lib "kernel32.dll" (sys hConsoleOutput, bool bAdsolute, SMALL_RECT *lpConsoleWindow)
! GetTickCount         lib "kernel32.dll" () as dword
! Beep  lib "kernel32.dll" (dword dwFreq=800, dword dwDuration=200) as bool
! Sleep lib "kernel32.dll" 'dwMilliseconds

% RAND_MAX = 32767
! srand lib "Msvcrt.dll" (uint seed)
! rand  lib "Msvcrt.dll" () as int

srand(GetTickCount())

function inRange(int range_min, range_max) as int
  return (double rand() / RAND_MAX) * (range_max - range_min) + range_min
end function


type CONSOLE_CURSOR_INFO ' cci 
    dword dwSize
    bool  bVisible
end type

sub setcolor(int fg, bg)
  SetConsoleTextAttribute (ConsOut, fg+bg*16)
end sub
 
sub locate (int col,int row, optional int visible=1,int shape=12)
  CONSOLE_CURSOR_INFO cci
  SetPos(col-1,row-1)
  cci.bVisible = visible
  cci.dwSize   = shape
  SetConsoleCursorInfo(ConsOut, cci)
end sub
 
sub display(int col, row, string txt, optional int visible=1,int shape=12)
  locate(col, row, visible)
  print txt
end sub 

SetConsoleTitle "Playing with the Beep function"
cls

type music_note
   int    i
   string n_s       'major scale (with sharp)
   string n_f       'minor scale (with flat)
   dword  f
end type

' The piano key table
music_note note[] =
{
{ 1,"A0" ,"A0" ,  27.50},
{ 2,"A#0","Ab0",  29.14},
{ 3,"B0" ,"B0" ,  30.87},

{ 4,"C1" ,"C1" ,  32.70},
{ 5,"C#1","Db1",  34.65},
{ 6,"D1" ,"D1" ,  36,71},
{ 7,"D#1","Eb1",  38.89},
{ 8,"E1" ,"E1" ,  41.20},
{ 9,"F1" ,"F1" ,  43.65},
{10,"F#1","Gb1",  46.25},
{11,"G1" ,"G1" ,  49.00},
{12,"G#1","Ab1",  51.91},
{13,"A1" ,"A1" ,  55.00},
{14,"A#1","Bb1",  58.27},
{15,"B1" ,"B1" ,  61.74},

{16,"C2" ,"C2" ,  65.41},
{17,"C#2","Db2",  69.30},
{18,"D2" ,"D2" ,  73.42},
{19,"D#2","Eb2",  77.78},
{20,"E2" ,"E2" ,  82.41},
{21,"F2" ,"F2" ,  87.31},
{22,"F#2","Gb2",  92.50},
{23,"G2" ,"G2" ,  98.00},
{24,"G#2","Ab2", 103.83},
{25,"A2" ,"A2" , 110.00},
{26,"A#2","Bb2", 116.54},
{27,"B2" ,"B2" , 123.47},

{28,"C3" ,"C3" , 130.81},
{29,"C#3","Db3", 138.59},
{30,"D3" ,"D3" , 146.83},
{31,"D#3","Eb3", 155.56},
{32,"E3" ,"E3" , 164.81},
{33,"F3" ,"F3" , 174.61},
{34,"F#3","Gb3", 185.00},
{35,"G3" ,"G3" , 196.00},
{36,"G#3","Ab3", 207.65},
{37,"A3" ,"A3" , 220.00},
{38,"A#3","Bb3", 233.08},
{39,"B3" ,"B3" , 246.94},

{40,"C4" ,"C4" , 261.63},
{41,"C#4","Db4", 277.18},
{42,"D4" ,"D4" , 293.66},
{43,"D#4","Eb4", 311.13},
{44,"E4" ,"E4" , 329.63},
{45,"F4" ,"F4" , 349.23},
{46,"F#4","Gb4", 369.99},
{47,"G4" ,"G4" , 392.00},
{48,"G#4","Ab4", 415.30},
{49,"A4" ,"A4" , 440.00},
{50,"A#4","Bb4", 466.16},
{51,"B4" ,"B4" , 493.88},

{52,"C5" ,"C5" , 523.25},
{53,"C#5","Db5", 554.37},
{54,"D5" ,"D5" , 587.33},
{55,"D#5","Eb5", 622.25},
{56,"E5" ,"E5" , 659.25},
{57,"F5" ,"F5" , 698.46},
{58,"F#5","Gb5", 739.99},
{59,"G5" ,"G5" , 783.99},
{60,"G#5","Ab5", 830.61},
{61,"A5" ,"A5" , 880.00},
{62,"A#5","Bb5", 932.33},
{63,"B5" ,"B5" , 987.77},

{64,"C6" ,"C6" ,1046.50},
{65,"C#6","Db6",1108.73},
{66,"D6" ,"D6" ,1174.66},
{67,"D#6","Eb6",1244.51},
{68,"E6" ,"E6" ,1318.51},
{69,"F6" ,"F6" ,1396.91},
{70,"F#6","Gb6",1479.98},
{71,"G6" ,"G6" ,1567.98},
{72,"G#6","Ab6",1661.22},
{73,"A6" ,"A6" ,1760.00},
{74,"A#6","Bb6",1864.66},
{75,"B6" ,"B6" ,1975.53},

{76,"C7" ,"C7" ,2093.00},
{77,"C#7","Db7",2217.46},
{78,"D7" ,"D7" ,2349.32},
{79,"D#7","Eb7",2489.02},
{80,"E7" ,"E7" ,2637.02},
{81,"F7" ,"F7" ,2793.83},
{82,"F#7","Gb7",2959.96},
{83,"G7" ,"G7" ,3135.96},
{84,"G#7","Ab7",3322.44},
{85,"A7" ,"A7" ,3520.00},
{86,"A#7","Bb7",3729.31},
{87,"B7" ,"B7" ,3951.07},
{88,"C8" ,"C8" ,4186.01},
{89,"GAP","GAP" ,0}
}

' Duration values
int d_0, d_2, d_4, d_8, d_16

sub adapt_duration(int v)
  d_0  = v      'whole
  d_2  = d_0\2  'half
  d_4  = d_2\2  'quarter
  d_8  = d_4\2  'eighth
  d_16 = d_8\2  'sixteenth
end sub

macro doBeep (idx)
   if note (n(idx)).i <> 89 then
      Beep(note(n(idx)).f, d(idx))
   else
      sleep(d(idx))
   end if     
end macro   

adapt_duration(1400)

redim int n(30)
redim int d(30)
'
' a simple childrens song
n[] =  {40,42,44,45,47,47,        49,49,49,49,47,       89,   49,49,49,49,47,       89,
        45,45,45,45,44,44,        47,47,47,47,40}
d[] =  {d_4,d_4,d_4,d_4,d_2,d_2,  d_4,d_4,d_4,d_4,d_2,  d_4,  d_4,d_4,d_4,d_4,d_2,  d_4,
        d_4,d_4,d_4,d_4,d_2,d_2,  d_4,d_4,d_4,d_4,d_2}


int x
Printl "A simple childrens song" + cr : sleep 1000

printl "All my little ducklings"
printl "swimming on the lake,"
for x = 1 to 12
   doBeep (x)
next

printl "swimming on the lake,"
for x = 13 to 18
   doBeep (x)
next

printl "dip their heads in water,"
for x = 19 to 24
   doBeep (x)
next

printl "make their tails all shake."
for x = 25 to 29
   doBeep (x)
next

sleep(d_0)
Beep : Beep : Beep

cls
printl "And now TheBeeper makes Popcorn" + cr : sleep 1000

redim int n(0)
redim int n(194)

'Popcorn (a little, very little bit like Gershon Kingsley)
n[] = {49,47,49,44,40,44,37,  89,  49,47,49,44,40,44,37,  89,  49,51,       '18
       52,51,52,49,51,49,51,47,49,47,49,45,49,  89,  49,47,49,44,40,44,     '38
       37,  89,  49,47,49,44,40,44,37,  89,  49,51,52,51,52,49,51,49,51,47, '58
       49,47,49,51,52,  89,  56,54,56,52,47,52,44,  89,  56,54,56,52,47,52, '78
       44,  89,  56,58,59,58,59,56,58,56,57,54,56,54,56,52,56,  89,  56,54, '98
       56,52,47,52,44,  89,  56,54,56,52,47,52,44,  89,  56,58,59,58,59,56, '118
       58,56,57,54,56,54,51,54,56,  89,  49,47,49,44,40,44,37,  89,  49,47, '138
       49,44,40,44,37,  89,  49,51,52,51,52,49,51,49,51,47,49,47,49,45,     '158
       49,  89,  49,47,49,44,40,44,37,  89,  49,47,49,44,40,44,37, 89,  49,51, '178
       52,51,52,49,51,49,51,47,49,47,44,47,49,  89,  89,  89}                  '194

adapt_duration(900)

for x = 1 to 194
   if note (n(x)).i <> 89 then
      display(inRange(5,25), inRange(5,16), "**")
      Beep(note(n(x)).f, d_4)
   else
      sleep(d_4)
   end if     
next

Beep : Beep : Beep
locate(1,20)
print "Enter to continue ..."
waitkey


[Charles Pegge]

Thanks Roland.

I will save it as demos\Sound\PlayBeeper.o2bas

[Roland Stowasser]

Hi Charles,

I'm doing these little projects to reacquaint myself a bit more with O2 and see what has changed/improved in the last two years. In this context, I noticed something about the redim command. I accidentally typed in about line 220: redim int n(98), even though there are 194 notes. (I corrected it later). But this had no effect on the program. Shouldn't there have been an error message that the limits were exceeded?

[Roland Stowasser]

Hello,

this little example uses the Beep function to do a simple listening test. It is intended to serve as an incentive for self-control. I use console.inc's helpful 'SetPos' and 'inkey' functions, as well as the interesting built-in 'quote' (see O2 help) function .

Actually, I also wanted to write an app that creates Morse code (which is still used today), but that might be a bit too boring.

Code: [Select]

$ filename "HearingTest.exe"

'uses rtl32
'uses rtl64

uses console

! Beep  lib "kernel32.dll" (dword dwFreq=800, dword dwDuration=200) as bool
'! Sleep lib "kernel32.dll" 'dwMilliseconds

% f_min = 20
% f_max = 20000
int f = f_min
int k

SetConsoleTitle "Test your hearing"

string InfoTxt = quote !!!
  The range of human hearing is between 20 and 20,000 Hz, but
  it is age-dependent. Almost everyone can still hear up to 8000 Hz.
  The ability to hear decreases with age:

     age 50 and older:  up to 8000 Hz - 12000 Hz
     age 40 to 50:      up to 12000 Hz
     age 30 to 40:      up to 15000 Hz
     age 20 to 30:      up to 17000 Hz
     younger than 20:   up to 19000 Hz
     baby:              up to 20000 Hz

  This test cannot be very accurate, if only because of the limited
  capabilities of the speakers or headphones. But it already gives
  an approximate overview. To be sure, you should visit
  a hearing care professional.
!!!

cls
print InfoTxt
printl : print "Enter ..." : waitkey

cls
SetPos(3,3) : print "Test your Hearing"
SetPos(3,4) : print "If you can hear the sound between the clicks,"
SetPos(3,5) : print "then please press X"

SetPos(3,8) : print "Starting"
Sleep(2000)

'The lower frequencies
do
  f += 10
  Beep(f, 1000)
  k=inkey 'non-blocking
  sleep 10 'important!
  if k=27 then goto fin: ' Esc
  SetPos(3,8) : print f " Hertz  "
  if f = f_max then exit do
  if f > 300 then
     SetPos(3,10) : print "You are probably deaf or have blocked ears. If this is the case,"
     SetPos(3,11) : print "then maybe you need a hearing aid."
     goto fin
  endif   
  if k = 88 then 'X
     f -= 10
     SetPos(3,8) : print f " Hertz   "
     exit do
  endif     
loop

SetPos(3,3) : print "Now testing the upper frequencies:"
SetPos(3,4) : print "If you cannot hear the sound between the clicks any longer,"
SetPos(3,5) : print "then please press X"
SetPos(3,10) : print "Starting"
Sleep(2000)

'The upper frequencies
f = 6900
do
  if f > 9900 then f += 400
  f += 100
  Beep(f, 1000)
  k=inkey 'non-blocking
  sleep 10 'important!
  if k=27 then goto fin: ' Esc
  SetPos(3,10) : print f " Hertz   "
  if f = f_max then exit do
  if k = 88 then 'X
     if f > 9900 then f -= 400
     f -= 100
     SetPos(3,10) : print f " Hertz   "
     exit do
  endif     
loop

fin:
SetPos(0,12)
print "Enter ..." : waitkey


[Charles Pegge]

Thanks Roland.

I'll store this one as demos/Sound/HearingTestBeeps.o2bas.

The beeps on my PC unfortunately start and end with a loud pop, indicating the pulses are not balanced +/-. So I thought it might be possible to use wave audio instead,  to deliver pure sine waves with volume control. The min pulse width is 1/44100 of a second.

[Roland Stowasser]

Hi Charles,

that's what I'm going to try to do. I noticed that you have already done some sound experiments in demos\!ProjA\AudioSynth. Maybe I can use some functions from the demos, that would simplify things a bit.

[Charles Pegge]

This might be a useful template, based on demos/!ProjA/AudioSynth/WaveSynthDem7.o2bas

It produces a simple rising pitch from 100 Hz to 22050 Hz.

To avoid 'popping' a beep should delay its ending until phase is at a small value, ideally zero.

Alternatively, the beep could be faded out over a short period, say 50ms.

Code: [Select]

  uses minwin
  uses waves.h
  uses waves.inc
  '
  WaveOut w
  '
  w.WavoStart
  '
  double v
  '
  single a,amp,freq,nfreq,basefreq,phase,phdis,vphase
  single reverba=0.0, nreverba=1.0
  single ,filt,filtpr,filtba
  '
  sys b,bufo,d1,d2,i,p,q,decay,reverbt
  sys k1,k2,pc,opc,pcf,qq
  '
  /*
  'REVERB SETTINGS

  reverba=.25
  nreverba=.75
  'reverbt=0.3*88200 'max buffersize 64k
  */
  '

  amp=1000
  basefreq=100
  freq=basefreq
  filtba=1
  do
    sleep 5 'msec
    if GetAsyncKeyState 27 'escape key
      exit do
    endif
    p=w.wavopos
    if p+2000>q 'ahead ~1/40 sec

  '
  'ENVELOPE
  '
  int i
  '
  ============================
  for i=1 to 1000 'in envelope
  ============================
  '
  'DECAY
  '
  if amp>=1000 then decay=1
  if decay
    'amp*=.9995
    'if amp then amp-=.5
  else
    'amp+=10
  endif
  '
  v=freq*q*ipuls-phdis
  phase=frac(v)
  pc=v-phase 'wave counter
  if pcf then opc=pc : pcf=0
  '
  'NEW WAVE OR PULSE
  '
  if pc>opc then
    pcf=1
    vphase=frac(8*ipuls*q)
    'basefreq+=.02
    freq=basefreq
    '
    /*
    'VIBRATO (frequency modulation)
    '
    v=sin(pi2*vphase)*basefreq*.1
    freq+=v
    */
    '
    'SYNC PHASE
    '
    phdis=frac(freq*q*ipuls)-phase
    '
  end if
  '
  '
  'WAVEFORM
  '
  'a+=amp*noiseInterp(pc,phase)
  'a+=amp*sawtooth(phase)
  'a+=amp*triangle(phase)
  'a+=amp*square(phase)
  'a+=amp*square(phase*1.5)
  a+=amp*sin(pi2*phase) 'sine wave
  'a+=amp*sin(pi2*phase*2) 'sine harmonic
  'a+=amp*sin(pi2*phase*3) 'sine harmonic
  'a+=amp*sin(pi2*phase*4) 'sine harmonic

  '
  /*
  'FILTER
  '
  filtpr=.1
  filt=filt*(1-filtpr)+a*filtpr
  single lp=filt       'low pass
  'hp=a-filt     'high pass
  'a=lp*filtba + hp*(1-filtba) 'moving filter mix
  'a=lp*2 'boosted
  */
  '
  /*
  'TREMOLO (amplitude modulation)
  '
  a=a*(0+(1+sin(pi2*vphase)))*.5
  */
  '
  '
  SendToBuffer 'macro
  a=0
  '
  =================
  next 'in envelope
  =================

  int dmx=2
  if ++d1=dmx 'raise-pitch event
    'decay=0
    'amp=4000
    basefreq=freq*(1.0+0.00625*dmx) 'rising pitch
    'if basefreq>1000 then amp*=.90 'FADE
    if basefreq>22050 then exit do 'FINISH
    if ++d2=8
      d2=0
      'if filtba<=0 then exit do
    endif
    d1=0
  endif

  endif

  enddo
  '
  w.WavoEnd

   

[Charles Pegge]

I found there are system latencies wich make a wave-based beep function impractical, unfortunately. Perhaps using a midi sound, like the piccolo would make a much easier beep function.

[Roland Stowasser]

Hi Charles,

apparently I need to learn a bit more about midi to create effective tones. I don't quite understand the parameters for midiOutShortMsg in particular. But I found an old app that still works after some small tweaks. I believe it contains all the necessary functions I need. But I need to read the explanations a little more carefully.

Code: [Select]

/*---------------------------------------------------
   BACHTOCC.o2bas -- Bach Toccata in D Minor (First Bar)
                 (c) Charles Petzold, 1998
  ---------------------------------------------------*/
'Ported to Oxygenbasic

$ filename "BACHTOCC.exe"

'uses rtl32
'uses rtl64

uses corewin

'uses minmidi
'octave 0..10
extern lib "Winmm.dll"

sys midiOutOpen(sys *phmo, uDeviceID,dwCallback, dwInstance,fdwOpen)
sys midiOutShortMsg( sys hmo, dwMsg)
sys midiOutClose( sys hmo)
sys midiOutReset(sys hmo)

% COLOR_WINDOW = 5
% MIDIMAPPER = 0xFFFFFFFF

'=======================
'MAIN CODE
'=======================

sys hInstance = GetModuleHandle(0)
'========================================'


string szClassName = "BachTocc"
string WindowTitle = "Bach Toccata in D Minor (First Bar)"


% ID_TIMER = 1


function MidiOutMsg(sys hMidi, int iStatus, iChannel, iData1,  iData2) as dword
   dword dwMessage = iStatus + iChannel + (iData1 * 0x100) + (iData2 * 0x10000)
   return midiOutShortMsg(hMidi, dwMessage)
end function


int iDur = 1
int iNote = 2

int noteseq[] =
                {110, 69, 81, 
                 110, 67, 79,
                 990, 69, 81,
                 220, -1, -1,
                 110, 67, 79,
                 110, 65, 77,
                 110, 64, 76,
                 110, 62, 74,
                 220, 61, 73,
                 440, 62, 74,
                 1980,-1, -1,
                 110, 57, 69,
                 110, 55, 67,
                 990, 57, 69,
                 220, -1, -1,
                 220, 52, 64,
                 220, 53, 65,
                 220, 49, 61,
                 440, 50, 62,
                 1980, -1, -1}

sys hMidiOut
int iIndex = 1


function WndProc(sys hwnd, Message, wParam, lParam) as sys callback
   int i

   switch Message

   case WM_CREATE

     // Open MIDIMAPPER device                                                           
     if midiOutOpen(hMidiOut, MIDIMAPPER, 0, 0, 0) then
        MessageBeep(MB_ICONEXCLAMATION)
        MessageBox(hwnd, "Cannot open MIDI output device!",
                   szClassname, MB_ICONEXCLAMATION or MB_OK)
        return -1
     end if

     // Send Program Change messages for "Church Organ"         
     'MidiOutMsg(hMidiOut, 0xC0,  0, 19, 0)
     'Send Program Change messages for "Piccolo"         
     MidiOutMsg(hMidiOut, 0xC0,  0, 72, 0)
     SetTimer(hwnd, ID_TIMER, 1000, NULL)

   case WM_TIMER

     // Loop for 2-note polyphony         
     for i = 1 to 2                         
        // Note Off messages for previous note
        if iIndex <> 1 and noteseq[iIndex-iDur-iNote + i] <> -1 then
           MidiOutMsg(hMidiOut, 0x80,  0,
                      noteseq[iIndex-iDur-iNote +i], 0)
        end if
        // Note On messages for new note
        if iIndex <= 20*(iDur+iNote)  and
                     noteseq[iIndex +i] <> -1 then
           MidiOutMsg(hMidiOut, 0x90,  0,
                      noteseq[iIndex +i], 127)
        end if                             
     next i

     if iIndex <= 20*(iDur+iNote) then
       SetTimer(hwnd, ID_TIMER, noteseq[iIndex] - 1, NULL)
       iIndex = iIndex + iDur + iNote
     else
       KillTimer(hwnd, ID_TIMER)
       DestroyWindow (hwnd)   
     end if

   case WM_DESTROY
       midiOutReset(hMidiOut)
       midiOutClose(hMidiOut)
       PostQuitMessage(0)

   case else
       return DefWindowProc(hwnd, Message, wParam, lParam)

   end switch

   return 0
end function


function WinMain(sys nCmdShow) as sys

   WNDCLASSEX wc
   MSG Msg

   sys hwnd

   wc.cbSize        = sizeof(WNDCLASSEX)
   wc.style         = 0
   wc.lpfnWndProc   = @WndProc
   wc.cbClsExtra    = 0
   wc.cbWndExtra    = 0
   wc.hInstance     = hInstance
   wc.hIcon         = LoadIcon (NULL, IDI_APPLICATION)
   wc.hCursor       = LoadCursor(NULL, IDC_ARROW)
   wc.hbrBackground = COLOR_WINDOW+1
   wc.lpszMenuName  = NULL
   wc.lpszClassName = strptr(szClassName)
   wc.hIconSm       = LoadIcon (NULL, IDI_APPLICATION)

   if not RegisterClassEx(&wc) then
      MessageBox(NULL, "Window Registration Failed!", "Error!", MB_ICONERROR)
      return 0
   end if

   hwnd = CreateWindowEx(
              WS_EX_CLIENTEDGE,
              szClassName,
              WindowTitle,
              WS_OVERLAPPEDWINDOW,
              CW_USEDEFAULT, CW_USEDEFAULT, // x, y positon
                       500,           300,  // x size, y size
              NULL,
              NULL,   // window menu handle
              hInstance, NULL)

   if hwnd = NULL then
     MessageBox(NULL, "Window Creation Failed!", "Error!", MB_ICONERROR)
     return 0
   end if

   ShowWindow(hwnd, nCmdShow)
   UpdateWindow(hwnd)

   sys bRet
   do while (bRet := GetMessage(&Msg, NULL, 0, 0))
       TranslateMessage(&Msg)
       DispatchMessage(&Msg)
   wend
   
   return Msg.wParam
end function

'WINDOWS START
'=============

WinMain(SW_NORMAL)