home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / MBUG / MBUG013.ARC / SCALE.PAS < prev    next >
Pascal/Delphi Source File  |  1979-12-31  |  2KB  |  55 lines
  1. program SCALE;
  2.  
  3. { Demonstration program in Turbo Pascal for the
  4.   MicroBee, which simulates the PLAY command in
  5.   MicroWorld BASIC, developed by Bob Burt from
  6.       an algorithm developed by Alan Burt        }
  7.  
  8. const
  9.   note_name = 'A A#B C C#D D#E F F#G G#';
  10. var
  11.   count,cycles,interval,frequency,duration : integer;
  12.   tone_length,freq1,freq2,dur1,dur2 : byte;
  13.  
  14. {$I sound.pro}
  15.  
  16. procedure play;
  17. begin
  18.   mem[addr(sound)+39] := freq1;
  19.   mem[addr(sound)+40] := freq2;
  20.   mem[addr(sound)+41] := dur1;
  21.   mem[addr(sound)+42] := dur2;
  22.   sound
  23. end; {procedure play}
  24.  
  25. begin {main}
  26.   clrscr;
  27.   write('Enter Tone Length (1/8 ths of second) : ');
  28.   readln(tone_length);
  29.   count := 1; interval := -11;
  30.   while interval < 48 do
  31.     begin
  32.       while count <24 do
  33.       begin
  34.         frequency := round(exp(ln(440)+(interval-13)/12*ln(2)));
  35.         duration := round(exp(ln(144)+(13-interval)/12*ln(2.028)));
  36.         cycles := (frequency*tone_length) div 8;
  37.         write('Play ',interval:3,',',tone_length,'   ');
  38.         write(copy(note_name,count,2),'  ');
  39.         write(frequency:4,' Hz  ');
  40.         freq1 := cycles;
  41.         freq2 := cycles div 256;
  42.         dur1 := duration;
  43.         dur2 := duration div 256;
  44.         write(cycles:4,' Cycles ');
  45.         writeln(duration:4,' Delay');
  46.         play;
  47.         interval := interval + 1; count := count + 2
  48.       end; {while count}
  49.       count := 1
  50.     end {while interval}
  51. end. {main}
  52.  
  53.  
  54.  
  55.