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 / GENSND.PAS < prev    next >
Pascal/Delphi Source File  |  1979-12-31  |  4KB  |  175 lines
  1. program GENSND;
  2.  
  3. {  Demonstration sound effects program in
  4.   Turbo Pascal for the MicroBee, developed
  5.    by Bob Burt from his gensnd program on
  6.    page 41 of Wildcards Volume 2, written
  7.           in MicroWorld BASIC               }
  8.  
  9. const
  10.   space20 = '                    ';
  11.   title = '*** Sound Generator Routines ***';
  12. var
  13.   count,interval : integer;
  14.   set_tone,up_down,duration,duration2 : byte;
  15.   one_many,value,timbre,compare,counter : byte;
  16.  
  17. {$I gensnd.pro}
  18. {$I initsnd.pro}
  19.  
  20. procedure scale;
  21. begin
  22.     set_tone := count;     initsnd; gensnd;
  23.     set_tone := count + 2; initsnd; gensnd;
  24.     set_tone := count + 8; initsnd; gensnd;
  25.     set_tone := count + 6; initsnd; gensnd;
  26.     set_tone := count + 4; initsnd; gensnd;
  27.     count := count + interval
  28.   end; {procedure scale}
  29.  
  30. procedure rand_notes;
  31. begin
  32.   for count := 1 to 60 do
  33.   begin
  34.     value := random(200) + 55;
  35.     set_tone := value;
  36.     delay(50);
  37.     initsnd;
  38.     gensnd
  39.   end
  40. end; {procedure rand_notes}
  41.  
  42. begin {main}
  43.   clrscr;
  44.   write(space20);
  45.   writeln(title);
  46.   writeln;
  47.   write('Gensound '); gensnd;
  48.   write('Routine '); gensnd;
  49.   write('commences at '); gensnd;
  50.   write('memory '); gensnd;
  51.   write('location '); gensnd;
  52.   writeln(addr(gensnd)); gensnd;
  53.   writeln;
  54.   delay(1000);
  55.   set_tone := 240; {initialise procedure initsnd}
  56.   up_down := 5;
  57.   duration := 4;
  58.   duration2 := 0;
  59.   one_many := 32;
  60.   timbre := 65;
  61.   compare := 0;
  62.   writeln('Ascending Slide ..........');
  63.   initsnd; gensnd;
  64.   delay(1000);
  65.   writeln('Descending Slide .........');
  66.   set_tone := 32;
  67.   up_down := 4;
  68.   initsnd; gensnd;
  69.   delay(1000);
  70.   writeln('Siren ....................');
  71.   duration := 5;
  72.   for count := 1 to 2 do
  73.   begin
  74.     set_tone := 247;
  75.     up_down := 5;
  76.     initsnd; gensnd;
  77.     set_tone := 8;
  78.     up_down := 4;
  79.     initsnd; gensnd
  80.   end;
  81.   delay(1000);
  82.   writeln('Single Note ..............');
  83.   duration2 := 6;
  84.   set_tone := 25;
  85.   one_many := 40;
  86.   initsnd; gensnd;
  87.   delay(1000);
  88.   writeln('Musical Scale of Sorts ...');
  89.   duration := 110;
  90.   duration2 := 0;
  91.   count := 30; interval := -2;
  92.   while count > 1 do
  93.   scale;
  94.   count := 4; interval := 2;
  95.   while count < 33 do
  96.   scale;
  97.   delay(1000);
  98.   writeln('Random Notes .............');
  99.   duration := 8;
  100.   rand_notes;
  101.   delay(1000);
  102.   writeln('Chipmunk Chatter .........');
  103.   duration := 6;
  104.   timbre := 69;
  105.   rand_notes;
  106.   timbre := 65; {restore balance}
  107.   delay(1000);
  108.   writeln('Attention ! ..............');
  109.   up_down := 5;
  110.   compare := 1;
  111.   one_many := 32; {restore multiple notes}
  112.   for count := 1 to 20 do
  113.   begin
  114.     set_tone := (count)*2 + 5;
  115.     duration := 20 - (count div 2);
  116.     initsnd; gensnd;
  117.     delay(15)
  118.   end;
  119.   delay(1000);
  120.   writeln('Gobbled Up ! .............');
  121.   set_tone := 60;
  122.   duration := 1;
  123.   for count := 1 to 3 do
  124.   begin
  125.     initsnd; gensnd;
  126.     delay(200)
  127.   end;
  128.   delay(1000);
  129.   writeln('Rapid Fire ! .............');
  130.   for count := 1 to 50 do
  131.   begin
  132.     initsnd; gensnd;
  133.   end;
  134.   delay(1000);
  135.   writeln('Closing In ...............');
  136.   timbre := 69;
  137.   for count := 80 downto 30 do
  138.   begin
  139.     set_tone := (count)*3 - 25;
  140.     initsnd; gensnd
  141.   end;
  142.   timbre := 65;
  143.   delay(1000);
  144.   writeln('You are Surrounded ! .....');
  145.   count := 28; interval := -2;
  146.   while count > 1 do
  147.   scale;
  148.   count := 4; interval := 2;
  149.   while count < 31 do
  150.   scale;
  151.   delay(1000);
  152.   writeln('Random Laser Fire ........');
  153.   duration := 4;
  154.   for count := 1 to 30 do
  155.   begin
  156.     if (count mod 2) = 0 then
  157.       timbre := 65
  158.     else
  159.       timbre := 69;
  160.     set_tone := random(60) + 10;
  161.     initsnd; gensnd
  162.   end;
  163.   delay(1000);
  164.   writeln('Bird Warble ..............');
  165.   counter := 26;
  166.   duration := 12;
  167.   for count := 1 to 30 do
  168.   begin
  169.     if counter = 41 then counter := 26;
  170.     set_tone := counter;
  171.     initsnd; gensnd;
  172.     counter := counter + 1
  173.   end
  174. end. {main}
  175.