я в Паскале не силён от слова совсем, где тут может быть косяк ?//(C) Romanich
//Vladivostok
//2006
//Для компиляции необходим TMT Pascal MS DOS Edition Version 3.90
{$I+}
uses CRT;
label DAC;
const LPT=$378; //Базовый адрес LPT порта
var f:file;
Name:string;
Volume:dword;
Buffer:pointer;
i:dword;
Offset0,Offset:dword;
c:char;
Slow:word=25;
Mode:byte=2;
Divisor:byte=1;
P:byte=2;
procedure OffCursor;
assembler;
asm
mov ah,1
mov ch,$20
int $10
end;
procedure A1(b:byte);
begin
P:=P and $FB or b shl 2;
Port[LPT+2]:=P;
end;
procedure RES(b:byte);
begin
P:=P and $FE or not b and 1;
Port[LPT+2]:=P;
end;
procedure OutYM2612(Address,Data:byte);
begin
P:=P and $FD;
Port[LPT+2]:=P;
P:=P or 8;
Port[LPT+2]:=P;
Port[LPT]:=Address;
P:=P or 2;
Port[LPT+2]:=P;
P:=P and $FD;
Port[LPT+2]:=P;
P:=P and $F7;
Port[LPT+2]:=P;
Port[LPT]:=Data;
P:=P or 2;
Port[LPT+2]:=P;
end;
procedure ResetYM2612;
begin
A1(0);
RES(0);
RES(1);
RES(0);
A1(1);
RES(0);
RES(1);
RES(0);
end;
procedure Delay(Time:dword);
var i:dword;
begin
for i:=0 to Time*Slow*100 do;
end;
procedure ShowSlow;
begin
TextColor(2);
GotoXY(1,5);
Write('Slow[UP/DOWN]:');
TextColor(10);
GotoXY(15,5);
Write(' ');
GotoXY(15,5);
Write(Slow);
end;
procedure ShowMode;
begin
TextColor(3);
GotoXY(1,6);
Write('Mode[m,M]:');
TextColor(11);
GotoXY(11,6);
Write(' ');
GotoXY(11,6);
case Mode of
0:Write('DAC');
1:Write('FM');
2:Write('DAC+FM');
end;
end;
procedure ShowDivisor;
begin
TextColor(8);
GotoXY(1,7);
Write('PCM Slow[d,D]/');
TextColor(7);
GotoXY(15,7);
Write(' ');
GotoXY(15,7);
Write(Divisor);
end;
BEGIN
TextMode(CO40);
TextColor(1);
WriteLn('YM2612 VGM Player');
TextColor(9);
WriteLn('(C) Romanich 2006');
WriteLn;
TextColor(14);
Write('VGM Name:');
TextColor(15);
ReadLn(Name);
if Name='' then Halt;
OffCursor;
Assign(f,Name);
Reset(f,1);
Volume:=FileSize(f);
GetMem(Buffer,Volume);
BlockRead(f,Buffer^,Volume);
Close(f);
i:=MemD[DWORD(Buffer)+$34]+$34;
ShowSlow;
ShowMode;
ShowDivisor;
InLine($FA);
ResetYM2612;
repeat
case Mem[DWORD(Buffer)+i] of
$30..$50:Inc(i,2);
$51,$54..$5F,$A0..$BF:Inc(i,3);
$C0..$DF:Inc(i,4);
$E1..$FF:Inc(i,5);
$52:begin
if Mode<>0 then begin
A1(0);
if (Mode<>1) or (Mem[DWORD(Buffer)+i+1]<>$2B) then OutYM2612(Mem[DWORD(Buffer)+i+1],Mem[DWORD(Buffer)+i+2]);
end;
Inc(i,3);
end;
$53:begin
if Mode<>0 then begin
A1(1);
OutYM2612(Mem[DWORD(Buffer)+i+1],Mem[DWORD(Buffer)+i+2]);
end;
Inc(i,3);
end;
$61:begin
Delay(MemW[DWORD(Buffer)+i+1]);
Inc(i,3);
end;
$62:begin
Delay(735);
Inc(i);
end;
$63:begin
Delay(882);
Inc(i);
end;
$66:if MemD[DWORD(Buffer)+$1C]=0 then i:=MemD[DWORD(Buffer)+$34]+$34 else i:=MemD[DWORD(Buffer)+$1C]+$1C;
$67:begin
Offset0:=i+7;
Inc(i,MemD[DWORD(Buffer)+i+3]+7);
end;
$70..$7F:begin
Delay(Mem[DWORD(Buffer)+i] and $F+1);
Inc(i);
end;
$80..$8F:begin
A1(0);
DAC:
OutYM2612($2A,Mem[DWORD(Buffer)+Offset]);
Delay(Mem[DWORD(Buffer)+i] and $F div Divisor);
Inc(Offset);
Inc(i);
if Mem[DWORD(Buffer)+i] and $F0=$80 then goto DAC;
end;
$E0:begin
Offset:=MemD[DWORD(Buffer)+i+1]+Offset0;
Inc(i,5);
end;
else Inc(i);
end;
c:=#$FF;
if KeyPressed then c:=ReadKey;
case c of
#0:case ReadKey of
#72:begin
if Slow>999 then Slow:=1000 else Inc(Slow);
ShowSlow;
end;
#80:begin
if Slow<1 then Slow:=0 else Dec(Slow);
ShowSlow;
end;
end;
'm','M':begin
Inc(Mode);
if Mode>2 then Mode:=0;
A1(0);
case Mode of
0:begin
OutYM2612($21,$08);
OutYM2612($2B,$80);
end;
1:begin
OutYM2612($21,$00);
OutYM2612($2B,$00);
end;
2:begin
OutYM2612($21,$00);
OutYM2612($2B,$80);
end;
end;
ShowMode;
end;
'd','D':begin
Inc(Divisor);
if Divisor>16 then Divisor:=1;
ShowDivisor;
end;
end;
until c=#27;
ResetYM2612;
InLine($FB);
FreeMem(Buffer,Volume);
TextMode(CO80+Font8x8);
END.
