Amiga ISO Collection/AmigaUtilCD2.iso/Programming/Pascal/MAXONPASCAL3.DMS/in.adf/DEMOS-OS1.3/Play8SVX.p

Text File | 1994-07-23 | 7.5 KB | 301 lines

PROGRAM Play8SVX;

{ Demo für die Benutzung des Audio-Device.              }
{ Die Funktion "LoadSample" lädt einen 8SVX-IFF-Sound,  }
{ legt ihn in einer dynamisch eingerichteten Struktur   }
{ ab und gibt einen Zeiger auf diese Struktur zurück.   }
{ Die Datei muß vor Aufruf von "LoadSample" bereits     }
{ geöffnet sein.                                        }
{ Die Prozedur "PlaySample" spielt den Sound dann ab.   }
{ Vorraussetzung ist, daß das Audio-Device geöffnet und }
{ initialisiert ist.                                    }

{ MaxonPascal3-Anpassung / Test:  Falk Zühlsdorff (PackMAN) 1994 }
{ nutzt richtiggestellte "Workbench/startup.h"  von PackMAN      }

{ Bsp.-Sound: MPascal3:demo/Sound                                }

USES ExecSupport,ExecIO,DOS;

{$incl 'devices/audio.h', "workbench/startup.h" }

Const
  CLOCK = 3579545;


TYPE
  File8SVX = File of Byte;

  VHDRTYPE = RECORD
               OneShotHiSamples: Long;
               RepeatHiSamples: Long;
               SamplesPerHiCycle: Long;
               SamplesPerSecond: Word;
               Oktaven: Byte;
               PackFlag: Byte;
               Volume: Long
             END;

  SamplePtr = ^SampleTYPE;
  SampleTYPE = RECORD
                 VHDR: VHDRTYPE;
                 Len: LongInt;
                 Data: ARRAY[0..MaxLongInt] OF Short
               END;


VAR F1                  : File8SVX;
    Filename            : STRING;
    MySample            : SamplePtr;
    allocIOB, lockIOB   : ^IOAudio;
    port                : ^MsgPort;
    mydevice            : p_Device;
    err                 : Long;


FUNCTION LoadSample(VAR f: File8SVX): SamplePtr;
  TYPE StrTYPE = String[5];
  VAR sp: SamplePtr;
      lw, err: LongInt;
      s1: StrTYPE;
      HeadFlag, BodyFlag: Boolean;
      VHDR: VHDRTYPE;

  FUNCTION ReadStr4: StrTYPE;
    VAR s: Array[1..5] OF Byte;
        s2: String[5];
    BEGIN
      Read(f, s[1], s[2], s[3], s[4] );
      s[5] := 0;
      s2 := Str(^s);
      ReadStr4 := S2;
    END;

  FUNCTION ReadLong: LongInt;
    VAR b1, b2, b3, b4: Byte;
    BEGIN
      Read(f, b1, b2, b3, b4 );
      ReadLong := Long( Long(b1 shl 8 + b2) shl 8 + b3) shl 8 + b4
    END;

  PROCEDURE Overread(Anz: LongInt);
    VAR b: Byte;
    BEGIN
      While Anz>0 DO
        BEGIN
          Read(f, b);
          Dec(Anz)
        END
    END;

  PROCEDURE ReadTo(Point: Ptr; Anz: Long );
    VAR p2: ^Array[1..MaxLongInt] Of Byte;
        i: LongInt;
    BEGIN
      p2 := Point;
      For i:=1 to Anz Do Read(f, p2^[i]);
      { Blockread(f, p2^, Anz); }
    END;


  BEGIN    { LoadSample }
    s1 := ReadStr4;
    IF s1 <> 'FORM' THEN
      BEGIN
        Writeln('Kein IFF-Format!');
        LoadSample := Nil;
        Exit
      END;
    lw := ReadLong;
    s1 := ReadStr4;
    IF s1 <> '8SVX' THEN
      BEGIN
        Writeln('Kein 8SVX-File!');
        LoadSample := Nil;
        Exit
      END;

    sp := Nil;
    HeadFlag := false;
    BodyFlag := false;

    While not (HeadFlag and BodyFlag) Do
      BEGIN
        s1 := ReadStr4;
        lw := ReadLong;
        IF s1='VHDR' THEN
          BEGIN
            ReadTo(^VHDR, SizeOf(VHDRTYPE));
            Overread(lw-SizeOf(VHDRTYPE));
            HeadFlag := true
          END
        ELSE
        IF s1='BODY' THEN
          BEGIN
            IF not HeadFlag THEN
              BEGIN
                Writeln('Fehler in DateIFormat!');
                LoadSample := Nil;
                Exit
              END;
            sp := Ptr (Alloc_Mem (lw+4+SizeOf(VHDRTYPE), 2));
            sp^.Len := lw+4+SizeOf(VHDRTYPE);
            sp^.VHDR := VHDR;
            BlockRead(f, sp^.Data, lw);
            BodyFlag := true
          END
        ELSE
          OverRead(lw);

      END;

    LoadSample := sp
  END;



PROCEDURE InitAudio;
  { Device öffnen, Ports einrichten, Kanäle reservieren usw. }
  VAR alloctable : Array[1..4] Of Byte;
  BEGIN
    port := CreatePort ('sound example', 0);
    IF port=Nil THEN Halt(0);

    allocIOB := CreateExtIO (port, SizeOf (IOAudio));
    IF allocIOB=Nil THEN Halt(0);

    lockIOB := CreateExtIO (port, SizeOf (IOAudio));
    IF lockIOB=Nil THEN Halt(0);

    Open_Device(AUDIONAME, 0, AllocIOB, 0);

    mydevice := allocIOB^.ioa_Request.io_Device;
    lockIOB^.ioa_Request.io_Device := mydevice;

    AllocTable[1] := %0001;
    AllocTable[2] := %0010;
    AllocTable[3] := %0100;
    AllocTable[4] := %1000;

    With allocIOB^, ioa_Request, io_Message Do
      BEGIN
        io_Flags := ADIOF_NOWAIT;
        ioa_Data := ^AllocTable;
        ioa_Length := 4;
        io_Command := ADCMD_ALLOCATE;
        BEGINIO(allocIOB);
      END;
    err:=WaitIO(PTR(allocIOB));
    IF err <> 0 THEN
      Error('Allocation failed');

    With lockIOB^, ioa_Request Do
      BEGIN
        io_Unit := allocIOB^.ioa_Request.io_Unit;
        io_Command := ADCMD_LOCK;
        ioa_AllocKey := allocIOB^.ioa_AllocKey;
      END;
    SENDIO(PTR(lockIOB));
    IF CheckIO(PTR(lockIOB)) THEN
      Error('Channel stolen.');
  END;

PROCEDURE PlaySample(s: SamplePtr);
  VAR Laenge,Rate: Long;
  BEGIN
    With s^.VHDR Do
      BEGIN
        Laenge := OneShotHiSamples+RepeatHiSamples;
        Rate := CLOCK div SamplesPerSecond;
      END;

    With lockIOB^, ioa_Request Do
      BEGIN
        io_Command := CMD_WRITE;
        io_Flags := ADIOF_PERVOL;
        ioa_Data := ^s^.Data;
        ioa_Length := Laenge;
        ioa_Volume := 64;
        ioa_Period := Rate;
        ioa_Cycles := 1;
      END;
    BEGINIO(lockIOB);
    IF not fromWB THEN writeln('Playing...');
    err:=WaitIO(PTR(lockIOB))
 END;



PROCEDURE StartVonWorkbench;
  { Workbench-Parameter auswerten }
  VAR StMess  : p_WBStartup;
      OldLock : BPTR;
  BEGIN
    StMess := StartupMessage;
      { "StartupMessage" ist ein typfreier "Ptr"-Pointer. Deshalb
        wird zum Auswerten der Hilfszeiger "StMess" benötigt.    }
    IF StMess^.sm_NumArgs < 2 THEN
      { Anzahl der Argumente, d. h. der aktiven Icons. Das erste
        Argument ist immer das Programm selbst. Also müssen mindestens
        zwei Argumente vorhanden sein. }
      Filename := ''
    ELSE
      WITH StMess^.sm_ArgList^[2] DO
        BEGIN
          { Als Datei wird das Argument Nr. #2 genommen. Falls noch
            mehr Icons aktiviert sing (z. B. durch "ShIFt-Klick",
            werden diese ignoroert. }
          Filename:=wa_Name;
          { reiner Name ohne Pfad! Deshalb muss das aktuelle Verzeichnis
            entsprechEND gewählt werden:  }
          OldLock:=CurrentDir(wa_Lock );
        END;
  END;


BEGIN { Main }

  { Dateinamen bestimmen }

  IF FromWB THEN
    BEGIN
      StartVonWorkbench;
      IF Filename = '' THEN Exit
    END
  ELSE { Start von CLI }
    BEGIN
      Filename := ParameterStr;
      IF ParameterLen < 80 THEN Filename[ParameterLen+1] := chr(0);
      While Filename[1] = ' ' Do
        Delete (Filename, 1, 1);    { führende Spaces löschen }
      While (Filename <> '') and (Filename[Length(Filename)] <= ' ') Do
        Filename[Length(Filename)] := chr(0);

      IF Filename='' THEN
        BEGIN
          Writeln(#e'33mPlay8SVX'#e'31m - geschrieben von '#e'33mJens Gelhar'#&
                  #e'31m 1990 mit Kickpascal 2.0');
          Write('Dateiname : '); Readln(Filename);
          IF Filename='' THEN Exit
        END;
    END;

  Reset (F1, Filename);
  IF IOResult <> 0 THEN
    Error('Datei konnte nicht geöffnet werden.');

  Buffer (F1, 5000);
  IF not FromWB THEN Writeln ('Loading ', Filename, '...');
  MySample := LoadSample (F1);
  Close (F1);

  IF MySample <> Nil THEN
    BEGIN
      InitAudio;
      PlaySample(MySample);
      Close_Device(allocIOB);
    END;

END.