home *** CD-ROM | disk | FTP | other *** search
/ Programmer Power Tools / Programmer Power Tools.iso / turbopas / tlist23.arc / TEST.LIB < prev    next >
Encoding:
Text File  |  1987-12-20  |  1.8 KB  |  72 lines
  1. {.PTEPSON}                 { Only Processed If This File Is Listed By Itself }
  2. {.MHTest Library For Turbo Pascal Source Code Lister - @D - @T}  { This too! }
  3. {.MFVersion ##1.0                            Page - # -}         { This too! }
  4. {.PA}
  5. {
  6.      Play -
  7.  
  8.           This procedure will play a note in octave duration milliseconds.
  9.           The frequency is computed by first computing C in Octave then
  10.           increasing the frequency by Note-1 times the twelfth root of 2.
  11.           If the duration is zero the note will be played until you activate
  12.           the procedure NoSound.
  13.  
  14. }
  15. procedure Play(Octave,Note,Duration: integer);
  16.  
  17. var
  18.   Frequency: real;
  19.   I: integer;
  20.  
  21. begin { Play }
  22.   Frequency:=32.625;
  23.   { Compute C in Octave }
  24.   for I:=1 to Octave do Frequency:=Frequency*2;
  25.   { Increase frequency Note-1 times }
  26.   for I:=1 to Note-1 do Frequency:=Frequency*1.059463094;
  27.   if Duration<>0 then
  28.   begin
  29.     Sound(Round(Frequency));
  30.     Delay(Duration);
  31.     NoSound;
  32.   end else Sound(Round(Frequency));
  33. end; { Play }
  34.  
  35. {.PC20}
  36. {
  37.      SoftAlarm -
  38.  
  39.           This procedure will play the notes G and D in octave three,
  40.           seven times, each with a duration of 70 milliseconds.
  41.  
  42. }
  43. procedure SoftAlarm;
  44. var
  45.   I: integer;
  46.  
  47. begin { SoftAlarm }
  48.   for I:=1 to 7 do with Notes do
  49.   begin
  50.     Play(4,G,70);
  51.     Play(4,D,70);
  52.   end;
  53.   Delay(1000);
  54. end;  { SoftAlarm }
  55.  
  56. {.PC15}
  57. {
  58.      Sirene - 
  59.  
  60.           This procedure demonstrates the method used to generate
  61.           a sirene like sound.
  62.  
  63. }
  64. procedure Sirene;
  65. var
  66.   Frequency: integer;
  67.  
  68. begin { Sirene }
  69.   for Frequency:= 500 to     2000 do begin Delay(1); Sound(Frequency); end;
  70.   for Frequency:=2000 downto  500 do begin Delay(1); Sound(Frequency); end;
  71. end;  { Sirene }
  72.