Prima Shareware 3/DuCom_Prima-Shareware-3_cd1.bin/PROGRAMO/PASCAL/BUNKED/PP.PAS

Pascal/Delphi Source File | 1994-03-06 | 5.1 KB | 158 lines

Program PlayPatch; {simple program to play .INS file on channel 0}

Type HSC_InstType = Record
                     AmByte,                       {AM/VB/EG/KS/MFM}
                     LkByte,                       {KSL/Volume}
                     AdByte,                       {Attack/Decay}
                     SrByte : Array[1..2] of Byte; {Sustain/Release}
                     FbByte : Byte;                {Feedback/DuelOp}
                     WfByte : Array[1..2] of Byte; {WaveForm Type}
                     SlideByte : Byte;             {HSC internal byte (?)}
                    End;

     RegConfigType = Record
                      WaveEnab,                    {WaveForm Enable}
                      Sp_Ks,                       {SpeechSyn/KeySplit}
                      AmVb_Perc : Byte;            {Am/Vb depths/Percussion}
                     End;

     ChnlRange = 0..8; {Available Channels}
     OctRange  = 0..8; {Octive Range}

Const RegConfig : RegConfigType = (WaveEnab  : $20;  {WaveForm Enabled}
                                   Sp_Ks     : $00;  {Speech Off/KeySplit Off}
                                   AmVb_Perc : $00); {Am Dep: 1db
                                                      Vb Dep: 7cent
                                                      Percussion Mode Off}

      {list of freq range.. C# thru B and a higher C}

      NoteList : Array[1..12] of Word = ($016B, $0181, $0198, $01B0,
                                         $01CA, $01E5, $0202, $0220,
                                         $0241, $0263, $0287, $02AE);

      {mapping array for channel positions from register base}

      ChannelMap : Array[ChnlRange] of Byte = ($00, $01, $02, $08,
                                               $09, $0A, $10, $11,
                                               $12);

Var CurrentIns : HSC_InstType;

{write value to specific FM register in single OPL2/mono mode}

Procedure WriteFM(Reg, Value : Byte); Assembler;
Asm
 MOV DX, 0388h   {address port = 388h.. single OPL2/mono}
 MOV AL, Reg
 OUT DX, AL      {send register info to address port}

 MOV AH, 0       {set counter to 0}
@Delay1:         {delay 3.3ms (6 port reads)}
 IN  AL,  DX     {read address port}
 INC AH          {increment counter}
 CMP AH, 6       {there yet?}
 JNE @Delay1     {no.. read port again}

 MOV DX, 0389h   {data port = 389h.. single OPL2/mono}
 MOV AL, Value
 OUT DX, AL      {send register value to data port}

 MOV AH, 0       {set counter to 0}
 MOV DX, 0388h   {set address port for delay}
@Delay2:         {delay 23ms (35 port reads)}
 IN  AL,  DX     {read address port}
 INC AH          {increment counter}
 CMP AH, 35      {done yet?}
 JNE @Delay2     {no.. read port again}
 {ready for next port write}
End;

{reset all FM registers to 0}

Procedure ResetFM;

Var Count : Byte;

Begin
 For Count := $01 to $F5 do WriteFM(Count, $00);
End;

{loads instrument file into HSC_InstType variable}

Function LoadInst(fName : String; Var Ins : HSC_InstType) : Boolean;

Var InsF : File of HSC_InstType;

Begin
 Assign(InsF, fName);
 {$I-} Reset(InsF); {$I+}
 If IOResult <> 0 then LoadInst := False
 Else Begin
  {$I-} Read(InsF, Ins); {$I+}
  If IOResult <> 0 then LoadInst := False
  Else Begin
   LoadInst := True;
   Close(InsF);
  End;
 End;
End;

{write instrument to specific channel}

Procedure WriteInst(Chnl : Byte; Ins : HSC_InstType);

Var OpCount,
    OpMap    : Byte;

Begin
 With RegConfig do
 Begin
  WriteFM($01, WaveEnab);  {enable WaveForm usage}
  WriteFM($08, Sp_Ks);     {turn off Speech/Key Split}
  WriteFM($BD, AmVb_Perc); {Am Depth = 1db / Vib Depth = 7cent / Percussion Mode Off}
 End;
 OpMap := 3;
 With Ins do
 Begin
  For OpCount := 1 to 2 do {write first to the carrier.. then the modulator}
  Begin
  WriteFM($20+ChannelMap[Chnl]+OpMap, AmByte[OpCount]); {write AM/VB/EG/KS/MFM info}
  WriteFM($40+ChannelMap[Chnl]+OpMap, LkByte[OpCount]); {write KS/Volume info}
  WriteFM($60+ChannelMap[Chnl]+OpMap, AdByte[OpCount]); {write Attack/Decay info}
  WriteFM($80+ChannelMap[Chnl]+OpMap, SrByte[OpCount]); {write Sustain/Release}
  WriteFM($E0+ChannelMap[Chnl]+OpMap, WfByte[OpCount]); {write WaveForm info}
  Dec(OpMap, 3);
  End;
  WriteFM($C0+Chnl, FbByte);   {write feedback/duel op info}
 End;
End;

{turn on voice on specific channel at specified octive/pitch}

Procedure Vox_On(Chnl : ChnlRange; Pitch : Word; Oct : OctRange);
Begin
 WriteFM($A0+Chnl, Lo(Pitch));
 WriteFM($B0+Chnl, $20 or Hi(Pitch) or (Oct shl 2));
End;

{turn off voice on specific channel}

Procedure Vox_Off(Chnl : Byte);
Begin
 WriteFM($B0+Chnl, $00);
End;

Begin
 WriteLn('usage: pp <patch.ins>');
 WriteLn('run prog with no parameters to kill sound');
 ResetFM; {reset FM registers}
 If ParamCount <> 1 then Halt(0);
 If Not LoadInst(ParamStr(1), CurrentIns) then {try and load instrument file}
 Begin
  WriteLn(ParamStr(1),' does not exist or is corrupt');
  Halt(0);
 End;
 WriteInst(0, CurrentIns);   {write loaded instrument file to channel 0}
 Vox_On(0, NoteList[12], 3); {turn on 0.. pitch C.. octive 3}
End.