Mapcon
05-11-2002, 08:13 PM
ngờ uồn : Lưu Văn Minh ( Tạp chí Tin Học & Nhà Trường)
{ Không biết có phải Lưu Văn Minh là bác Minh "meo" lớp Tin 97-00 của thầy Ánh không ! }
{------------------------------------------------}
unit sound;
interface
uses
Crt, Dos;
const
DMA = 4096;
type
TId = array [1..4] of Char;
TRiff = record
rIdent: TId;
Length: LongInt;
wIdent: TId;
fIdent: TId;
sLength: LongInt;
wFormat,
wModus: Word;
lFreq,
lBytePS: LongInt;
wByteSam,
wBitSam: Word;
dIdent: TId;
dLength: LongInt;
end;
TBlaster = record
wPort: Word;
bDMAc,
bHDMAc,
bIRQ: Byte;
end;
TBuffer = array[1..DMA] of Byte;
procedure SetStereo;
procedure ClearStereo;
function PlayWave(st: string): byte;
implementation
const
RIFF: TId = ('R','I','F','F');
WAVE: Tid = ('W','A','V','E');
FMT : Tid = ('f','m','t',' ');
DATA: Tid = ('d','á,'t','á);
DMADat: array[0..7, 1..6] of Byte = (($A, $C, $B, $0, $87, $1),
($A, $C, $B, $2, $83, $3),
($A, $C, $B, $4, $81, $5),
($A, $C, $B, $6, $82, $7),
($D4, $D8, $D6, $C0, $8F, $C2),
($D4, $D8, $D6, $C4, $8B, $C6),
($D4, $D8, $D6, $C8, $89, $CA),
($D4, $D8, $D6, $CC, $8A, $CE));
var
Blaster: TBlaster;
Riff_: TRiff;
bChannel: Byte;
bfDMA1,
bfDMA2,
bfzwi: ^TBuffer;
EndOf: Boolean;
OldIRQ: Pointer;
procedure BlasterCommand(c :Byte); assembler;
asm
mov dx, Word Ptr Blaster.wPort
ađ dx, $c
@t:in al, dx
and al, 128
jnz @t
mov al, c
out dx, al
end;
procedure Init_SB(wBase: Word);
var w, w2: Word;
begin
Port[wBase + 6] := 1;
Delay(4);
Port[wBase + 6] := 0;
w := 0;
w2 := 0;
repeat
repeat
Inc(w);
until ((Port[wBase + $e] and 128) = 128) or (w > 29);
Inc(w2);
until (Port[wBase + $a] = $AA) or (W2 > 30);
if w2 > 30 then
begin
WriteLn('Failed to reset blaster');
Halt(128);
end;
BlasterCommand($d1);
End;
procedure Init;
var
BlastEnv: string;
b: Byte;
begin
WriteLn;
Blaster.wPort := 0;
Blaster.bDMAc := 0;
Blaster.bHDMAc := 0;
Blaster.bIRQ := 0;
BlastEnv := GetEnv('BLASTER');
if BlastEnv = '' then
begin
WriteLn('BLASTER must be set...');
Halt(100);
end;
b:=1;
repeat
case BlastEnv[b] of
'A' : repeat
Inc(B);
Blaster.wPort := Blaster.wPort * 16 + Ord(BlastEnv[b]) - 48;
until BlastEnv[b + 1] = ' ';
'D' : begin
Blaster.bDMAc := Ord(BlastEnv[b + 1]) - 48;
Inc(b, 2);
end;
'I' : repeat
Inc(B);
Blaster.bIRQ := Blaster.bIRQ * 10 + Ord(BlastEnv[b]) - 48;
until BlastEnv[b + 1] = ' ';
'H' : begin
Blaster.bHDMAc := Ord(BlastEnv[b + 1]) - 48;
Inc(b, 2);
end;
end;
Inc(B);
until b > Length(BlastEnv);
With Blaster do
WriteLn('Blaster : P', wPort, ' I',bIRQ, ' D', bDMAc, ' H', bHDMAc);
Init_SB(Blaster.wPort);
end;
procedure SetStereo; assembler;
asm
mov dx, Word Ptr Blaster.wPort
ađ dx, $4
mov al, $e
out dx, al
inc dx
in al, dx
and al, 253
or al, 2
out dx, al
end;
procedure ClearStereo; assembler;
asm
mov dx, Word Ptr Blaster.wPort
ađ dx, $4
mov al, $e
out dx, al
idiv al
inc dx
in al, dx
and al, 253
out dx, al
end;
function NoWave(var Riff_: TRiff): Boolean;
Begin
With Riff_ do
NoWave := (rIdent <> RIFF) or
(wIdent <> WAVE) or
(fIdent <> FMT ) or
(dIdent <> DATA);
End;
{$F+}
procedure SetDMĂlFreq: LongInt; var wSize: Word);
var
wPageNr,
wPageAdress,
wDMALength: Word;
begin
inline($FA);
asm
mov ax, Word Ptr bfDMA1[2]
shr ax, 12
mov Word Ptr wPageNr, ax
mov ax, Word Ptr bfDMA1[2]
shl ax, 4
mov Word Ptr wPageAdress, ax
mov ax, Word Ptr bfDMA1
ađ Word Ptr wPageAdress, ax
adc Word Ptr wPageNr, 0
end;
wDMALength := wSize;
lFreq := 256 - Round(1000000 / lFreq);
if bChannel > 3 then
begin
wDMALength := wDMALength div 2;
wPageAdress := wPageAdress div 2;
if Ođ(wPageNr) then
begin
Dec(wPageNr);
wPageAdress := wPageAdress + $8000
end;
end;
if Riff_.wModus = 2 then
if Riff_.wBitSam = 16 then BlasterCommand($A4)
else BlasterCommand($A8)
else
if Riff_.wBitSam = 16 then BlasterCommand($A4);
Dec(wDMALength);
Port[DMADat[bChannel, 1]] := $4 or (bChannel and $3);
Port[DMADat[bChannel, 2]] := $0;
Port[DMADat[bChannel, 3]] := $49;
Port[DMADat[bChannel, 4]] := lo(wPageAdress);
Port[DMADat[bChannel, 4]] := hi(wPageAdress);
Port[DMADat[bChannel, 5]] := lo(wPageNr);
Port[DMADat[bChannel, 6]] := lo(wDMALength);
Port[DMADat[bChannel, 6]] := hi(wDMALength);
Port[DMADat[bChannel, 1]] := (bChannel and $3);
BlasterCommand($40);
BlasterCommand(Lo(Word(lFreq)));
if Riff_.wModus = 1 then
begin
BlasterCommand($14);
BlasterCommand(lo(wDMALength));
BlasterCommand(hi(wDMALength));
end
else
begin
BlasterCommand($48);
BlasterCommand(lo(wDMALength));
BlasterCommand(hi(wDMALength));
BlasterCommand($91);
end;
inline($FB);
end;
procedure SB_IRQ; interrupt;
var
bTest: Byte;
begin
inline($FA);
Port[$20] := $20;
bTest := Port[Blaster.wPort + $e];
EndOf := True;
inline($FB);
end;
{$F-}
function PlayWave;
var
hFile: file;
wp,
ws,
ws2: Word;
lFreq: LongInt;
begin
Assign(hFile, st);
{$I-}
Reset(hFile, 1);
if IoResult <> 0 then
begin
WriteLn('File '', st, '' not found');
Close(hFile);
Halt(2);
end;
{$I+}
BlockRead(hFile, Riff_, Sizeof(RIff_));
if NoWave(Riff_) then
begin
WriteLn(''', st, '' seem to be no WAVE-File...');
Close(hFile);
Halt(128);
end;
if Riff_.wModus = 2 then SetStereo
else ClearStereo;
if (Riff_.wBitSam > 8) and (Blaster.bhDMAc > 3) then bChannel := Blaster.bhDMAc
else bChannel := Blaster.bDMAc;
WriteLn('Playing...');
GetMem(bfzwi, 16);
GetMem(bfDMA1, DMA);
wp:=16;
while ((Seg(bfDMA1^[1]) mod 4096) > (4096 - (DMA * 2 div 16))) do
begin
FreeMem(bfDMA1, DMA);
FreeMem(bfzwi, wp);
wp := wp + 16;
if wp > 65525 then Halt(111);
GetMem(bfzwi, wp);
GetMem(bfDMA1, DMA);
end;
GetMem(bfDMA2, DMA);
FreeMem(bfzwi, wp);
GetIntVec(Blaster.bIRQ+8, OldIRQ);
SetIntVec(Blaster.bIRQ+8, @SB_IRQ);
Port[$21] := Port[$21] and (255 xor (1 shl Blaster.bIRQ));
lFreq:=Riff_.lFreq * Riff_.wModus;
BlockRead(hFile, bfDMA1^[1], DMA, ws);
repeat
EndOf := False;
SetDMĂlFreq, ws);
BlockRead(hFile, bfDMA2^[1], DMA, ws2);
repeat until EndOf;
ws := ws2;
bfzwi := bfDMA1;
bfDMA1 := bfDMA2;
bfDMA2 := bfzwi;
until Eof(hFile) or Keypressed;
while KeyPressed do ws2 := Ord(ReadKey);
if Eof(hFile) then
begin
EndOf := False;
SetDMĂlFreq, ws);
repeat until EndOf;
end;
SetIntVec(Blaster.bIRQ + 8, OldIRQ);
FreeMem(bfDMA1, DMA);
FreeMem(bfDMA2, DMA);
Port[$21] := Port[$21] or (1 shl Blaster.bIRQ);
BlasterCommand($d3);
Close(hFile);
end;
begin
Init;
Để sử dụng được unit này chúng ta chỉ cần khai báo:
uses Sound
và dùng hàm PlayWave(st) để chơi file wave (st là tên và đường dẫn của file)
{ Không biết có phải Lưu Văn Minh là bác Minh "meo" lớp Tin 97-00 của thầy Ánh không ! }
{------------------------------------------------}
unit sound;
interface
uses
Crt, Dos;
const
DMA = 4096;
type
TId = array [1..4] of Char;
TRiff = record
rIdent: TId;
Length: LongInt;
wIdent: TId;
fIdent: TId;
sLength: LongInt;
wFormat,
wModus: Word;
lFreq,
lBytePS: LongInt;
wByteSam,
wBitSam: Word;
dIdent: TId;
dLength: LongInt;
end;
TBlaster = record
wPort: Word;
bDMAc,
bHDMAc,
bIRQ: Byte;
end;
TBuffer = array[1..DMA] of Byte;
procedure SetStereo;
procedure ClearStereo;
function PlayWave(st: string): byte;
implementation
const
RIFF: TId = ('R','I','F','F');
WAVE: Tid = ('W','A','V','E');
FMT : Tid = ('f','m','t',' ');
DATA: Tid = ('d','á,'t','á);
DMADat: array[0..7, 1..6] of Byte = (($A, $C, $B, $0, $87, $1),
($A, $C, $B, $2, $83, $3),
($A, $C, $B, $4, $81, $5),
($A, $C, $B, $6, $82, $7),
($D4, $D8, $D6, $C0, $8F, $C2),
($D4, $D8, $D6, $C4, $8B, $C6),
($D4, $D8, $D6, $C8, $89, $CA),
($D4, $D8, $D6, $CC, $8A, $CE));
var
Blaster: TBlaster;
Riff_: TRiff;
bChannel: Byte;
bfDMA1,
bfDMA2,
bfzwi: ^TBuffer;
EndOf: Boolean;
OldIRQ: Pointer;
procedure BlasterCommand(c :Byte); assembler;
asm
mov dx, Word Ptr Blaster.wPort
ađ dx, $c
@t:in al, dx
and al, 128
jnz @t
mov al, c
out dx, al
end;
procedure Init_SB(wBase: Word);
var w, w2: Word;
begin
Port[wBase + 6] := 1;
Delay(4);
Port[wBase + 6] := 0;
w := 0;
w2 := 0;
repeat
repeat
Inc(w);
until ((Port[wBase + $e] and 128) = 128) or (w > 29);
Inc(w2);
until (Port[wBase + $a] = $AA) or (W2 > 30);
if w2 > 30 then
begin
WriteLn('Failed to reset blaster');
Halt(128);
end;
BlasterCommand($d1);
End;
procedure Init;
var
BlastEnv: string;
b: Byte;
begin
WriteLn;
Blaster.wPort := 0;
Blaster.bDMAc := 0;
Blaster.bHDMAc := 0;
Blaster.bIRQ := 0;
BlastEnv := GetEnv('BLASTER');
if BlastEnv = '' then
begin
WriteLn('BLASTER must be set...');
Halt(100);
end;
b:=1;
repeat
case BlastEnv[b] of
'A' : repeat
Inc(B);
Blaster.wPort := Blaster.wPort * 16 + Ord(BlastEnv[b]) - 48;
until BlastEnv[b + 1] = ' ';
'D' : begin
Blaster.bDMAc := Ord(BlastEnv[b + 1]) - 48;
Inc(b, 2);
end;
'I' : repeat
Inc(B);
Blaster.bIRQ := Blaster.bIRQ * 10 + Ord(BlastEnv[b]) - 48;
until BlastEnv[b + 1] = ' ';
'H' : begin
Blaster.bHDMAc := Ord(BlastEnv[b + 1]) - 48;
Inc(b, 2);
end;
end;
Inc(B);
until b > Length(BlastEnv);
With Blaster do
WriteLn('Blaster : P', wPort, ' I',bIRQ, ' D', bDMAc, ' H', bHDMAc);
Init_SB(Blaster.wPort);
end;
procedure SetStereo; assembler;
asm
mov dx, Word Ptr Blaster.wPort
ađ dx, $4
mov al, $e
out dx, al
inc dx
in al, dx
and al, 253
or al, 2
out dx, al
end;
procedure ClearStereo; assembler;
asm
mov dx, Word Ptr Blaster.wPort
ađ dx, $4
mov al, $e
out dx, al
idiv al
inc dx
in al, dx
and al, 253
out dx, al
end;
function NoWave(var Riff_: TRiff): Boolean;
Begin
With Riff_ do
NoWave := (rIdent <> RIFF) or
(wIdent <> WAVE) or
(fIdent <> FMT ) or
(dIdent <> DATA);
End;
{$F+}
procedure SetDMĂlFreq: LongInt; var wSize: Word);
var
wPageNr,
wPageAdress,
wDMALength: Word;
begin
inline($FA);
asm
mov ax, Word Ptr bfDMA1[2]
shr ax, 12
mov Word Ptr wPageNr, ax
mov ax, Word Ptr bfDMA1[2]
shl ax, 4
mov Word Ptr wPageAdress, ax
mov ax, Word Ptr bfDMA1
ađ Word Ptr wPageAdress, ax
adc Word Ptr wPageNr, 0
end;
wDMALength := wSize;
lFreq := 256 - Round(1000000 / lFreq);
if bChannel > 3 then
begin
wDMALength := wDMALength div 2;
wPageAdress := wPageAdress div 2;
if Ođ(wPageNr) then
begin
Dec(wPageNr);
wPageAdress := wPageAdress + $8000
end;
end;
if Riff_.wModus = 2 then
if Riff_.wBitSam = 16 then BlasterCommand($A4)
else BlasterCommand($A8)
else
if Riff_.wBitSam = 16 then BlasterCommand($A4);
Dec(wDMALength);
Port[DMADat[bChannel, 1]] := $4 or (bChannel and $3);
Port[DMADat[bChannel, 2]] := $0;
Port[DMADat[bChannel, 3]] := $49;
Port[DMADat[bChannel, 4]] := lo(wPageAdress);
Port[DMADat[bChannel, 4]] := hi(wPageAdress);
Port[DMADat[bChannel, 5]] := lo(wPageNr);
Port[DMADat[bChannel, 6]] := lo(wDMALength);
Port[DMADat[bChannel, 6]] := hi(wDMALength);
Port[DMADat[bChannel, 1]] := (bChannel and $3);
BlasterCommand($40);
BlasterCommand(Lo(Word(lFreq)));
if Riff_.wModus = 1 then
begin
BlasterCommand($14);
BlasterCommand(lo(wDMALength));
BlasterCommand(hi(wDMALength));
end
else
begin
BlasterCommand($48);
BlasterCommand(lo(wDMALength));
BlasterCommand(hi(wDMALength));
BlasterCommand($91);
end;
inline($FB);
end;
procedure SB_IRQ; interrupt;
var
bTest: Byte;
begin
inline($FA);
Port[$20] := $20;
bTest := Port[Blaster.wPort + $e];
EndOf := True;
inline($FB);
end;
{$F-}
function PlayWave;
var
hFile: file;
wp,
ws,
ws2: Word;
lFreq: LongInt;
begin
Assign(hFile, st);
{$I-}
Reset(hFile, 1);
if IoResult <> 0 then
begin
WriteLn('File '', st, '' not found');
Close(hFile);
Halt(2);
end;
{$I+}
BlockRead(hFile, Riff_, Sizeof(RIff_));
if NoWave(Riff_) then
begin
WriteLn(''', st, '' seem to be no WAVE-File...');
Close(hFile);
Halt(128);
end;
if Riff_.wModus = 2 then SetStereo
else ClearStereo;
if (Riff_.wBitSam > 8) and (Blaster.bhDMAc > 3) then bChannel := Blaster.bhDMAc
else bChannel := Blaster.bDMAc;
WriteLn('Playing...');
GetMem(bfzwi, 16);
GetMem(bfDMA1, DMA);
wp:=16;
while ((Seg(bfDMA1^[1]) mod 4096) > (4096 - (DMA * 2 div 16))) do
begin
FreeMem(bfDMA1, DMA);
FreeMem(bfzwi, wp);
wp := wp + 16;
if wp > 65525 then Halt(111);
GetMem(bfzwi, wp);
GetMem(bfDMA1, DMA);
end;
GetMem(bfDMA2, DMA);
FreeMem(bfzwi, wp);
GetIntVec(Blaster.bIRQ+8, OldIRQ);
SetIntVec(Blaster.bIRQ+8, @SB_IRQ);
Port[$21] := Port[$21] and (255 xor (1 shl Blaster.bIRQ));
lFreq:=Riff_.lFreq * Riff_.wModus;
BlockRead(hFile, bfDMA1^[1], DMA, ws);
repeat
EndOf := False;
SetDMĂlFreq, ws);
BlockRead(hFile, bfDMA2^[1], DMA, ws2);
repeat until EndOf;
ws := ws2;
bfzwi := bfDMA1;
bfDMA1 := bfDMA2;
bfDMA2 := bfzwi;
until Eof(hFile) or Keypressed;
while KeyPressed do ws2 := Ord(ReadKey);
if Eof(hFile) then
begin
EndOf := False;
SetDMĂlFreq, ws);
repeat until EndOf;
end;
SetIntVec(Blaster.bIRQ + 8, OldIRQ);
FreeMem(bfDMA1, DMA);
FreeMem(bfDMA2, DMA);
Port[$21] := Port[$21] or (1 shl Blaster.bIRQ);
BlasterCommand($d3);
Close(hFile);
end;
begin
Init;
Để sử dụng được unit này chúng ta chỉ cần khai báo:
uses Sound
và dùng hàm PlayWave(st) để chơi file wave (st là tên và đường dẫn của file)