NAME THAT TUNE USING THE SAS CALL SOUND ROUTINE

 

/*Define Length of 4/4 Note*/

%let BaseLength=2000;



data Noten;

  Length Note $5. Mode $1. Type $4.;

  retain BaseLength &BaseLength

         Staccato_Lag 0.2;

  BaseFreq=440;

  label Note='Note'

        Type='Type of Note, e.g. 1/4'

        Mode='Mode (Staccato/Legato)'

        Staccato_Lag='Short break before note to 

                      perform staccato'

        BaseFreq='Frequency of base-note A'

        Length='Length of Note'

        BaseLength='Length of Time ';

  /*Define Array containing Scale*/

  array Scale(0:11) $3 _temporary_

    ('A' 'AIS' 'H' 'C' 'CIS' 'D' 'DIS' 'E' 'F'

     'FIS' 'G' 'GIS');

  /*Get file defined in macro-var file*/

  input Note Type Mode;

  /*Get the length of a Note in ms from input

    Character Column 'Type' in format x/y*/

  if index(Type,'/') then

     length=Baselength*

            input(scan(Type,1,'/'),8.)/input(scan(Type,2,'/'),8.);

  else length=Baselength*input(scan(Type,1,'/'),8.);

  Note=upcase(Note);

  select(Note);

     when('DES') Note='CIS';

     when('ES')  Note='DIS';

     when('GES') Note='FIS';

     when('AS')  Note='GIS';

     when('B')   Note='AIS';

     otherwise;

 end;

  /*If Note contains a plus or minus sign the tone should be x octave

  higher or lower according to the integer x following

  the sign. This is performed by multiplying the 

  base Frequency BaseFreq by 2**(sign*x)  */

  AnyPlusOrMinus=indexc(Note,'-','+');

  if AnyPlusOrMinus then do;

    higherOrlower=input(substr(Note,AnyPlusOrMinus+1),1.);

    if substr(Note,AnyPlusOrMinus,1)='-' then

       higherOrLower=-1*higherOrLower;

    BaseFreq=BaseFreq*(2**(higherOrLower));

    Note=scan(Note,1,'+-');

  end;

  /*If PAUSE then perform break of length LENGTH*/

  if Note='PAUSE' then do;

     /*Delay for Length*/

     start=time();

     end=start+Length/1000;

     do while(time() < end);

     end;

     drop start end; 

 end;

 /*Now create the Frequeny (if not PAUSE)

 and sound. Frequency increases by factor

 2**(1/12) for each halftone*/

 else do i=0 to 11;

    if Note= Scale[i] then do;

         Frequency=BaseFreq*(2**(i/12));

         if mode='S' then do;

            /*if Staccato then Delay for Staccato_lag

            before creating sound*/

            start=time();

            end=start+(Length*Staccato_Lag/1000);

            do while(time() < end);

            end;

            drop start end; 

            /*Correct Length by Staccato_lag*/

            Length=Length-Length*Staccato_lag; 

         end;

         call sound(frequency,Length);

         /*Finish do-loop*/

         i=12;

    end;

  end;

cards;

h     1/16   L   

a     1/16   L 

gis-1 1/16   L

a     1/16   L

c     1/8    L 

PAUSE 1/8    L

d     1/16   L 

c     1/16   L

h     1/16   L 

c     1/16   L 

e     1/8    L

PAUSE 1/8    L

f     1/16   L 

e     1/16   L 

dis   1/16   L

e     1/16   L

h+1   1/16   L

a+1   1/16   L

gis   1/16   L

a+1   1/16   L

h+1   1/16   L

a+1   1/16   L

gis   1/16   L

a+1   1/16   L

c+1   1/4    L

a+1   1/8    S

c+1   1/8    S

g     1/24   L

a+1   1/24   L

h+1   1/24   L

a+1   1/8    S

g     1/8    S

a+1   1/8    S

g     1/24   L

a+1   1/24   L

h+1   1/24   L

a+1   1/8    S

g     1/8    S

a+1   1/8    S

h+1   1/8    S

a+1   1/8    S

g     1/8    S

fis   1/8    S

e     1/8    S  

PAUSE 1/8    L 

h     1/16   L  

a     1/16   L 

gis-1 1/16   L

a     1/16   L

c     1/8    L 

PAUSE 1/8    L

d     1/16   L 

c     1/16   L

h     1/16   L 

c     1/16   L 

e     1/8    L

PAUSE 1/8    L

f     1/16   L 

e     1/16   L 

dis   1/16   L

e     1/16   L

h+1   1/16   L

a+1   1/16   L

gis   1/16   L

a+1   1/16   L

h+1   1/16   L 

a+1   1/16   L

gis   1/16   L

a+1   1/16   L

c+1   1/4    L  

a+1   1/8   S

h+1   1/8   S

C+1   1/8   S

h+1   1/8   S

a+1   1/8   S

gis   1/8   S

a+1   1/8   S

e     1/8   S

f     1/8   S

d     1/8   S

c     1/4   L

c     1/16  L

h     1/16  L

a     1/16  L

h     1/16  L

a     1/8   S   

PAUSE 1/8   L 

;

run;