info-mac@uw-beaver (info-mac) (11/16/84)
From: shebanow%ucbernie@Berkeley (Mike Shebanow)
Here is a simple MaPascal program which plays a small Prelude by Chopin.
It uses MacPascal's builtin definitions of the sound driver functions to do
its stuff. Sorry about the rotten commenting, but MacPascal makes it difficult
to do. Program is in the public domain, please send any improvements or tune
changes to me ( I already have several tunes which use the same basic core).
A. Shebanow
shebanow@ucbernie
-----------------------------------------------------------------------------
{*******************************************************************}
{ Plays a simple tune using the four voice capabilities of the Mac }
{ Written By: Andrew G. Shebanow 10/25/84 }
{ Tune "converted" by John Hewitt & Andrew Shebanow }
{*******************************************************************}
program Sound;
const
Note32nd = 3; { multiply factors for the duration of... }
Rest32nd = 1; { the note and the rest }
{ constants for note values from "Inside Macintosh" }
NoNote = 0; { for unused voices }
Down1E = 124376;
Down1Gb = 141525;
Down1Ab = 159201;
Down1A = 165834;
Down1B = 186564;
MidD = 223877;
MidE = 248752;
MidAb = 318403;
MidA = 331669;
MidBb = 348253;
MidB = 373128;
Up1Db = 424537;
Up1D = 447754;
Up1E = 497504;
Up1Gb = 566100;
Up1Ab = 636806;
Up1A = 663339;
Up1B = 746257;
Up2Db = 849074;
var
wave1, wave2 : Wave; { the sound wave }
sndRec : FTSoundRec; { the four voice sound record }
synth : FTSynthRec; { the four voice sound header }
{ InitSounds initializes the sound structures }
procedure InitSounds;
{ InitWaves initializes the sound wave shape }
procedure InitWaves;
var
j : integer;
begin
for j := 0 to 31 do
begin
wave1[j] := 0;
wave2[j] := 0;
end;
for j := 32 to 63 do
begin
wave1[j] := 60;
wave2[j] := 10;
end;
for j := 64 to 191 do
begin
wave1[j] := 250;
wave2[j] := 70;
end;
for j := 192 to 224 do
begin
wave1[j] := 60;
wave2[j] := 10;
end;
for j := 225 to 255 do
begin
wave1[j] := 0;
wave2[j] := 0;
end;
end;
begin { InitSounds }
InitWaves;
sndRec.Sound1Wave := @wave1;
sndRec.Sound2Wave := @wave2;
sndRec.Sound3Wave := @wave2;
sndRec.Sound4Wave := @wave2;
sndRec.Sound1Phase := 0;
sndRec.Sound2Phase := 0;
sndRec.Sound3Phase := 0;
sndRec.Sound4Phase := 0;
synth.Mode := FTMode;
synth.SndRec := @sndRec;
end;
{ Rest is a delay loop which does the proper delay for a note}
procedure Rest (n : integer);
var
ticks : longint;
begin
ticks := TickCount + (Rest32nd * n);
while ticks >= TickCount do
;
end;
{ Play is the workhorse of the program. It plays a single 4 voice }
{ chord of the given duration using the four notes specified }
procedure Play (note1, note2, note3, note4 : longint;
n32nds : integer);
var
length : integer;
begin
length := n32nds * Note32nd;
sndRec.duration := length;
sndRec.Sound1Rate := note1;
sndRec.Sound2Rate := note2;
sndRec.Sound3Rate := note3;
sndRec.Sound4Rate := note4;
StartSound(@synth, sizeof(synth), pointer(-1));
Rest(1);
end;
{ Note that this tune is in 3/4 time. }
procedure Part1;
begin
Play(NoNote, MidE, NoNote, NoNote, 8); { Measure 0 }
Play(Down1E, MidAb, Up1Db, NoNote, 6); { Measure 1 }
Play(NoNote, Up1D, NoNote, NoNote, 2);
Play(NoNote, MidD, MidAb, MidB, 8);
Play(Down1B, MidD, MidAb, MidB, 8);
Play(Down1E, MidD, MidAb, MidB, 16); { Measure 2 }
Play(NoNote, Up1D, Up1Gb, NoNote, 8);
Play(NoNote, MidB, Up1D, NoNote, 4); { Measure 3 }
Play(NoNote, Up1Db, Up1E, NoNote, 4);
Play(Down1A, Up1Db, Up1E, Up1A, 8);
Play(Down1E, Up1Db, Up1E, Up1A, 8);
Play(Down1A, Up1Db, Up1E, Up1A, 16); { Measure 4 }
Play(NoNote, Up1Db, NoNote, NoNote, 8);
Play(Down1E, MidBb, NoNote, NoNote, 6); { Measure 5 }
Play(NoNote, MidB, NoNote, NoNote, 2);
Play(Down1B, Up1D, NoNote, NoNote, 8);
Play(Down1B, Up1D, NoNote, NoNote, 8);
end;
procedure Part2;
begin
Play(Down1Ab, Up1D, NoNote, NoNote, 8); { Measure 6 }
Play(Down1E, Up1D, NoNote, NoNote, 8);
Play(Down1B, MidAb, NoNote, NoNote, 8);
Play(Down1E, MidAb, NoNote, NoNote, 6); { Measure 7 }
Play(NoNote, MidA, NoNote, NoNote, 2);
Play(Down1A, MidA, Up1Db, NoNote, 8);
Play(Down1E, MidA, Up1Db, NoNote, 8);
Play(Down1A, MidA, Up1Db, NoNote, 16); { Measure 8 }
Play(NoNote, MidE, NoNote, NoNote, 8);
Play(Down1E, MidAb, Up1Db, NoNote, 6); { Measure 9 }
Play(NoNote, Up1D, NoNote, NoNote, 2);
Play(NoNote, MidD, MidAb, MidB, 8);
Play(Down1B, MidD, MidAb, MidB, 8);
Play(Down1E, MidD, MidAb, MidB, 16); { Measure 10 }
Play(NoNote, Up1D, Up1Gb, NoNote, 8);
Play(NoNote, MidB, Up1D, NoNote, 6); { Measure 11 }
Play(NoNote, Up1Db, Up1E, NoNote, 2);
Play(Down1A, Up1E, Up1A, Up2Db, 8);
Play(Down1E, Up1E, Up1A, Up2Db, 8);
end;
procedure Part3;
begin
Play(NoNote, Up1E, Up1A, Up2Db, 8); { Measure 12 }
Play(Down1Gb, NoNote, NoNote, NoNote, 8);
Play(NoNote, MidE, MidA, Up1Db, 8);
Play(Down1Gb, MidA, Up1Db, NoNote, 6); {Measure 13 }
Play(NoNote, MidB, Up1D, NoNote, 2);
Play(Down1B, MidB, Up1D, Up1Gb, 8);
Play(Down1A, MidB, Up1D, Up1Gb, 8);
Play(Down1Ab, MidB, Up1D, Up1Gb, 16); { Measure 14 }
Play(Down1E, MidB, Up1D, Up1Ab, 8);
Play(Down1E, Up1D, Up1E, Up1B, 6); { Measure 15 }
Play(NoNote, Up1A, NoNote, NoNote, 2);
Play(Down1A, Up1Db, Up1E, Up1A, 8);
Play(Down1E, Up1Db, Up1E, Up1A, 8);
Play(Down1A, Up1Db, Up1E, Up1A, 16); { Measure 16 }
Rest(8);
end;
begin { Sound }
InitSounds;
Part1;
Part2;
Part3;
end.
-----------------------------------------------------------------------------