home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / sound.swg / 0047_Fm-voices.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-24  |  2.4 KB  |  87 lines
  1. {
  2. Could somebody tell me how to program the FM-voices of my sound-blaster ?
  3.  
  4. Here's a .sbi player for you...
  5. }
  6. program SBIread;
  7. uses Crt;
  8. const SBIREG : array[1..11] of Word =
  9.   ($20,$23,$40,$43,$60,$63,$80,$83,$E0,$E3,$C0);
  10. var
  11.   FromF: file;
  12.   I: integer;
  13.   FN: string;
  14.   NumRead, NumWritten: Word;
  15.   buf: array[1..2048] of Char;
  16.   ch: char;
  17.   IsSBI: boolean;
  18.   SBIName: string;
  19. procedure Bit;
  20. begin
  21.   Delay(1); {something fancier was suggested, but this works fine}
  22. end;                                                                           
  23.  
  24. function CheckSoundCard: boolean;
  25. var Temp, Temp2: byte;
  26. begin
  27.   port[$388]:=$4; repeat until Port[$22E] > 127;
  28.   port[$389]:=$60; repeat until Port[$22E] > 127;
  29.   port[$389]:=$80; repeat until Port[$22E] > 127;
  30.   Temp:=port[$388];
  31.   port[$388]:=$2; repeat until Port[$22E] > 127;
  32.   port[$389]:=$FF; repeat until Port[$22E] > 127;
  33.   port[$388]:=$4; repeat until Port[$22E] > 127;
  34.   port[$389]:=$21; repeat until Port[$22E] > 127;
  35.   Delay(1);
  36.   Temp2:=port[$388];
  37.   port[$388]:=$4; repeat until Port[$22E] > 127;
  38.   port[$389]:=$60; repeat until Port[$22E] > 127;
  39.   port[$389]:=$80; repeat until Port[$22E] > 127;
  40.   If ((temp and $E0)=$00) and ((temp2 and $E0)=$c0) then
  41.     CheckSoundCard:=True else CheckSoundCard:=False;
  42. end;
  43. procedure ClearCard;
  44. var CP: byte;
  45. begin
  46.   For CP:=0 to 255 do begin
  47.     port[$388]:=CP;
  48.     port[$389]:=0;
  49.   end;
  50. end;
  51. procedure Sounder(A,B: byte);
  52. begin
  53.   port[$388]:=A; Bit;
  54.   port[$389]:=B; Bit;
  55. end;
  56. begin
  57.   Writeln('SBI file player');
  58.   if not CheckSoundCard then begin
  59.     writeln('Soundcard not detected!');
  60.     halt(1);
  61.   end;
  62.   FN:=ParamStr(1);
  63.   If Pos('.',FN)=0 then FN:=FN+'.SBI';
  64.   Assign(FromF, FN);
  65.   Reset(FromF, 1);
  66.   BlockRead(FromF,buf,SizeOf(buf),NumRead);
  67.   Close(FromF);
  68.   If (buf[1]='S') and (buf[2]='B') and (buf[3]='I') and (ord(buf[4])=26)
  69.     then IsSBI:=True else IsSBI:=False;
  70.   If IsSBI=False then Writeln('Not a SBI file!') else begin
  71.     SBIName:='';
  72.     I:=4;
  73.     repeat
  74.       i:=i+1;
  75.       if (ord(buf[i])<>0) then SBIName:=SBIName+buf[i];
  76.     until ord(buf[i])=0;
  77.     Writeln('Name of file      : ',FN);
  78.     Writeln('Name of instrument: ',SBIName);
  79.     ClearCard;
  80.     for i:=1 to 11 do Sounder(SBIreg[i],ord(buf[i+36]));
  81.     Sounder($A0,$58);
  82.     Sounder($B0,$31);
  83.     Delay(900);
  84.     ClearCard;
  85.   end;
  86. end.
  87.