home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-387-Vol-3of3.iso
/
c
/
cmsunit.zip
/
CMS.PAS
next >
Wrap
Pascal/Delphi Source File
|
1992-07-29
|
6KB
|
255 lines
Unit CMS;
{
This unit was derived from a C source included in Jerry Joplin's CMS
guide. Thanks for the info Jerry.
}
{
The following Warranty text was "lifted" from Jerry Joplin's CMS guide.
(I'm too lazy to type up my own)
Warranty and Copyright Policy
This document is provided on an "as-is" basis, and its author makes no
warranty or representation, express or implied, with respect to its
quality performance or fitness for a particular purpose. In no event
will the author of this document be liable for direct, indirect,
special, incidental, or consequential damages arising out of the use or
inability to use the information contained within. Use of this document
is at your own risk.
This file may be used and copied freely so long as the applicable
copyright notices are retained, and no modifications are made to the
text of the document. No money shall be charged for its distribution
beyond reasonable shipping, handling and duplication costs, nor shall
proprietary changes be made to this document so that it cannot be
distributed freely. This document may not be included in published
material or commercial packages without the written consent of its
author.
I anyone actually uses this code, please write me:
Bryan Armstrong
at my home address
11802 Gardenglen Dr.
Houston, TX 77070
OR my Internet address
BMA7200@ZEUS.TAMU.EDU
dated: 7/29/92
}
Interface
Const
base = $220;
Var
k : integer;
Amp : Array [1..6] of byte;
Oct : Array [$10..$12] of byte;
Frq : Array [1..6] of byte;
FrqEn : byte;
NoiEn : byte;
NsFrq : byte;
Procedure CMSSetReg (cmsport, register, value : integer);
Procedure InitCMS;
Procedure CMSSetAmp (voice, lAmp, rAmp : integer);
Procedure CMSSetFreq (voice, freq : integer);
Procedure CMSSetOctave (voice, octave : integer);
Procedure CMSEnableVoice (voice : integer);
Procedure CMSSetNoiseF (voice, freq : integer);
Procedure CMSEnableNoise (voice : integer);
Procedure CMSSound (voice,lAmp,rAmp,freq,oct : integer);
Procedure CMSNoise (voice,lAmp,rAmp,noisenum : integer);
Implementation
Procedure CMSSetReg (cmsport, register, value : integer);
Begin
port [cmsport] := register;
port [cmsport-1] := value;
End;
Procedure InitCMS;
Var
tport, i : integer;
Begin
tport := base + 1; { voice 1-6 registers }
For i := 0 to $20 Do
CMSSetReg (tport,i,0);
CMSSetReg(tport,$1C,$2);
tport := base + 3; { voice 7-C registers }
For i := 0 to $20 Do
CMSSetReg (tport,i,0);
CMSSetReg(tport,$1C,$2);
For i := 1 to 6 Do
Begin
Amp [i] := 0;
Frq [i] := 0;
End;
For i := 1 to 3 Do
Oct [i] := 0;
FrqEn := 0;
NoiEn := 0;
NsFrq := 0;
End;
Procedure CMSSetAmp (voice, lAmp, rAmp : integer);
Var
tport : integer;
Begin
If voice < 7 Then
tport := base + 1 { voice 1-6 }
Else
Begin
tport := base + 3; { voice 7-C }
voice := voice - 6;
End;
Amp[voice] := (Amp[voice] shr 4) shl 4 + lAmp;
Amp[voice] := (Amp[voice] or 240) - 240 + rAmp shl 4;
CMSSetReg (tport,voice - 1, Amp[voice]);
End;
Procedure CMSSetFreq (voice, freq : integer);
Var
tport : integer;
Begin
If voice < 7 Then
tport := base + 1 { voice 1-6 }
Else
Begin
tport := base + 3; { voice 7-C }
voice := voice - 6;
End;
CMSSetReg (tport,$8 + voice - 1, freq);
End;
Procedure CMSSetOctave (voice, octave : integer);
Var
tport,
value,
reg : integer;
Begin
If voice < 7 Then
tport := base + 1 { voices 1-6 }
Else
tport := base + 3; { voices 7-C }
If (voice AND 1) <> 0 Then
value := octave
Else
value := octave shl 4;
Case voice Of
1,2,7,8 : reg := $10;
3,4,9,10 : reg := $11;
5,6,11,12 : reg := $12;
End;
If (voice and 1) <> 0 Then
Oct[reg] := (Oct[reg] shr 4) shl 4 + value
Else
Oct[reg] := (Oct[reg] or 240) - 240 + value;
CMSSetReg (tport,reg,Oct[reg]);
End;
Procedure CMSEnableVoice (voice : integer);
Var
tport,
value : integer;
Begin
If voice < 7 Then
Begin
tport := base + 1; { voices 1-6 }
value := 1 shl (voice - 1);
End
Else
Begin
tport := base + 3;
value := 1 shl (voice - 7); { voice 7-C }
End;
If voice = 0 Then
Begin
CMSSetReg (base + 1,$14,0);
CMSSetReg (base + 3,$14,0);
End
Else
Begin
FrqEn := FrqEn or value;
CMSSetReg (tport,$14,FrqEn);
CMSSetReg (tport,$1C,1);
End;
End;
Procedure CMSSetNoiseF (voice, freq : integer);
Var
gen,
tport : integer;
Begin
If voice < 7 Then
tport := base + 1 { voices 1-6 }
Else
tport := base + 3; { voices 7-C }
Case voice Of
$1..$3 : gen := 1;
$4..$6 : gen := 2;
$7..$9 : gen := 3;
$A..$C : gen := 4;
End; { case }
Case gen Of
1,3 : NsFrq := (NsFrq shr 2) shl 2 + freq;
2,4 : NsFrq := (NsFrq or 240) - 240 + freq shl 4;
End; { case }
CMSSetReg (tport,$16,NsFrq);
End;
Procedure CMSEnableNoise (voice : integer);
Var
tport,
value : integer;
Begin
If voice < 7 Then
Begin
tport := base + 1; { voices 1-6 }
value := 1 shl (voice - 1);
End
Else
Begin
tport := base + 3;
value := 1 shl (voice - 7); { voice 7-C }
End;
If voice = 0 Then
Begin
CMSSetReg (base + 1,$15,0);
CMSSetReg (base + 3,$15,0);
End
Else
Begin
NoiEn := FrqEn or value;
CMSSetReg (tport,$15,NoiEn);
CMSSetReg (tport,$1C,1);
End;
End;
Procedure CMSSound (voice,lAmp,rAmp,freq,oct : integer);
Begin
CMSSetAmp (voice,lAmp,rAmp);
CMSSetFreq (voice,freq);
CMSSetOctave (voice,oct);
CMSEnableVoice (voice);
End;
Procedure CMSNoise (voice,lAmp,rAmp,noisenum : integer);
Begin
CMSSetAmp (voice,lAmp,rAmp);
CMSSetNoiseF (voice,noisenum);
CMSEnableNoise (voice);
End;
End.