0
Stereo-FM-SB-Unit.
Der Zauberleerling
Listings
Unit SBlast;

interface

uses crt;

var Blasterfound : Boolean;

Procedure SwapChannels;
Procedure SetChannel(Channel : Byte);
Procedure SetAttack(Attack:Byte);
Procedure SetRelease(Release:Byte);
Procedure SetClearness(Clearness : Byte);
Procedure PlayTone(Frequence : integer);
Procedure StopTone;
Procedure RestoreOldMode;

implementation

const KEYON	 = $20;
      FMP        = 8;

var   IOport : integer;
      LEFT   : byte;
      RIGHT  : byte;

function sbfind:integer;
var   Basis, MaxPort, n,n2 : word;
const TestCount=15; TestCount2=40;
begin
Basis:=$210; MaxPort:=$260; n:=TestCount;
while n<=MaxPort do
 begin
  port[Basis+$6]:=1; port[Basis+$6]:=0; 
n2:=TestCount2;
  while (n2>0) and (port[Basis+$e] and 128=0) do 
dec(n2); 
  while (n2>0) and (port[Basis+$e] and 128=0) do 
dec(n2);
  if (n2=0) or (port[Basis+$a]<>$aa) then dec(n) 
else
    begin
     sbfind:=Basis;
     exit;
    end;
      Basis:=Basis+$10;
   end;
  sbfind:=-1;
end;
Procedure FMoutput(ioport, reg, val : integer);
begin
   port[ioport]:= reg;
   delay(1);
   port[ioport+1]:= val;
end;

Procedure fm(reg, val : integer);
begin
   FMoutput(IOport+FMP, reg, val);
end;

Procedure Profm(reg, val : integer);
begin
   FMoutput(IOport+2, reg, val);
end;

{Befehle----------------------------------------
-----------------------------}

Procedure SwapChannels;
var temp : byte;
begin
if blasterfound then
begin
temp:=left;
if temp = $20 then
begin
Right:=$20;
Left:=$10;
end
else
begin
Right:=$10;
Left:=$20;
end;
end;
end;

Procedure SetChannel(Channel : Byte);
begin
if blasterfound then
begin
If Channel = 1 then fm($C0,LEFT+1);
If Channel = 2 then fm($C0,LEFT+RIGHT+1);
If Channel = 3 then fm($C0,RIGHT+1);
end;
end;

Procedure SetAttack(Attack:Byte); {Ton-Fadein}
begin
if blasterfound then if attack > 15 then 
fm($63,Attack);
end;

Procedure SetRelease(Release:Byte); 
{Ton-Fadeout}
begin
if blasterfound then if Release < 16 then 
fm($83,Release);
end;

Procedure SetClearness(Clearness : Byte);
begin
if blasterfound then if clearness < 64 then 
fm($40,Clearness);
end;

Procedure PlayTone(Frequence : integer);
begin
if blasterfound then begin fm($A0,(Frequence and 
$FF)); fm($b0,$32); end;
end;

Procedure StopTone;
begin
If Blasterfound then fm($b0,$12);
end;

Procedure RestoreOldMode;
begin
if blasterfound then Profm(5, 0);
end;

{Init-------------------------------------------
-----------------------------}

Begin
left:=$20;
right:=$10;
Blasterfound:=false;
ioport:=sbfind;
if ioport<> -1 then
begin
Blasterfound:=true;
fm(1,0);
Profm(5, 1);
fm($C0,LEFT+RIGHT+1);
fm($23,$21);
fm($43, $0);
fm($63,255);
fm($83,15); 
fm($20,$20);
fm($40,$3f);
fm($60,$44);
fm($80,$05);
end;
end.