home *** CD-ROM | disk | FTP | other *** search
/ The Unsorted BBS Collection / thegreatunsorted.tar / thegreatunsorted / hacking / phreak_utils_pc / bbunit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-04-01  |  4.9 KB  |  108 lines
  1. unit bbunit;
  2.  
  3. interface
  4. procedure soundio(address,data: word);
  5. procedure soundinit;
  6. procedure soundplay(freq1,freq2,freq3,len: word);
  7. procedure soundstart(freq1,freq2,freq3:word);
  8. procedure soundstop;
  9.  
  10. implementation
  11. uses optimer;
  12.  
  13. procedure soundio(address,data: word);
  14. begin
  15.   port[$388] := address;  delayms(1); {* Adressregister ausgeben      *}
  16.   port[$389] := data;     delayms(1); {* Daten ausgeben               *}
  17. end;
  18.  
  19. procedure soundinit;
  20. var lop : byte;
  21. begin
  22.   for lop := 0 to 255 do soundio(lop,0);   {* Alle Register resetten       *}
  23.   soundio($20,$01);                        {* Modulator Multiple K1        *}
  24.   soundio($21,$01);                        {* Modulator Multiple K2        *}
  25.   soundio($22,$01);
  26.   soundio($40,$FF);                        {* Modulator Attenuation K1     *}
  27.   soundio($41,$FF);                        {* Modulator Attenuation K2     *}
  28.   soundio($42,$FF);
  29.   soundio($60,$FF);                        {* Modulator Attack/Decay K1    *}
  30.   soundio($61,$FF);                        {* Modulator Attack/Decay K2    *}
  31.   soundio($62,$FF);
  32.   soundio($80,$00);                        {* Modulator Sustain/Release K1 *}
  33.   soundio($81,$00);                        {* Modulator Sustain/Release K2 *}
  34.   soundio($82,$00);
  35.   soundio($23,$01);                        {* Carrier Multiple K1          *}
  36.   soundio($24,$01);                        {* Carrier Multiple K2          *}
  37.   soundio($25,$01);
  38.   soundio($43,$00);                        {* Carrier Attenuation K1       *}
  39.   soundio($44,$00);                        {* Carrier Attenuation K2       *}
  40.   soundio($45,$00);
  41.   soundio($63,$F0);                        {* A/D K1                       *}
  42.   soundio($64,$F0);                        {* A/D K2                       *}
  43.   soundio($65,$F0);
  44.   soundio($83,$00);                        {* S/R K1                       *}
  45.   soundio($84,$00);                        {* S/R K2                       *}
  46.   soundio($85,$00);
  47. end;
  48.  
  49. procedure soundplay(freq1,freq2,freq3,len:word);
  50. var freqr1,                                {* Frequenz Real Kanal 1        *}
  51.     freqr2,
  52.     freqr3 : real;                         {* Frequenz Real Kanal 2        *}
  53. begin
  54.   if freq1 = freq2 then freq2 := 0;        {* Resonanz verhindern          *}
  55.   freqr1 := freq1/6.103515625;             {* Frequenz K1 errechnen        *}
  56.   freq1  := round(freqr1);                 {* Als Word runden              *}
  57.   freqr2 := freq2/6.103515625;             {* Frequenz K2 errechnen        *}
  58.   freq2  := round(freqr2);                 {* Als Word runden              *}
  59.   freqr3 := freq3/6.103515625;
  60.   freq3  := round(freqr3);
  61.   soundio($B0,(60 or hi(freq1)));          {* Hibits K1 ausgeben           *}
  62.   soundio($B1,(60 or hi(freq2)));          {* Hibits K2 ausgeben           *}
  63.   soundio($B2,(60 or hi(freq3)));
  64.   soundio($A0,lo(freq1));                  {* Lowbyte K1 ausgeben          *}
  65.   soundio($A1,lo(freq2));                  {* Lowbyte K2 ausgeben          *}
  66.   soundio($A2,lo(freq3));
  67.   delayms(len);                            {* Ausgabedauer in ms           *}
  68.   soundio($B0,00);                         {* Kanal 1 ausschalten          *}
  69.   soundio($B1,00);                         {* Kanal 2 ausschalten          *}
  70.   soundio($B2,00);
  71.   soundio($A0,00);                         {* Kanal 1 ausschalten          *}
  72.   soundio($A1,00);                         {* Kanal 2 ausschalten          *}
  73.   soundio($A2,00);
  74. end;
  75.  
  76. procedure soundstart(freq1,freq2,freq3:word);
  77. var freqr1,                                {* Frequenz Real Kanal 1        *}
  78.     freqr2,
  79.     freqr3 : real;                         {* Frequenz Real Kanal 2        *}
  80. begin
  81.   if freq1 = freq2 then freq2 := 0;        {* Resonanz verhindern          *}
  82.   freqr1 := freq1/6.103515625;             {* Frequenz K1 errechnen        *}
  83.   freq1  := round(freqr1);                 {* Als Word runden              *}
  84.   freqr2 := freq2/6.103515625;             {* Frequenz K2 errechnen        *}
  85.   freq2  := round(freqr2);                 {* Als Word runden              *}
  86.   freqr3 := freq3/6.103515625;
  87.   freq3  := round(freqr3);
  88.   soundio($B0,(60 or hi(freq1)));          {* Hibits K1 ausgeben           *}
  89.   soundio($B1,(60 or hi(freq2)));          {* Hibits K2 ausgeben           *}
  90.   soundio($B2,(60 or hi(freq3)));
  91.   soundio($A0,lo(freq1));                  {* Lowbyte K1 ausgeben          *}
  92.   soundio($A1,lo(freq2));                  {* Lowbyte K2 ausgeben          *}
  93.   soundio($A2,lo(freq3));
  94. end;
  95.  
  96. procedure soundstop;
  97. begin
  98.   soundio($B0,00);                         {* Kanal 1 ausschalten          *}
  99.   soundio($B1,00);                         {* Kanal 2 ausschalten          *}
  100.   soundio($B2,00);
  101.   soundio($A0,00);                         {* Kanal 1 ausschalten          *}
  102.   soundio($A1,00);                         {* Kanal 2 ausschalten          *}
  103.   soundio($A2,00);
  104. end;
  105.  
  106.  
  107. end.
  108.