
{===========================================================================}
{ Konzept        : DATA BECKERs Sound Blaster Superbuch                     }
{ Prog. Waves    : Simuliert Wellengerusche - ein Beispiel fr die Verwen- }
{                  dung der Unit SBDSP.                                     }
{===========================================================================}
{ Autor          : Arthur Burda                                             }
{ Dateiname      : WAVES.PAS                                                }
{ entwickelt am  : 08.07.1993                                               }
{ letztes Update : 01.09.1993                                               }
{ Version        : 1.03                                                     }
{ Compiler       : Turbo Pascal 6.0 und hher                               }
{===========================================================================}

PROGRAM Waves;

{$D-}                                        { keine Debugger-Informationen }
{$F-}                                        { FAR-Aufrufe sind nicht ntig }
{$G+}                                                   { 286-Code erzeugen }
{$I-}                                                   { keine I/O-Prfung }
{$R-}                                               { keine Bereichsprfung }
{$S-}                                                  { keine Stackprfung }
{$X+}                    { Behandlung von Funktionen wie Prozeduren mglich }

{$M 16384,131072,655360}       { 16 KB Stack, min. 128 KB Heap, max. 640 KB }

USES CRT, SBDSP;                            { Units CRT und SBDSP einbinden }

{===========================================================================}
{ Prozedur Wave: Erzeugt ein Wellengerusch mit der Ausgabe-Frequenz von 5  }
{                kHz (5000 Hz). Es sind insgesamt 5 verschiedene Wellenge-  }
{                rusche mglich.                                           }
{===========================================================================}
{ Eingabe: Num = Nummer des Wellengerusches (1..5)                         }
{ Ausgabe: keine                                                            }
{---------------------------------------------------------------------------}

PROCEDURE Wave(Num : Byte);

CONST
  Freq = 5000;

VAR
  DataBuf : Pointer;                                          { Datenpuffer }
  Count   : LongInt;                                           { ein Zhler }
  BytePtr : ^Byte;                                    { Zeiger auf ein Byte }

BEGIN
  CASE Num OF
    1 :
      BEGIN
        GetMem(DataBuf, 60000);  { Speicherplatz fr den Puffer reservieren }

        { Wellengerusch generieren }

        FOR Count := 0 TO 19999 DO
          BEGIN
            BytePtr := Ptr(Seg(DataBuf^), Ofs(DataBuf^)+Count);
            BytePtr^ := Random(Round(Count/(100+((20000-Count)/20))));
          END;
        FOR Count := 20000 TO 59999 DO
          BEGIN
            BytePtr := Ptr(Seg(DataBuf^), Ofs(DataBuf^)+Count);
            BytePtr^ := Random(Round((60000-Count)/200));
          END;

        PlayDirect(DataBuf, 60000,           { Gerusch ist jetzt zu hren. }
          Freq, FALSE);
        FreeMem(DataBuf, 60000);                  { Speicherplatz freigeben }
      END;
    2 :
      BEGIN
        GetMem(DataBuf, 60000);
        FOR Count := 0 TO 9999 DO
          BEGIN
            BytePtr := Ptr(Seg(DataBuf^), Ofs(DataBuf^)+Count);
            BytePtr^ := Random(Round(Count/200));
          END;
        FOR Count := 10000 TO 59999 DO
          BEGIN
            BytePtr := Ptr(Seg(DataBuf^), Ofs(DataBuf^)+Count);
            BytePtr^ := Random(Round((60000-Count)/1000));
          END;
        PlayDirect(DataBuf, 60000, Freq, FALSE);
        FreeMem(DataBuf, 60000);
      END;
    3 :
      BEGIN
        GetMem(DataBuf, 40000);
        FOR Count := 0 TO 10999 DO
          BEGIN
            BytePtr := Ptr(Seg(DataBuf^), Ofs(DataBuf^)+Count);
            BytePtr^ := Random(Round(Count/200));
          END;
        FOR Count := 11000 TO 39999 DO
          BEGIN
            BytePtr := Ptr(Seg(DataBuf^), Ofs(DataBuf^)+Count);
            BytePtr^ := Random(Round((40000-Count)/400));
          END;
        PlayDirect(DataBuf, 40000, Freq, FALSE);
        FreeMem(DataBuf, 40000);
      END;
    4 :
      BEGIN
        GetMem(DataBuf, 20000);
        FOR Count := 0 TO 8999 DO
          BEGIN
            BytePtr := Ptr(Seg(DataBuf^), Ofs(DataBuf^)+Count);
            BytePtr^ := Random(Round(Count/50));
          END;
        FOR Count := 9000 TO 19999 DO
          BEGIN
            BytePtr := Ptr(Seg(DataBuf^), Ofs(DataBuf^)+Count);
            BytePtr^ := Random(Round((20000-Count)/90));
          END;
        PlayDirect(DataBuf, 20000, Freq, FALSE);
        FreeMem(DataBuf, 20000);
      END;
    5 :
      BEGIN
        GetMem(DataBuf, 60000);
        FOR Count := 0 TO 14999 DO
          BEGIN
            BytePtr := Ptr(Seg(DataBuf^), Ofs(DataBuf^)+Count);
            BytePtr^ := Random(Round(Count/400));
          END;
        FOR Count := 15000 TO 19999 DO
          BEGIN
            BytePtr := Ptr(Seg(DataBuf^), Ofs(DataBuf^)+Count);
            BytePtr^ := Random(Round(Count/(100+((20000-Count)/10))));
          END;
        FOR Count := 20000 TO 59999 DO
          BEGIN
            BytePtr := Ptr(Seg(DataBuf^), Ofs(DataBuf^)+Count);
            BytePtr^ := Random(Round((60000-Count)/200));
          END;
        PlayDirect(DataBuf, 60000, Freq, FALSE);
        FreeMem(DataBuf, 60000);
      END;
  END;
END;

{---------------------------------------------------------------------------}
{ Hauptprogramm                                                             }
{---------------------------------------------------------------------------}

VAR
  Num : Byte;                                 { Nummer des Wellengerusches }

BEGIN
  Randomize;                        { Zufallszahlengenerator initialisieren }
  TextColor(LightGray);                                { Textfarbe hellgrau }
  ClrScr;                                              { Bildschirm lschen }
  WriteLn('  DATA BECKERs Sound Blaster Superbuch  *  WAVES  *  (c) '+
    '1993 by Arthur Burda');
  WriteLn('ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ'+
    'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');
  WriteLn('Sie hren jetzt verschiedene Wellengerusche (Meeresrauschen).');
  WriteLn;
  WriteLn('Drcken Sie irgendeine Taste, um die Demo zu beenden ...');
  InitDSP;                                             { DSP initialisieren }
  REPEAT                { solange wiederholen, bis eine Taste gedrckt wird }
    Num := Random(5)+1;    { Nummer des Wellengerusches zufllig ermitteln }
    Wave(Num);              { Gerusch auf der Sound-Blaster-Karte ausgeben }
  UNTIL KeyPressed;
END.
