home *** CD-ROM | disk | FTP | other *** search
/ PC Action 1998 January / PCA0198.ISO / MENUE / POSTFACH / 98012063.TXT < prev    next >
Text File  |  1997-11-25  |  3KB  |  162 lines
  1. 0
  2. Stereo-FM-SB-Unit.
  3. Der Zauberleerling
  4. Listings
  5. Unit SBlast;
  6.  
  7. interface
  8.  
  9. uses crt;
  10.  
  11. var Blasterfound : Boolean;
  12.  
  13. Procedure SwapChannels;
  14. Procedure SetChannel(Channel : Byte);
  15. Procedure SetAttack(Attack:Byte);
  16. Procedure SetRelease(Release:Byte);
  17. Procedure SetClearness(Clearness : Byte);
  18. Procedure PlayTone(Frequence : integer);
  19. Procedure StopTone;
  20. Procedure RestoreOldMode;
  21.  
  22. implementation
  23.  
  24. const KEYON     = $20;
  25.       FMP        = 8;
  26.  
  27. var   IOport : integer;
  28.       LEFT   : byte;
  29.       RIGHT  : byte;
  30.  
  31. function sbfind:integer;
  32. var   Basis, MaxPort, n,n2 : word;
  33. const TestCount=15; TestCount2=40;
  34. begin
  35. Basis:=$210; MaxPort:=$260; n:=TestCount;
  36. while n<=MaxPort do
  37.  begin
  38.   port[Basis+$6]:=1; port[Basis+$6]:=0; 
  39. n2:=TestCount2;
  40.   while (n2>0) and (port[Basis+$e] and 128=0) do 
  41. dec(n2); 
  42.   while (n2>0) and (port[Basis+$e] and 128=0) do 
  43. dec(n2);
  44.   if (n2=0) or (port[Basis+$a]<>$aa) then dec(n) 
  45. else
  46.     begin
  47.      sbfind:=Basis;
  48.      exit;
  49.     end;
  50.       Basis:=Basis+$10;
  51.    end;
  52.   sbfind:=-1;
  53. end;
  54. Procedure FMoutput(ioport, reg, val : integer);
  55. begin
  56.    port[ioport]:= reg;
  57.    delay(1);
  58.    port[ioport+1]:= val;
  59. end;
  60.  
  61. Procedure fm(reg, val : integer);
  62. begin
  63.    FMoutput(IOport+FMP, reg, val);
  64. end;
  65.  
  66. Procedure Profm(reg, val : integer);
  67. begin
  68.    FMoutput(IOport+2, reg, val);
  69. end;
  70.  
  71. {Befehle----------------------------------------
  72. -----------------------------}
  73.  
  74. Procedure SwapChannels;
  75. var temp : byte;
  76. begin
  77. if blasterfound then
  78. begin
  79. temp:=left;
  80. if temp = $20 then
  81. begin
  82. Right:=$20;
  83. Left:=$10;
  84. end
  85. else
  86. begin
  87. Right:=$10;
  88. Left:=$20;
  89. end;
  90. end;
  91. end;
  92.  
  93. Procedure SetChannel(Channel : Byte);
  94. begin
  95. if blasterfound then
  96. begin
  97. If Channel = 1 then fm($C0,LEFT+1);
  98. If Channel = 2 then fm($C0,LEFT+RIGHT+1);
  99. If Channel = 3 then fm($C0,RIGHT+1);
  100. end;
  101. end;
  102.  
  103. Procedure SetAttack(Attack:Byte); {Ton-Fadein}
  104. begin
  105. if blasterfound then if attack > 15 then 
  106. fm($63,Attack);
  107. end;
  108.  
  109. Procedure SetRelease(Release:Byte); 
  110. {Ton-Fadeout}
  111. begin
  112. if blasterfound then if Release < 16 then 
  113. fm($83,Release);
  114. end;
  115.  
  116. Procedure SetClearness(Clearness : Byte);
  117. begin
  118. if blasterfound then if clearness < 64 then 
  119. fm($40,Clearness);
  120. end;
  121.  
  122. Procedure PlayTone(Frequence : integer);
  123. begin
  124. if blasterfound then begin fm($A0,(Frequence and 
  125. $FF)); fm($b0,$32); end;
  126. end;
  127.  
  128. Procedure StopTone;
  129. begin
  130. If Blasterfound then fm($b0,$12);
  131. end;
  132.  
  133. Procedure RestoreOldMode;
  134. begin
  135. if blasterfound then Profm(5, 0);
  136. end;
  137.  
  138. {Init-------------------------------------------
  139. -----------------------------}
  140.  
  141. Begin
  142. left:=$20;
  143. right:=$10;
  144. Blasterfound:=false;
  145. ioport:=sbfind;
  146. if ioport<> -1 then
  147. begin
  148. Blasterfound:=true;
  149. fm(1,0);
  150. Profm(5, 1);
  151. fm($C0,LEFT+RIGHT+1);
  152. fm($23,$21);
  153. fm($43, $0);
  154. fm($63,255);
  155. fm($83,15); 
  156. fm($20,$20);
  157. fm($40,$3f);
  158. fm($60,$44);
  159. fm($80,$05);
  160. end;
  161. end.
  162.