home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / sound / adlib / play.pas
Encoding:
Pascal/Delphi Source File  |  1991-01-19  |  9.7 KB  |  441 lines
  1. unit MusicIO;
  2. {Contains procedures and function to call to Ad-Lib sound Driver.
  3.  if Sound Driver is not Loaded the system WILL Crash.
  4.  Parameters must be passed backwards since the sound driver is made
  5.  for a C parameter passing sequence.}
  6.  
  7. interface
  8.  
  9.   uses
  10.     DOS;
  11.  
  12.   type
  13.     Instrument = array[1..26] of integer;
  14.  
  15.   var
  16.     GActVoice :word; {Active Voice}
  17.     GT        :array[0..10] of Instrument; {use global variable to keep array valid}
  18.  
  19.   procedure InitDriver;
  20.   procedure RelTimeStart(TimeNum,TimeDen :integer);
  21.   procedure SetState(State :integer);
  22.   function GetState :boolean;
  23.   procedure SetMode(PercussionMode :integer);
  24.   function SetVolume(VolNum,VolDen,TimeNum,TimeDen :integer) :boolean;
  25.   function SetTempo(Tempo,TimeNum,TimeDen :integer) :boolean;
  26.   procedure SetActVoice(Voice :word);
  27.   function PlayNote(Pitch :integer; LengthNum,LengthDen :word) :boolean;
  28.   function SetTimbre(TimeNum,TimeDen :word) :boolean;
  29.   procedure SetTickBeat(TickBeat :integer);
  30.   procedure DirectNoteOn(Voice :word; Pitch :integer);
  31.   procedure DirectNoteOff(Voice :word);
  32.   procedure DirectTimbre;
  33.   procedure LoadInstrument(FileSpec :string);
  34.   function LoadSong(FileSpec :string) :boolean;
  35.  
  36.  
  37. implementation
  38.  
  39.   {Returns True if file exists; otherwise, it returns False. Closes the file if it exists.}
  40.   function Exist(fs :string) :boolean;
  41.     var
  42.       f: file;
  43.     begin
  44.       {$I-}
  45.       Assign(f,fs);
  46.       Reset(f);
  47.       Close(f);
  48.       {$I+}
  49.       Exist:=(IOResult=0) and (fs<>'');
  50.     end;
  51.  
  52.  
  53.   procedure InitDriver;
  54.     {Initialize Sound Driver}
  55.     Var
  56.       r :registers; TmpP:Pointer;
  57.     Begin
  58.       GetIntVec(101,TmpP);
  59.       If TmpP = Nil Then
  60.       Begin
  61.          WriteLn('Sound Driver Not Installed!');
  62.          Halt(0);
  63.       End;
  64.  
  65.       R.SI:=0;
  66.       Intr(101,r);
  67.     End;
  68.  
  69.   procedure RelTimeStart(TimeNum,TimeDen :integer);
  70.     {Set Relative Time to Start}
  71.     var
  72.       TD,TN :integer;
  73.       r :registers;
  74.     begin
  75.       TD:=TimeDen;
  76.       TN:=TimeNum;
  77.  
  78.       r.SI:=2;
  79.       r.ES:=Seg(TN);
  80.       r.BX:=Ofs(TN);
  81.  
  82.       Intr(101,r);
  83.     end;
  84.  
  85.   procedure SetState(State :integer);
  86.     {Start or Stop a Song}
  87.     var
  88.       r :registers;
  89.     begin
  90.       r.SI:=3;
  91.       r.ES:=Seg(State);
  92.       r.BX:=Ofs(State);
  93.  
  94.       Intr(101,r);
  95.     end;
  96.  
  97.   function GetState :boolean;
  98.     var
  99.       r :registers;
  100.     begin
  101.       r.SI:=4;
  102.       r.ES:=Seg(GetState);
  103.       r.BX:=Ofs(GetState);
  104.  
  105.       Intr(101,r);
  106.  
  107.       GetState:=(r.BP=1);
  108.     end;
  109.  
  110.   procedure SetMode(PercussionMode :integer);
  111.     {Percussion or Melodic Mode}
  112.     var
  113.       r :registers;
  114.     begin
  115.       r.SI:=6;
  116.       r.ES:=Seg(PercussionMode);
  117.       r.BX:=Ofs(PercussionMode);
  118.  
  119.       Intr(101,r);
  120.     end;
  121.  
  122.   function SetVolume(VolNum,VolDen,TimeNum,TimeDen :integer) :boolean;
  123.     var
  124.       TD,TN,VD,VN :word; {To put variables values in proper order in memory}
  125.       r           :registers;
  126.     begin
  127.       TD:=TimeDen;
  128.       TN:=TimeNum;
  129.       VD:=VolDen;
  130.       VN:=VolNum;
  131.  
  132.       r.SI:=8;
  133.       r.ES:=Seg(VN);
  134.       r.BX:=Ofs(VN);
  135.  
  136.       Intr(101,r);
  137.  
  138.       SetVolume:=(r.BP=1);
  139.     end;
  140.  
  141.   function SetTempo(Tempo,TimeNum,TimeDen :integer) :boolean;
  142.     var
  143.       TD,TN,TP :integer; {To put variables values in proper order in memory}
  144.       r        :registers;
  145.     begin
  146.       TD:=TimeDen;
  147.       TN:=TimeNum;
  148.       TP:=Tempo;
  149.  
  150.       r.SI:=9;
  151.       r.ES:=Seg(TP);
  152.       r.BX:=Ofs(TP);
  153.  
  154.       Intr(101,r);
  155.  
  156.       SetTempo:=(r.BP=1);
  157.     end;
  158.  
  159.   procedure SetActVoice(Voice :word);
  160.     var
  161.       r :registers;
  162.     begin
  163.       GActVoice:=Voice;
  164.  
  165.       r.SI:=12;
  166.       r.ES:=Seg(Voice);
  167.       r.BX:=Ofs(Voice);
  168.  
  169.       Intr(101,r);
  170.     end;
  171.  
  172.   function PlayNoteDel(Pitch :integer; LengthNum,LengthDen,DelayNum,DelayDen :word) :boolean;
  173.     var
  174.       DD,DN,LD,LN :word;
  175.       P           :integer;
  176.       r           :registers;
  177.     begin
  178.       P:=Pitch;
  179.       LD:=LengthDen;
  180.       LN:=LengthNum;
  181.       DN:=DelayNum;
  182.       DD:=DelayDen;
  183.  
  184.       r.SI:=14;
  185.       r.ES:=Seg(P);
  186.       r.BX:=Ofs(P);
  187.  
  188.       Intr(101,r);
  189.  
  190.       PlayNoteDel:=(r.BP=1);
  191.     end;
  192.  
  193.   function PlayNote(Pitch :integer; LengthNum,LengthDen :word) :boolean;
  194.     var
  195.       LD,LN :word;
  196.       P     :integer;
  197.       r     :registers;
  198.     begin
  199.       P:=Pitch;
  200.       LD:=LengthDen;
  201.       LN:=LengthNum;
  202.  
  203.       r.SI:=15;
  204.       r.ES:=Seg(P);
  205.       r.BX:=Ofs(P);
  206.  
  207.       Intr(101,r);
  208.  
  209.       PlayNote:=(r.BP=1);
  210.     end;
  211.  
  212.   function SetTimbre(TimeNum,TimeDen :word) :boolean;
  213.     var
  214.       TD,TN :word;
  215.       T     :^integer;
  216.       c1,c2 :byte;
  217.       r     :registers;
  218.     begin
  219.       T:=Addr(GT[GActVoice]);
  220.       TN:=TimeNum;
  221.       TD:=TimeDen;
  222.  
  223.       r.SI:=16;
  224.       r.ES:=Seg(T);
  225.       r.BX:=Ofs(T);
  226.  
  227.       Intr(101,r);
  228.  
  229.       SetTimbre:=(r.BP=1);
  230.     end;
  231.  
  232.   function SetPitch(DeltaOctave,DeltaNum,DeltaDen :integer; TimeNum,TimeDen :word) :boolean;
  233.     var
  234.       TD,TN   :word;
  235.       DD,DN,D :integer;
  236.       c1,c2   :byte;
  237.       r       :registers;
  238.     begin
  239.       D:=DeltaOctave;
  240.       DN:=DeltaNum;
  241.       DD:=DeltaDen;
  242.       TN:=TimeNum;
  243.       TD:=TimeDen;
  244.  
  245.       r.SI:=16;
  246.       r.ES:=Seg(D);
  247.       r.BX:=Ofs(D);
  248.  
  249.       Intr(101,r);
  250.  
  251.       SetPitch:=(r.BP=1);
  252.     end;
  253.  
  254.   procedure SetTickBeat(TickBeat :integer);
  255.     var
  256.       r :registers;
  257.     begin
  258.       r.SI:=18;
  259.       r.ES:=Seg(TickBeat);
  260.       r.BX:=Ofs(TickBeat);
  261.  
  262.       Intr(101,r);
  263.     end;
  264.  
  265.   procedure DirectNoteOn(Voice :word; Pitch :integer);
  266.     var
  267.       P :integer;
  268.       V :word;
  269.       r :registers;
  270.     begin
  271.       P:=Pitch;
  272.       V:=Voice;
  273.  
  274.       r.SI:=19;
  275.       r.ES:=Seg(V);
  276.       r.BX:=Ofs(V);
  277.  
  278.       Intr(101,r);
  279.     end;
  280.  
  281.   procedure DirectNoteOff(Voice :word);
  282.     var
  283.       r :registers;
  284.     begin
  285.       r.SI:=20;
  286.       r.ES:=Seg(Voice);
  287.       r.BX:=Ofs(Voice);
  288.  
  289.       Intr(101,r);
  290.     end;
  291.  
  292.   procedure DirectTimbre;
  293.     var
  294.       T     :^integer;
  295.       V     :word;
  296.       r     :registers;
  297.     begin
  298.       V:=GActVoice;
  299.       T:=Addr(GT[V]);
  300.  
  301.       r.SI:=21;
  302.       r.ES:=Seg(V);
  303.       r.BX:=Ofs(V);
  304.  
  305.       Intr(101,r);
  306.     end;
  307.  
  308.   procedure LoadInstrument(FileSpec :string);
  309.     {Load an Instument from Disk and Place in Array}
  310.     var
  311.       c1 :byte;
  312.       n  :integer;
  313.       f  :file of integer;
  314.     begin
  315.       if not(Exist(FileSpec)) then FileSpec:='C:\MUSIC\PIANO1.INS';
  316.       Assign(f,FileSpec);
  317.       Reset(f);
  318.       Read(f,n);
  319.       for c1:=1 to 26 do
  320.         Read(f,GT[GActVoice,c1]);
  321.       Close(f);
  322.     end;
  323.  
  324.   function LoadSong;
  325.     {Read a .ROL file and place song in Buffer}
  326.     var
  327.       nb :byte;
  328.       ns :string[255];
  329.       ni,ni2,ni3,ni4,BPM :integer;
  330.       c1,c2  :word;
  331.       nr,nr2 :real;
  332.       fl :boolean;
  333.       f  :file;
  334.     procedure StringRead(len :word); {uses f,ns}
  335.       var
  336.         nc :char;
  337.         c1 :word;
  338.       begin
  339.         ns:='';
  340.         for c1:=1 to len do
  341.           begin
  342.             BlockRead(f,nc,1);
  343.             ns:=ConCat(ns,nc);
  344.           end;
  345.       end;
  346.     procedure TempoRead; {uses f,nb}
  347.       var
  348.         b1,b2,b3,b4 :byte;
  349.       begin
  350.         BlockRead(f,b1,1);
  351.         BlockRead(f,b2,1);
  352.         BlockRead(f,b3,1);
  353.         BlockRead(f,b4,1);
  354.         nb:=(b3{ div 2});
  355.       end;
  356.     procedure VolumeRead;
  357.       var
  358.         b1,b2,b3,b4 :byte;
  359.       begin
  360.         BlockRead(f,b1,1);
  361.         BlockRead(f,b2,1);
  362.         BlockRead(f,b3,1);
  363.         BlockRead(f,b4,1);
  364.         nb:=51+Round(b3/2.5);
  365.       end;
  366.     begin
  367.       LoadSong:=true;
  368.       if not(Exist(FileSpec))
  369.         then begin
  370.                LoadSong:=false;
  371.                Exit;
  372.              end;
  373.  
  374.       InitDriver;
  375.       RelTimeStart(0,1);
  376.       Assign(f,FileSpec);
  377.       Reset(f,1);
  378.       StringRead(44);
  379.       BlockRead(f,ni,2); SetTickBeat(ni); {Ticks per Beat}
  380.       BlockRead(f,ni,2); BPM:=ni; {Beats per Measure}
  381.       StringRead(5);
  382.       BlockRead(f,nb,1); SetMode(1); {Mode}
  383.       StringRead(143);
  384.       TempoRead; fl:=SetTempo(nb,0,1); {Tempo}
  385.       BlockRead(f,ni,2);
  386.       for c1:=1 to ni do
  387.         begin
  388.           BlockRead(f,ni2,2);
  389.           TempoRead; fl:=SetTempo(nb,ni2,1); {Tempo}
  390.         end;
  391.       for c1:=0 to 10 do {11 Voices}
  392.         begin
  393.           SetActVoice(c1);
  394.           StringRead(15);
  395.           BlockRead(f,ni2,2); {Time in ticks of last Note}
  396.           c2:=0;
  397.           while (c2<ni2) do
  398.             begin
  399.               BlockRead(f,ni3,2); {Note Pitch}
  400.               BlockRead(f,ni4,2); {Note Duration}
  401.               fl:=PlayNote(ni3-60,ni4,BPM); {Note}
  402.               c2:=c2+ni4; {Summation of Durations}
  403.             end;
  404.           StringRead(15);
  405.           BlockRead(f,ni2,2);
  406.           for c2:=1 to ni2 do {Instuments}
  407.             begin
  408.               BlockRead(f,ni3,2);
  409.               StringRead(9);
  410.               nb:=Pos(#0,ns);
  411.               Delete(ns,nb,Length(ns));
  412.               LoadInstrument(ConCat('C:\MUSIC\',ns,'.INS'));
  413.               fl:=SetTimbre(ni3,1);
  414.               StringRead(1);
  415.               BlockRead(f,ni4,2);
  416.             end;
  417.           StringRead(15);
  418.           BlockRead(f,ni2,2);
  419.           nb:=1;
  420.           for c2:=1 to ni2 do {Volume}
  421.             begin
  422.               BlockRead(f,ni3,2);
  423.               fl:=SetVolume(100,nb,ni3,1); {Use inverse to disable Relative}
  424.               VolumeRead;
  425.               fl:=SetVolume(nb,100,ni3,1);
  426.             end;
  427.           StringRead(15);
  428.           BlockRead(f,ni2,2);
  429.           for c2:=1 to ni2 do {Pitch -disabled}
  430.             begin
  431.               BlockRead(f,ni3,2);
  432.               BlockRead(f,nr,4);
  433.               if (nr=0) then nr2:=1 else nr2:=nr;
  434. {             fl:=SetPitch(0,Abs(Trunc(nr*100)),Trunc((nr/nr2)*100),ni3,1);}
  435.             end;
  436.         end;
  437.       Close(f);
  438.     end;
  439.  
  440. end.
  441.