Power-Programmierung/CD1.mdf/pascal/library/windows/wsound/winplay.pas

Pascal/Delphi Source File | 1991-12-17 | 10.6 KB | 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
*)