/* Richard A. DeVenezia * www.devenezia.com * August 16, 2004 * * Mod: * 6-FEB-2020 RAD Updated to also run in 64-bit SAS. * * Generate wave forms of pure tone notes and play them back through * the sound card in the form of the song "Joy to the World". * Tested on Windows 2000. * * Thanks to posts by Michael Williams and David L. Ward */ data notes; noteid + 1; input note $ frequency ; logfreq = log(frequency); cards; C1 33 C1# 35 D1 37 D1# 39 E1 41 F1 44 F1# 46 G1 49 G1# 52 A1 55 A1# 58 B1 62 C2 65 C2# 69 D2 73 D2# 78 E2 82 F2 87 F2# 93 G2 98 G2# 104 A2 110 A2# 117 B2 123 C3 131 C3# 139 D3 147 D3# 156 E3 165 F3 175 F3# 185 G3 196 G3# 208 A3 220 A3# 233 B3 247 C4 262 C4# 277 D4 294 D4# 311 E4 330 F4 349 F4# 370 G4 392 G4# 415 A4 440 A4# 466 B4 494 C5 523 C5# 554 D5 587 D5# 622 E5 659 F5 698 F5# 740 G5 784 G5# 831 A5 880 A5# 932 B5 988 C6 1047 C6# 1109 D6 1175 D6# 1245 E6 1319 F6 1397 F6# 1475 G6 1568 G6# 1661 A6 1760 A6# 1865 B6 1976 C7 2093 C7# 2217 D7 2349 D7# 2489 E7 2637 F7 2794 F7# 2960 G7 3136 G7# 3322 A7 3520 A7# 3729 B7 3951 C8 4186 run; ods listing; symbol1 v=square i=R1; axis1 logbase=e logstyle=power; proc gplot data=notes; * plot frequency * noteid / vaxis=axis1 regeqn; plot logfreq * noteid / regeqn; run; quit; /**/ %let append = 1; filename sascbtbl catalog 'work.sandbox.sascbtbl.source'; data _null_; infile sascbtbl; input; if index (_infile_,'routine PlaySoundA') then do; call symput ('append', '0'); stop; end; run; data _null_; if not &append then stop; input; if _infile_ in: ('32:', '64:') then do; if _infile_ ne: "&SYSADDRBITS" then delete; putlog 'NOTE: ' _infile_; _infile_ = substr(_infile_,4); end; file sascbtbl mod; put _infile_; cards4; routine PlaySoundA module = winmm minarg = 3 maxarg = 3 stackpop = called returns = long 32: dlltype=32 ; 32:arg 1 num input byvalue format=pib4.; *lpszSoundName; 32:arg 2 num input byvalue format=pib4.; *hModule (always 0); 32:arg 3 num input byvalue format=pib4.; *uFlags; 64:arg 1 char input byvalue format=$ptr. datalen=8; *lpszSoundName; 64:arg 2 num input byvalue format=pib4.; *hModule (always 0); 64:arg 3 num input byvalue format=pib4.; *uFlags; ;;;; /**/ %let SND_ALIAS = 10000x; %let SND_ASYNC = 1x; %let SND_FILENAME = 20000x; %let SND_LOOP = 8x; %let SND_MEMORY = 4x; %let SND_NODEFAULT = 2x; %let SND_NOSTOP = 10x; %let SND_SYNC = 0x; /* * Adapted from post * From: Michael Williams * Subject: Re: Creating sound through speakers * Newsgroups: comp.lang.basic.visual.misc * Date: 2001-08-15 14:46:46 PST */ data tones; set notes; duration = .4; * seconds; amplitude = .3; * 0 mute, 1 full volume; link makeSineWave; return; makeSineWave: if amplitude < 0 then amplitude = 0; else if amplitude > 1 then amplitude = 1; maxlevel = floor (32767 * amplitude); samplerate = 11025; cycles = floor (frequency * duration); samplecount = floor (samplerate / frequency * cycles); %let dim = 12000; %let siz = %sysevalf(&dim*2+44); array bit(&dim) _temporary_; length wavedata $&siz; if samplecount > dim(bit) then do; put 'ERROR: bit dimension should be at least ' samplecount; stop; end; thetamax = cycles * 2 * constant('PI'); thetastep = thetamax / samplecount; i = 0; do theta = 0 to thetamax by thetastep; i + 1; bit [i] = floor (maxlevel * sin(theta)); * if noteid=50 then put bit[i]=; end; samplecount = i-1; link bitsToString; /* fname = 'c:\temp\' || trim(note) || '.wav'; file dummy filevar = fname recfm = n; put wavedata $varying. wavesize @; file log; put wavesize=; */ return; bitsToString: wavesize = 2 * samplecount + 44; wavedata = repeat ('00'x, wavesize-1); substr(wavedata, 1,4) = 'RIFF'; substr(wavedata, 5,4) = put(wavesize-8,pib4.); substr(wavedata, 9,4) = 'WAVE'; substr(wavedata,13,4) = 'fmt '; substr(wavedata,17,4) = put(16,pib4.); * 16 bit chunk size; substr(wavedata,21,2) = put( 1,pib2.); * uncompressed format tag; substr(wavedata,23,2) = put( 1,pib2.); * 1 channel; substr(wavedata,25,4) = put(samplerate,pib4.); * playback rate; substr(wavedata,29,4) = put(samplerate*2,pib4.); * average bytes/second, (16bit mono); substr(wavedata,33,2) = put(2,pib2.); * blockalign (bytes per sample frame); substr(wavedata,35,2) = put(16,pib2.); * bits per sample; substr(wavedata,37,4) = 'data'; substr(wavedata,41,4) = put(samplecount*2,pib4.); p = 45; do i = 1 to samplecount; substr(wavedata,p,2) = put (bit[i], pib2.); p + 2; end; return; keep noteid note frequency wavedata; run; data cntlin; set notes; fmtname = 'nf'; start = note; label = noteid; type = 'I'; run; proc format cntlin = cntlin; run; %let addr32 = addr; %let addr64 = addrlong; %let addr_func = &&addr&SYSADDRBITS.; %let notone32 = 0; %Let notone64 = '0000000000000000'x; %let notone = &¬one&SYSADDRBITS.; data _null_; infile cards eof=eof flowover; length token $8 ; input token @@ ; note = scan (token,1,'='); durc = scan (token,2,'='); dur = input (durc,best12.); * tweak note duration 5x; dur = dur/5; * put 'NOTE: Playing ' note dur; if note = 'R' then do; rc = modulen ('PlaySoundA', ¬one, 0, 0); call sleep (dur*1000,0.001) ; end; else do; row = input (note, nf.); set tones point=row; * play the note for the specified duration; rc = modulen ('PlaySoundA', &addr_func(wavedata), 0, &SND_ASYNC+&SND_MEMORY+&SND_LOOP); call sleep (dur*1000, 0.001); * take a breather between each note; * rc = modulen ('PlaySoundA', 0, 0, 0); * call sleep (20,0.001); end; return; eof: put 'eof'; rc = modulen ('PlaySoundA', ¬one, 0, 0); stop; /* * song from comp.soft-sys.sas post by: * David L. Ward * Thursday, December 20, 2001 10:04 AM */ cards; C6=1 B5=1.5 A5=6 G5=1 R=2 F5=2 E5=1 D5=1 C5=1 R=2 G5=2 A5=1 R=2 A5=2 B5=1 R=2 B5=2 C6=.33 C6=2 C6=2 B5=2 A5=2 G5=2 G5=1.5 F5=4 E5=2 C6=2 C6=2 B5=2 A5=2 G5=2 G5=1.5 F5=4 E5=2 E5=2 E5=2 E5=2 E5=2 E5=4 F5=4 G5=1 R=4 F5=4 E5=4 D5=2 D5=2 D5=2 D5=4 E5=4 F5=1 R=4 E5=4 D5=4 C5=2 C6=1 A5=2 G5=1.5 F5=6 E5=2 F5=2 E5=1 D5=1 C5=1 ; run ;