home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
pascal
/
library
/
windows
/
wsound
/
winplay.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-12-17
|
11KB
|
326 lines
unit WinPlay;
(*
I'll make a confession that may shame me in front of my fellow
TurboPascal programmers: I used to enjoy using the Play statement in
GW-BASIC. It provided a pretty sensible way to get a musical phrase
out of a program. Certainly it was easier to use than TP's Sound
command, and much easier to use than the TPW Windows API calls that
deal with musical notes.
Here, then, is WinPlay, a TPW unit that emulates that BASIC command.
It makes it a snap to drop a musical phrase into a TPW program.
The syntax is simple: just give Play() a string consisting of note
names. Optionally you can specify things like octaves, tempo, note
types (like quarter, sixteenth, etc.), "music" type (like legato,
staccato, and normal), and a few other goodies.
In that Play string:
A..G : are the note names, as if on a keyboard.
P : means pause, or rest.
#,+ : mean sharp the immediately previous note.
- : means flat the immediately previous note.
. : means dot the immediately previous note.
Tnnn : tempo, sets the number of quarter notes in one
minute. Default is T120.
On : octave, sets the current octave, 0 through 6, that the
note names refer to. Default is O4, where C is an
octave above middle C. Pitches in an octave begin at
C and work upwards to B.
Lnn : length, sets the duration of notes that follow. 'n'
usually is a common note type like 8 for eighths, 4
for quarters, 1 for whole notes, etc. It may be any
number. Musician friends will giggle at you if you
program in 15th or 57th notes. 3, 6, and 12 might
commonly be used for triplets, though. Default is L4.
nn : a number following a note name or a pause means 'for
this specific instance only, set a temporary length.'
MS
MN
ML : "music" types of staccato, normal, or legato.
In staccato mode, the pitch is sounded for half the
indicated length followed by a rest of half the
length. In normal mode, the default, the ratio is 7/8
to 1/8. In legato mode, there is no articulating rest
-- repeated notes will not be distinguishable.
>
< : shorthand indicators to change up or down from the
current octave.
(A few commands from BASIC are not supported: N, X, V, MF, and MB.)
Case of the letters makes no difference. Embedded spaces, which can
make things much more readable, are ignored.
This simple example will play a G major scale starting in default
octave 4, at default quarter-note length, at default 120 tempo:
Play ('gab>cdef#g');
Careful perusal of the accompanying file, CELLO.PAS, a setting of a
movement from the Bach G Major Solo Suite for 'cello, will show all
the tricks in use.
The following source code is pretty liberally commented with some
oddities about using the Windows API sound functions. *)
interface
procedure Play (PlayString : string);
implementation
uses WinProcs, WinCRT;
const Magic : integer=376;
(*
Magic is used as a multiplier to determine the duration of a
note. The Windows API documentation for setVoiceSound
indicates that duration should be a straight forward
calculation of yea-so-many clock ticks. It just isn't so.
Brute force experimentation found 376. It seems to work fine
regardless of processor speed or whatever. I've tested on
386/33, 386/16, and 8088/4.7 machines -- they all work. Let
me tell you, it was sure fun setting up and running Windows on
that 8088/4.7 CGA equipment. *)
Tempo : integer = 120;
NoteType : integer = 4;
Octave : integer = 4;
Music : char = 'N';
C : integer = 0;
D : integer = 2;
E : integer = 4;
F : integer = 5;
G : integer = 7;
A : integer = 9;
B : integer = 11;
Pause : integer = $ff;
Base : array [0..6] of integer = (1,13,25,37,49,61,73);
var Pitch : array[0..84] of LongInt;
Herz : array[0..11] of Real;
SemiTone,Count,Multiplier,Power : integer;
Divisor : real;
procedure Play;
var p : integer;
AddDot : Boolean;
function GetNumber: integer;
var N,ErrorCode: integer;
S: string[4];
begin
N := 0;
S := '';
inc(p);
repeat
S := S + PlayString[p];
Inc(p);
until not (UpCase(PlayString[p]) in ['0'..'9'])
or (p > length(PlayString));
val(S,N,ErrorCode);
GetNumber := N;
dec(p);
end;
function Duration(Tempo,NoteType : integer) : integer;
var Temp : real;
begin
Temp := 60 / Tempo * Magic * 4 / NoteType;
If AddDot then Temp := Temp + Temp / 2;
Duration := trunc(Temp);
end;
procedure SetNote(Note : integer);
var SingleLength : boolean;
SaveNoteType : integer;
begin
SingleLength := false;
AddDot := false;
if p<length(PlayString) then
if PlayString[p+1] in ['#','+','-'] then
begin
inc(p);
case PlayString[p] of
'#','+' : inc(Note);
'-' : dec(Note);
end;
end;
if p<length(PlayString) then
if PlayString[p+1] in ['0'..'9'] then
begin
SaveNoteType := NoteType;
NoteType := GetNumber;
SingleLength := true;
end;
if p<length(PlayString) then
if PlayString[p+1] = '.' then
begin
AddDot := true;
inc(p);
end;
(*
The actual tone production routines follow. If you've explored
the API music functions at all, you may wonder why I'm using
setVoiceSound instead of setVoiceNote. setVoiceNote seems, on the
surface, to be the automatic way to write these sorts of things,
but it just doesn't work very well. Whole notes and half notes
are incorrectly produced, dots are impossible, and the nicety of
having legato is gone. setVoiceSound works much better, though it
does require that you calculate a duration rather than just
specifying tempo and length. *)
if Note = Pause then setVoiceSound(1,Pitch[0],Duration(Tempo,NoteType))
else
Case Music of
'N' : begin
setVoiceSound(1,Pitch[Base[Octave]+Note],
Duration(Tempo,NoteType) * 7 div 8 );
setVoiceSound(1,Pitch[0],Duration(Tempo,NoteType) * 1 div 8 );
end;
'S' : begin
setVoiceSound(1,Pitch[Base[Octave]+Note],
Duration(Tempo,NoteType) * 4 div 8 );
setVoiceSound(1,Pitch[0],Duration(Tempo,NoteType) * 4 div 8 );
end;
'L' : setVoiceSound(1,Pitch[Base[Octave]+Note],Duration(Tempo,NoteType));
end;
if SingleLength then NoteType := SaveNoteType;
end; {SetNote}
begin {Play main body}
repeat for p := 1 to length (PlayString) do
if PlayString[p] = ' ' then Delete (PlayString,p,1);
until pos(' ',PlayString) = 0;
OpenSound;
p := 1;
repeat
Case UpCase(PlayString[p]) of
'T' : Tempo := GetNumber;
'O' : Octave := GetNumber;
'L' : NoteType := GetNumber;
'M' : begin
inc(p);
Music := UpCase(PlayString[p]);
end;
'A' : SetNote(A);
'B' : SetNote(B);
'C' : SetNote(C);
'D' : SetNote(D);
'E' : SetNote(E);
'F' : SetNote(F);
'G' : SetNote(G);
'P' : SetNote(pause);
'>' : Inc(Octave);
'<' : Dec(Octave);
end; {Case}
inc(p);
until p > length (PlayString);
(*
I don't know why I've got to send one last 'empty' note to the
voice queue, but without it, the last real note doesn't get played.
That's the purpose of the next statement. *)
setVoiceSound(1,0,1);
setVoiceThreshold(1,0);
StartSound;
repeat until GetThresholdStatus = 1;
CloseSound;
end;
begin {WinPlay Unit initialization}
(*
I found a book with the appropriate frequencies for an octave of white
notes without much scouring around. I couldn't find the black notes,
so they are calculated values -- pretty close to what they should be,
with just a little insult to a really critical ear for intonation. *)
Herz[C] := 523.25;
Herz[D] := 587.33;
Herz[E] := 659.26;
Herz[F] := 698.46;
Herz[G] := 783.99;
Herz[A] := 880.00;
Herz[B] := 987.77;
Herz[C+1] := (Herz[C]+Herz[D]) /2;
Herz[D+1] := (Herz[D]+Herz[E]) /2;
Herz[F+1] := (Herz[F]+Herz[G]) /2;
Herz[G+1] := (Herz[G]+Herz[A]) /2;
Herz[A+1] := (Herz[A]+Herz[B]) /2;
(*
I was going to construct a table with the frequencies for all octaves.
My brother was appalled at such wasteful coding, and insisted on
figuring out a formula to do it from the known octave. I call his
effort The Formula From Hell. It works just fine, though. *)
for Count := 0 to 6 do begin
Power := 1;
for Multiplier := 0 to Count-1 do Power := Power *2;
Divisor := 16.0 / Power;
for SemiTone := 0 to 11 do
Pitch[Semitone+Base[Count]] := MakeLong(trunc(frac(Herz[SemiTone]/Divisor)),
trunc(int(Herz[SemiTone]/Divisor)));
end;
(*
That MakeLong(trunc(frac( and trunc(int( stuff is necessary because
Windows wants the fractional and integer portions of the frequency
stuffed respectively into the low and high words of a long integer.
Strange. *)
(*
setVoiceSound doesn't provide for a rest. Instead, I've plugged an
impossibly high pitch into the [0] slot of that array. It's
presumably playing, but you shouldn't hear it. *)
Pitch[0] := MakeLong(0,20000);
end.
(*
There's no error checking built into any of this. It didn't seem very
necessary. Much of the time, a nonsense value in the play string will
just fall on through and be ignored. Something like a T not followed
by a valid number will cause a run time error message, but I figure
the programmer is going to catch that sort of thing -- it will never
impact the end user.
Additionally, I didn't fiddle with the size of the "voice queue."
There are API calls to tweak it. If you write an unusually long
string, the last portion may fail to play. There's really no reason
to write such a long string, though. Break long strings into short
ones that fit neatly on the screen in the TPW editor. You'll probably
never run out of queue space.
Don Phillip Gibson
910 East 11th
Winfield, KS 67156
CompuServe [75725,1752]
December 17, 1991
*)