[Palm] Play.pas
Ilya V. Vasilyev
Был бы у нас веб-сайт, можно было бы выложить весь архивчик Play.zip -- с
документацией и PDB'шками.
=== Play.pas ===
{ Play.pas version 1.0
(C) Ilya V. Vasilyev, 1 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
pfreqNotes:Array[1..120] of Integer;
pO,pT,pL:Integer;
procedure PlayInit;
var
o:Integer; f:Real;
procedure OctIni;
var z:Integer;
begin
z:=o*12+10;
pfreqNotes[z-9]:=Round(261.6256*f);
pfreqNotes[z-8]:=Round(277.1826*f);
pfreqNotes[z-7]:=Round(293.6648*f);
pfreqNotes[z-6]:=Round(311.1270*f);
pfreqNotes[z-5]:=Round(329.6276*f);
pfreqNotes[z-4]:=Round(349.2282*f);
pfreqNotes[z-3]:=Round(369.9944*f);
pfreqNotes[z-2]:=Round(391.9954*f);
pfreqNotes[z-1]:=Round(415.3047*f);
pfreqNotes[z]:=Round(440.0*f);
pfreqNotes[z+1]:=Round(466.1638*f);
pfreqNotes[z+2]:=Round(493.8833*f)
end;
begin { PlayInit }
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;
pO:=4; pT:=120; pL:=1
end; { PlayInit }
procedure Play(S:String);
var
i,n:Integer; pC,c:Char;
pN,num,mfy,dots,oct,octBack
:Integer;
procedure Note(N,L,D:Integer);
var i:Integer; t:Real;
begin
t:=4.0*60000.0/(pT*L);
for i:=1 to D do t:=t*3.0/2.0;
if N=0 then
{ Tell me, how to make delay, and I'll
make pause, MN and MS }
else if (N>0)and(N<=120) then
Sound(pfreqNotes[N],Round(t))
end;
procedure Clear(c: Char);
begin
pC:=c; octBack:=oct; oct:=0;
mfy:=0; num:=0; dots:=0
end;
procedure Flush;
var N,L: Integer;
begin
if pC<>' ' then
begin
N:=-1;
case pC 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 pO:=num;
'N': if (num>=0)and(num<=120)
then N:=num;
'T': if (num>=32)and(num<=255)
then pT:=num;
'L': if (num>0)and(num<=64)
then pL:=num
end;
if N>=0 then
begin
if (N<>0)and(pC<>'N') then
N:=N+(pO+octBack)*12+mfy;
if num>0 then L:=num else L:=pL;
if (N>=0)and(N<=120) then
Note(N,L,dots)
end { N>=0 }
end { pc<>' ' }
end;
procedure NextChar(c:Char);
begin
Flush; Clear(c)
end;
begin { Play }
n:=Length(S);
oct:=0; Clear(' ');
for i:=1 to n do
begin
c:=S[i];
if (c>='A')and(c<='Z') then
NextChar(c)
else if (c>='a')and(c<='z') then
NextChar(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 i }
Flush
end; { Play }
=== Play.pas ===
=== Sound.pas ===
{Sound Unit for PP compiler,[http://ppcompiler.free.fr]}
{by Levent B. Bayar aka laconf}
{happy coding.}
const
SYSTRAP = $4E4F;
SndMaxAmp=64;
sndCmdFreqDurationAmp =1;
type
UInt16 = 0..65535;
UInt8 = 0..255;
Int32 = integer;
pUInt8 = ^UInt8;
type SndCommandType = record
cmd_s:UInt8;
reserved:UInt8;
param1:Int32;
param2:UInt16;
param3:UInt16;
end;
SndCommandPtr=^SndCommandType;
//Actual PalmOS API
procedure SndDoCmd(channelP:pUInt8; cmdP:SndCommandPtr;noWait:
boolean);inline(SYSTRAP,$A233);
//----------
procedure sound(freq:Int32;duration:Uint16);
var snd:SndCommandType;
begin
snd.cmd_s:=sndCmdFreqDurationAmp;
snd.param1:=freq;
snd.param2:=duration;
snd.param3:=sndMaxAmp;
SndDoCmd(nil,@snd,false);
end;
procedure nosound;
begin
//not implemented yet.However palmos stops sound immediately after duration
//time expires.
end;
sound(1000,250);
sound(300,450);
end.
=== Sound.pas ===
=== tryit.pas ===
program tryit;
{$i Sound.pas}
{$i Play.pas}
begin
PlayInit;
// 'Money' Pink Floyd
Play('O4L4BF#8>B8B >F#>ACDC');
Play('O4L4BF#8>B8B >F#>ACDC');
writeln('Press any key')
end.
=== tryit.pas ===
Bye,
Ilya V. Vasilyev