[Palm] Play.pas v2.1
Ilya V. Vasilyev
=== Play.pas ===
{ Play.pas version 2.1
(C) Ilya V. Vasilyev; 1,6 Mar 2005
Play one-channel foreground music
via PalmOS speaker, 120 notes.
Uses low-level module Sound.pas
This code is copylefted free software.
You can use, modify and distribute
this code under terms of FSF's
GNU Lesser General Public Licence
See www.gnu.org for details.
Contact me at sof...@rambler.ru
}
var
p_freqNote:Array[1..120] of 0..25000;
p_O:Integer=-1;
p_T:Integer=120;
p_L:Integer=1;
p_MBack:Integer=16;
p_M:Integer=16;
p_freqBase:Array[1..12] of Real=
(261.625565, 277.182631, 293.664768,
311.126984, 329.627557, 349.228231,
369.994423, 391.995436, 415.304698,
440.0, 466.163762, 493.883301);
procedure Play(S:String);
{ Entry Point: play MML string. }
var
n,j:Integer; cmd,c:Char;
flgShift:Boolean;
num,mfy,dots,oct,octBack:Integer;
procedure Init;
{ Must be called first and once. }
var
o:Integer; f:Real;
procedure OctIni;
{ Initialize octave #o with freq-s. }
var i:Integer;
begin
for i:=1 to 12 do
p_freqNote[o*12+i]:=
Round(p_freqBase[i]*f)
end; { OctIni() }
begin { Init() }
f:=1.0; for o:=4 to 9 do
begin OctIni; f:=f*2.0 end;
f:=1.0; for o:=3 downto 0 do
begin f:=f/2.0; OctIni end;
p_O:=4
end; { Init() }
procedure Note(N,L,D:Integer);
{ Play recognized note. }
var i,tp1,tp2:Integer; t:Real;
begin
t:=4.0*60000.0/(p_T*L);
for i:=1 to D do t:=t*3.0/2.0;
if N=0 then Delay(Round(t))
else if (N>0)and(N<=120) then
begin
tp1:=0;
if p_MBack<>0 then
begin
tp1:=Round(t/p_MBack);
Delay(tp1)
end;
if p_M<>0 then
begin
tp2:=Round(t/p_M);
Sound(p_freqNote[N],Round(t)-tp1-tp2);
Delay(tp2)
end
else Sound(p_freqNote[N],Round(t)-tp1);
p_MBack:=p_M
end { if 0<N<=120 }
end; { Note(N,L,D) }
procedure Start(c: Char);
{ Cleanup, first char of next command. }
begin
cmd:=c; octBack:=oct; oct:=0;
mfy:=0; num:=0; dots:=0
end;
procedure Flush;
{ Complete command recognition. }
var N,L: Integer;
begin
if cmd<>' ' then
begin
N:=-1;
case cmd of
'R','P': N:=0;
'C': N:=1;
'D': N:=3;
'E': N:=5;
'F': N:=6;
'G': N:=8;
'A': N:=10;
'B','H': N:=12;
'O': if (num>=0)and(num<=9)
then p_O:=num;
'N': if (num>=0)and(num<=120)
then N:=num;
'T': if (num>=32)and(num<=255)
then p_T:=num;
'L': if (num>0)and(num<=64)
then p_L:=num
end; { case cmd }
if N>=0 then
begin
if (N<>0)and(cmd<>'N') then
N:=N+(p_O+octBack)*12+mfy;
if num>0 then L:=num else L:=p_L;
if (N>=0)and(N<=120) then
Note(N,L,dots)
end { if N>=0 }
end { if cmd<>' ' }
end; { Flush() }
procedure NextAlpha(c:Char);
{ Next letter from parser. }
begin
if flgShift then
begin
case c of
'L': p_M:=0; { Legato }
'S': p_M:=8; { Staccato }
'N': p_M:=16 { Normal }
end;
flgShift:=False
end else
begin
if c='M' then flgShift:=True else
begin Flush; Start(c) end
end
end; { NextAlpha(c) }
begin { Play(S) }
if p_O<0 then Init;
n:=Length(S); flgShift:=False;
oct:=0; Start(' ');
for j:=1 to n do
begin
c:=S[j];
if (c>='A')and(c<='Z') then
NextAlpha(c)
else if (c>='a')and(c<='z') then
NextAlpha(chr(ord(c)-
ord('a')+ord('A')))
else if (c>='0')and(c<='9') then
num:=num*10+ord(c)-ord('0')
else case c of
'.': dots:=dots+1;
'>': oct:=oct-1;
'<': oct:=oct+1;
'-': mfy:=-1;
'+','#': mfy:=1
end { case c }
end; { for j }
Flush
end; { Play(S) }
=== Play.pas ===
=== tryit.pas ===
program tryit;
{$i Sound.pas}
{$i Play.pas}
begin
// 'Money' Pink Floyd
Play('O4L4MLBF#8>B8B >F#>ACDC');
Play('O4L4MNBF#8>B8B >F#>ACDC');
writeln('Press any key')
end.
=== tryit.pas ===
Bye,
Ilya V. Vasilyev