
{===========================================================================}
{ Konzept        : DATA BECKERs Sound Blaster Superbuch                     }
{ Prog. PlayCMF  : Spielt ein CMF-Musikstck mit Hilfe des mit jeder Sound- }
{                  Blaster-Karte gelieferten Treibers SBFMDRV.COM ab. Das   }
{                  Programm benutzt die Unit SBFMDrv.                       }
{===========================================================================}
{ Autor          : Arthur Burda                                             }
{ Dateiname      : PLAYCMF.PAS                                              }
{ entwickelt am  : 10.07.1993                                               }
{ letztes Update : 01.09.1993                                               }
{ Version        : 1.02                                                     }
{ Compiler       : Turbo Pascal 6.0 und hher                               }
{===========================================================================}

PROGRAM PlayCMF;

{---------------------------------------------------------------------------}
{ Compiler-Schalter                                                         }
{---------------------------------------------------------------------------}

{$D-}                                        { keine Debugger-Informationen }
{$F+}                                                { FAR-Aufrufe erlauben }
{$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, DOS, SBFMDrv;              { Units CRT, DOS und SBFMDrv einbinden }

TYPE

  {=========================================================================}
  { TCMFHeader: Aufbau des CMF-Datei-Header                                 }
  {=========================================================================}

  TCMFHeader = RECORD
    IDStr       : ARRAY[0..3] OF Char;              { Format-Kennung "CTMF" }
    Ver, SubVer : Byte;               { Haupt- und Unterversion des Formats }
    InstrStart  : Word;       { absolute Startadresse fr Instrumentendaten }
    MusicStart  : Word;              { absolute Startadresse fr Musikdaten }
    QuarterNote : Word;               { Zahl der Uhrtakte einer Viertelnote }
    Freq        : Word;       { Zahl der Uhrtakte in der Sekunde (Frequenz) }
    TitleStart  : Word;              { absolute Startadresse fr Musiktitel }
    CompStart   : Word;   { abs. Startadresse fr den Namen des Komponisten }
    RemStart    : Word;             { absolute Startadresse fr Bemerkungen }
    ChannelData : ARRAY[1..16] OF Byte;       { Kanaldaten (max. 16 Kanle) }
    NmbOfInstr  : Word;                { Anzahl der verwendeten Instrumente }
    Tempo       : Word;                                        { Grundtempo }
  END;

VAR
  CMFName     : String;                                { Name der CMF-Datei }
  CMFFile     : File;                                   { CMF-Dateivariable }
  NmbOfInstr  : Word;                              { Anzahl der Instrumente }
  Freq        : Word;         { Zahl der Uhrtakte in der Sekunde (Frequenz) }
  MusDataSize : Word;                                { Gráe der Musikdaten }
  InstrTab    : Pointer; { Zeiger auf die Tabelle mit den Instrumentendaten }
  MusicTab    : Pointer;        { Zeiger auf die Tabelle mit den Musikdaten }
  Status      : Byte;                                          { Statusbyte }

{===========================================================================}
{ Prozedur ShowHelp: Hilfe zum Programm auf dem Bildschirm anzeigen.        }
{===========================================================================}
{ Eingabe: keine                                                            }
{ Ausgabe: keine                                                            }
{---------------------------------------------------------------------------}

PROCEDURE ShowHelp;

BEGIN
  WriteLn('Spielt eine CMF-Datei mit Hilfe des Treibers SBFMDRV.COM ab.');
  WriteLn('Dieser Treiber muá vorher geladen werden.');
  WriteLn;
  WriteLn('Syntax: PLAYCMF [Dateiname].CMF');
END;

{===========================================================================}
{ Funktion UpperString: Wandelt einen String beliebiger Lnge in Groá-      }
{                       schreibung um und liefert ihn an den Aufrufer der   }
{                       Funktion zurck.                                    }
{===========================================================================}
{ Eingabe: S = String, der in Groáschreibung umgewandelt werden soll        }
{ Ausgabe: String in Groáschreibung                                         }
{---------------------------------------------------------------------------}

FUNCTION UpperString(S : String) : String;

VAR
  Count : Word;                                                { ein Zhler }
  Upper : String;                  { in Groáschreibung umgewandelter String }

BEGIN
  UpperString := '';
  IF S <> '' THEN                               { Ist S kein leerer String? }
    BEGIN                                          { nein, S ist nicht leer }
      Upper := '';
      FOR Count := 1 TO Length(S) DO                     { String umwandeln }
        Upper := Upper+UpCase(S[Count]);
      UpperString := Upper;                      { neuen String zurckgeben }
    END;
END;

{===========================================================================}
{ Prozedur SeekError: Zeigt einen Suchfehler auf dem Bildschirm an.         }
{===========================================================================}
{ Eingabe: keine                                                            }
{ Ausgabe: keine                                                            }
{---------------------------------------------------------------------------}

PROCEDURE SeekError;

BEGIN
  Close(CMFFile);                                         { Datei schlieáen }
  WriteLn;
  WriteLn('Suchfehler bei ', CMFName);
  Halt;                                                  { Programm beenden }
END;

{===========================================================================}
{ Prozedur FreeBuf: Gibt die fr die Instrumenten- und Musikdaten-Tabelle   }
{                   reservierte Puffer wieder frei.                         }
{===========================================================================}
{ Eingabe: keine                                                            }
{ Ausgabe: keine                                                            }
{---------------------------------------------------------------------------}

PROCEDURE FreeBuf;

BEGIN
  FreeMem(InstrTab, NmbOfInstr*16);
  FreeMem(MusicTab, MusDataSize);
END;

{===========================================================================}
{ Prozedur ReadCMFData: Liest die fr das Abspielen eines CMF-Musikstckes  }
{                       erforderlichen Daten aus dem Header der angegebenen }
{                       Datei und belegt die entsprechenden Variablen.      }
{===========================================================================}
{ Eingabe: keine                                                            }
{ Ausgabe: keine                                                            }
{---------------------------------------------------------------------------}

PROCEDURE ReadCMFData;

VAR
  CMFHeader : TCMFHeader;                                { CMF-Datei-Header }
  Result    : Integer;                              { Fehlerstatus-Variable }

BEGIN
  BlockRead(CMFFile, CMFHeader, SizeOf(TCMFHeader));  { Datenblock einlesen }
  Result := IOResult;                               { Fehlerstatus abfragen }
  IF Result = 0 THEN                          { Ist ein Fehler aufgetreten? }
    IF CMFHeader.IDStr = UpperString('ctmf') THEN { nein, Kennung gefunden? }
      BEGIN                                                            { ja }
        WriteLn('Name der Musikdatei: ', CMFName);
        NmbOfInstr := CMFHeader.NmbOfInstr;    { Zahl der Instrumente lesen }
        Freq := CMFHeader.Freq;                            { Frequenz lesen }
        MusDataSize := FileSize(CMFFile)-CMFHeader.MusicStart;

        { Puffer fr die Instrumenten- und Musikdaten-Tabelle reservieren }

        GetMem(InstrTab, NmbOfInstr*16);
        GetMem(MusicTab, MusDataSize);

        { Instrumenten- und Musikdaten-Tabelle einlesen }

        Seek(CMFFile, CMFHeader.InstrStart);
        Result := IOResult;
        IF Result = 0 THEN                                    { Suchfehler? }
          BlockRead(CMFFile, InstrTab^, NmbOfInstr*16)               { nein }
        ELSE                                                           { ja }
          BEGIN
            FreeBuf;                                     { Puffer freigeben }
            SeekError;                             { Fehlermeldung anzeigen }
          END;
        Seek(CMFFile, CMFHeader.MusicStart);
        Result := IOResult;
        IF Result = 0 THEN
          BlockRead(CMFFile, MusicTab^, MusDataSize)
        ELSE
          BEGIN
            FreeBuf;
            SeekError;
          END;
      END
    ELSE                         { CMF-Kennung konnte nicht gefunden werden }
      BEGIN                                        { Fehlermeldung ausgeben }
        Close(CMFFile);                                   { Datei schlieáen }
        WriteLn;
        WriteLn('Fehler: Datei ', CMFName, ' nicht im CMF-Format');
        Halt;                                            { Programm beenden }
      END
  ELSE                                  { leider ein Lesefehler aufgetreten }
    BEGIN                       { Fehlermeldung auf dem Bildschirm anzeigen }
      Close(CMFFile);                                     { Datei schlieáen }
      WriteLn;
      WriteLn('Fehler: Lesefehler bei ', CMFName);
      Halt;
    END;
END;

{===========================================================================}
{ Prozedur Play: Spielt das CMF-Musikstck ab.                              }
{===========================================================================}
{ Eingabe: keine                                                            }
{ Ausgabe: keine                                                            }
{---------------------------------------------------------------------------}

PROCEDURE Play;

VAR
  Done : Boolean;            { TRUE, wenn das Abspielen beendet werden soll }

BEGIN
  IF FMDriverReset THEN       { Konnte der FM-Treiber initialisiert werden? }
    BEGIN                                                              { ja }
    END
  ELSE                                { nein, kein FM-Treiber-Reset erfolgt }
    BEGIN                                          { Fehlermeldung ausgeben }
      WriteLn;
      WriteLn('Fehler: Der FM-Treiber konnte nicht initialisiert werden.');
      Halt;                                              { Programm beenden }
    END;
  SBFMDrvSetStatusByte(Ptr(Seg(Status), Ofs(Status)));
  SBFMDrvSetInstrTable(NmbOfInstr, InstrTab);  { Instrumenten-Param. setzen }
  SBFMDrvSetClockRate2(Freq);     { Frequenz fr den Timer-Interrupt setzen }
  IF SBFMDrvPlayMusic(MusicTab) THEN            { Abspielvorgang gestartet? }
    BEGIN                                                              { ja }
      WriteLn;
      WriteLn('Die Musikdaten werden nun abgespielt.');
      WriteLn('Drcken Sie <ESC>, um den Abspielvorgang zu beenden ...');
      Done := FALSE;

      { solange wiederholen, bis das Musikstck komplett abgespielt }
      { wurde oder <ESC> gedrckt wird                              }

      REPEAT
        IF Status = 0 THEN                         { Ende des Musikstckes? }
          Done := TRUE;                                                { ja }
        IF KeyPressed THEN                     { Wurde eine Taste gedrckt? }
          IF ReadKey = #27 THEN                             { Ist es <ESC>? }
            Done := TRUE;                      { ja, Abspielvorgang beenden }
      UNTIL Done;
    END
  ELSE                           { Der Abspielvorgang wurde nicht gestartet }
    BEGIN                                          { Fehlermeldung ausgeben }
      WriteLn;
      WriteLn('Fehler: Der Abspielvorgang konnte nicht gestartet werden.');
      Halt;                                              { Programm beenden }
    END;
  IF FMDriverReset THEN       { Konnte der FM-Treiber initialisiert werden? }
    BEGIN                                                              { ja }
    END
  ELSE                                { nein, kein FM-Treiber-Reset erfolgt }
    BEGIN                                          { Fehlermeldung ausgeben }
      WriteLn;
      WriteLn('Fehler: Der FM-Treiber konnte nicht initialisiert werden.');
      Halt;                                              { Programm beenden }
    END;
END;

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

VAR
  Result : Integer;                                 { Fehlerstatus-Variable }
  Dir    : DirStr;                              { Verzeichnis der CMF-Datei }
  Name   : NameStr;                   { Name der CMF-Datei ohne Erweiterung }
  Ext    : ExtStr;                                       { Dateierweiterung }

BEGIN
  TextColor(LightGray);                                { Textfarbe hellgrau }
  WriteLn;
  WriteLn('PLAYCMF  *  Version 1.02  *  (c) 1993 by Arthur Burda');
  WriteLn('ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ'+
    'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');
  IF FMDrvIntr = 0 THEN                { Treiber SBFMDRV.COM nicht geladen? }
    BEGIN                                                            { nein }
      WriteLn;
      WriteLn('Fehler: Treiber SBFMDRV.COM nicht geladen');
      Halt;
    END;
  IF ParamCount = 0 THEN                    { kein Kommandozeilenparameter? }
    BEGIN                 { nein, Fehlermeldung auf dem Bildschirm ausgeben }
      WriteLn;
      WriteLn('Fehler: Keine CMF-Musikdatei zum Abspielen angegeben.');
      Halt;
    END
  ELSE
    IF ParamStr(1) = '/?' THEN                         { Hilfe angefordert? }
      ShowHelp                    { ja, Hilfetext auf dem Bildschirm zeigen }
    ELSE          { keine Hilfe, wahrscheinlich ein CMF-Dateiname angegeben }
      BEGIN
        CMFName := UpperString(ParamStr(1));      { CMF-Dateinamen auslesen }
        FSplit(CMFName, Dir, Name, Ext);          { CMF-Dateinamen zerlegen }
        IF Ext = '' THEN
          CMFName := CMFName+'.CMF';
        Assign(CMFFile, CMFName);              { Datei mit Namen verknpfen }
        Reset(CMFFile, 1);                                   { Datei ffnen }
        Result := IOResult;                         { Fehlerstatus abfragen }
        IF Result = 0 THEN                            { Fehler aufgetreten? }
          BEGIN                                         { nein, also weiter }
            ReadCMFData;                                  { CMF-Daten lesen }
            Play;                                    { Musikstck abspielen }
            FreeBuf;  { Puffer fr Instr.- und Musikdaten-Tabelle freigeben }
            Close(CMFFile);                               { Datei schlieáen }
          END
        ELSE                      { leider ein Fehler beim ffnen der Datei }
          BEGIN                                    { Fehlermeldung ausgeben }
            WriteLn;
            WriteLn('Fehler: Datei '+CMFName+' konnte nicht geffnet '+
              'werden.');
            Halt;
          END;
      END;
END.
