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