home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-386-Vol-2of3.iso
/
c
/
ctkit11.zip
/
CTSOUNDU.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-11-19
|
3KB
|
155 lines
unit CTSoundU;
interface
uses
crt, dos, ctu;
{
using:... SOUND DEMONSTRATION PROGRAM Version 1.00A
This program demonstrates TURBO PASCAL's standard procedures Sound,
Delay and NoSound on the IBM PC and true compatibles.
}
type
NoteRecord = record
C,CF,D,DF,E,F,FF,G,GF,A,AF,B: integer;
end;
Songs = record
l: Array[1..50] of byte;
n: array[1..50] of byte;
o: array[1..50] of byte;
end;
Var
Song: array[1..15] of songs;
SongFile: File;
ch: char;
saveold: pointer;
CurNote, CurSong: byte;
EndTime: longint;
Regs: registers;
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);
procedure PlaySong (WhichOne: integer);
implementation
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
if quiet then
exit;
if Note = 13 then
begin
Delay (Duration);
exit;
end;
Frequency := 32.625;
for I := 1 to Octave do { Compute C in Octave }
Frequency := Frequency * 2;
for I := 1 to Note - 1 do { Increase frequency Note-1 times }
Frequency := Frequency * 1.059463094;
if Duration <> 0 then
begin
Sound(Round(Frequency));
Delay(Duration);
NoSound;
end
else Sound(Round(Frequency));
end;
procedure PlayBG(Octave,Note: 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)
Note will be played until you activate procedure NoSound }
var
Frequency : real;
I : integer;
begin
if note = 13 then
exit;
Frequency := 32.625;
for I := 1 to Octave do { Compute C in Octave }
Frequency := Frequency * 2;
for I := 1 to Note - 1 do { Increase frequency Note-1 times }
Frequency := Frequency * 1.059463094;
Sound(Round(Frequency));
{ Delay(Duration);
NoSound; }
end;
Procedure DoSound; Interrupt;
begin
if CurSong = 0 then
exit;
regs.ah := 0;
intr($1a,regs);
if regs.dx >= endtime then
begin
NoSound;
inc(CurNote);
if (CurNote = 51) or (Song[CurSong].n[CurNote] = 0) then
begin
while (CurNote < 51) and (Song[CurSong].N[CurNote] = 0) do
inc(CurNote);
if CurNote = 51 then
begin
CurSong := 0;
SetIntVec($1c,saveold);
exit;
end;
end;
EndTime := Regs.dx+(Song[CurSong].L[CurNote]) div 2+1;
PlayBG(Song[CurSong].O[CurNote],Song[CurSong].N[CurNote]);
end;
end;
Procedure PlaySong (WhichOne: integer);
var t1: byte;
begin
if Quiet then
exit;
if Whichone = 0 then
begin
SetIntVec($1c,SaveOld);
CurSong := 0;
exit;
end;
SetIntVec($1c,@DoSound);
CurSong := WhichOne;
CurNote := 0;
EndTime := 0;
end;
begin
CurSong := 0;
FillChar (Song, SizeOf(Song), 0);
GetIntVec($1c,SaveOld);
end.