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.                                    }

Uses ExecSupport, ExecIO;

{$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(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(lockIOB);
    If CheckIO(lockIOB) <> 0 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(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.