dos_compilers/Borland Turbo Pascal v2/SOUND.PAS
2024-06-30 15:28:49 -07:00

76 lines
1.7 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

program SoundDemo;
type
NoteRecord = record
C,CF,D,DF,E,F,FF,G,GF,A,AF,B: integer;
end;
Const
Notes: NoteRecord =
(C:1;CF:2;D:3;DF:4;E:5;F:6;FF:7;G:8;GF:9;A:10;AF:11;B:12);
procedure Play(Octave,Note,Duration: integer);
{ Play Note in Octave Duration milliseconds }
{ Frequency computed by first computing C in }
{ Octave then increasing frequency by Note-1 }
{ times the twelfth root of 2. (1.059463994) }
{ }
{ If Duration is zero Note will be played }
{ until you activate procedure NoSound }
var
Frequency: real;
I: integer;
begin
Frequency:=32.625;
{ Compute C in Octave }
for I:=1 to Octave do Frequency:=Frequency*2;
{ Increase frequency Note-1 times }
for I:=1 to Note-1 do Frequency:=Frequency*1.059463094;
if Duration<>0 then
begin
Sound(Round(Frequency));
Delay(Duration);
NoSound;
end else Sound(Round(Frequency));
end;
procedure SoftAlarm;
{ Play the notes G and D in octave three 7 times }
{ each with a duration of 70 milliseconds. }
var
I: integer;
begin
for I:=1 to 7 do with Notes do
begin
Play(4,G,70);
Play(4,D,70);
end;
Delay(1000);
end;
procedure Sirene;
var
Frequency: integer;
begin
for Frequency:= 500 to 2000 do begin Delay(1); Sound(Frequency); end;
for Frequency:=2000 downto 500 do begin Delay(1); Sound(Frequency); end;
end;
begin
writeln('Press any key to Stop');
repeat SoftAlarm until KeyPressed;
read(Kbd);
writeln('Press any key to Stop');
repeat Sirene until KeyPressed;
NoSound;
end.