MODULE Play8SVX;  (* Play8SVX 3.1  Benchmark Modula-2 *)
(*
   Play8SVX 3.1                Mike Scalora                  PLink : SCARY

   This MODULE is public domain.   Freely distributable as long as this 
   notice stays in.

   This program was originally uploaded to PeopleLink's Amiga Zone.  The 
   Amiga Zone has well over 3000 members, and a library of thousands of 
   public domain files.  If you're interested in joining us, call 
      800-524-0100 (voice) 
   or 800-826-8855 (modem).

   SYNTAX:

     PLAY8SVX filename [-n] [+s] [@v] [ filename [-n] [+s] [@v] ...]

   WHERE:
     n - [1-9] number of times to play the sample.  Default: 1
     s - [1-65535] sample playback speed.  Default: VHDR.SamPerSec
     v - [0-64] sample playback volume.  Default: 64

*)
FROM PortsUtil   IMPORT CreatePort, DeletePort;
FROM AudioDevice IMPORT AudioName, IOAudio, ADIOPerVol;
FROM SYSTEM      IMPORT BYTE, ADR, ADDRESS;
FROM IODevices   IMPORT CmdWrite, IOQuick, IOFlagsSet, BeginIO, WaitIO,
                        OpenDevice, CloseDevice;
FROM Memory      IMPORT AllocMem, FreeMem, MemReqSet, MemPublic, MemChip;
FROM System      IMPORT argv, argc;
FROM AmigaDOS    IMPORT Open, Read, Seek, Close, FileHandle, ModeOldFile,
                        Write, Output;

CONST
  FORMid = 0464F524DH;  (*FORM*)
  BODYid = 0424F4459H;  (*BODY*)
  VHDRid = 056484452H;  (*VHDR*)
  SVXid  = 038535658H;  (*8SVX*)
  MAXSAMP = 128D * 1024D - 1D;

VAR
  N,C,D,CC,V : CARDINAL;
  S   : LONGCARD;
  FC : CHAR;
  stdout : FileHandle;

PROCEDURE WriteString(S : ARRAY OF CHAR);
  VAR
    C : CARDINAL;
    err : LONGINT;
  BEGIN
    IF stdout=NIL THEN RETURN; END;
    C := 0; WHILE S[C]#0C DO INC(C); END;
    err := Write(stdout,ADR(S),LONGCARD(C));
  END WriteString;

PROCEDURE MAIN(S : ADDRESS; Count, Volume : CARDINAL; Speed : LONGCARD);

VAR
  Sound,
  Sound2 : IOAudio;
  SoundData : ADDRESS;
  I         : INTEGER;
  err       : LONGINT;
  SoundUnit : LONGCARD;  
  Reps : CARDINAL;

  SFH : FileHandle;

  ILen : LONGINT;
  AnID, ALen, AllocLen : LONGCARD;
  
  VHDR : RECORD
    OSHS, RHS, SPHC : LONGCARD;
    SamPerSec : CARDINAL;
    Octave, Comp, Vol : BYTE; 
    a, b, c : LONGCARD;
  END;

PROCEDURE Read4(a : ADDRESS);
  BEGIN
    IF Read(SFH,a,4D)#4D THEN 
      WriteString('Error reading from input file!\n'); Close(SFH); HALT; END;
  END Read4;

BEGIN
  SFH := Open(S,ModeOldFile);
  IF SFH=FileHandle(0) THEN
    WriteString('Could not open file input file!\n'); HALT; END;

  Read4(ADR(AnID));       (* read FORM id *)
  IF AnID#FORMid THEN WriteString('Input file is not IFF format!\n');
    Close(SFH); HALT; END;
  Read4(ADR(ALen));       (* read FORM length *)
  Read4(ADR(AnID));       (* read 8SVX id *)
  IF AnID#SVXid THEN WriteString('Input file is not 8SVX IFF format!\n');
    Close(SFH); HALT; END;
  Read4(ADR(AnID));
  IF AnID#VHDRid THEN 
    WriteString('Input file is not valid 8SVX IFF format!\n'); HALT; END; 
  Read4(ADR(ALen));  
  ILen := Read(SFH,ADR(VHDR),ALen);    
  IF LONGCARD(ILen)#ALen THEN
    WriteString('Error reading file!\n'); Close(SFH); HALT; END;

  Read4(ADR(AnID));       (* read next id *)
  Read4(ADR(ALen));       (* read next length *)
  I := 0;
  WHILE (AnID#BODYid) AND (I<20) DO INC(I);
    ILen := Seek(SFH,LONGINT(ALen),0D); 
    IF ILen=-1D THEN
      WriteString('Error seeking file!\n'); Close(SFH); HALT; END;
    Read4(ADR(AnID));       (* read next id *)
    Read4(ADR(ALen));       (* read next length *)
  END;
  IF AnID#BODYid THEN WriteString('No BODY found in input file!\n');
    Close(SFH); HALT; END;

  SoundData := AllocMem(ALen,MemReqSet{MemPublic,MemChip});
  IF SoundData=NIL THEN WriteString('Could not allocate CHIP memory!\n');
    Close(SFH); HALT; END;
  AllocLen := ALen;

  AnID := Read(SFH,SoundData,ALen); Close(SFH);

  IF AnID<ALen THEN WriteString('Error while readin BODY chunk\n');
    FreeMem(SoundData,ALen); HALT; END;

  Sound.ioaRequest.ioMessage.mnReplyPort := CreatePort(ADR('MyAIOPort'),0);
  IF Sound.ioaRequest.ioMessage.mnReplyPort=NIL THEN 
    FreeMem(SoundData,ALen);
    WriteString('Could not create Reply Port!\n'); HALT; END;

  SoundUnit := 03050A0CH;                              (* any stereo pair *)
  Sound.ioaRequest.ioMessage.mnNode.lnPri := BYTE(10);
  Sound.ioaData := ADR(SoundUnit);
  Sound.ioaLength := 4D; (*SIZE(SoundUnit);*)

  err := OpenDevice(ADR(AudioName),0D,ADR(Sound.ioaRequest),0D);
  IF err#0D THEN WriteString('Could not open Audio Device!\n'); 
    FreeMem(SoundData,ALen); HALT; END; 

  Speed := Speed MOD 10000H;
  IF Speed#0D THEN
    VHDR.SamPerSec := CARDINAL(Speed);
  END;

  WITH Sound DO
    ioaRequest.ioCommand := CmdWrite;
    ioaRequest.ioFlags := IOFlagsSet{IOQuick,ADIOPerVol};
    ioaData := SoundData;
    ioaCycles := Count;
    ioaPeriod := CARDINAL(3579545D DIV LONGCARD(VHDR.SamPerSec));
    ioaVolume := Volume;
  END;
  Sound2 := Sound;

  IF ALen<=MAXSAMP THEN Count := 1; 
  ELSE Sound.ioaCycles := 1; Sound2.ioaCycles := 1; END;

  FOR Reps := 1 TO Count DO
    ALen := AllocLen;
    Sound.ioaLength := ALen;
    Sound.ioaData := SoundData;
    IF ALen<=MAXSAMP THEN
      BeginIO(ADR(Sound.ioaRequest));
      err := WaitIO(ADR(Sound.ioaRequest));
    ELSE
      Sound.ioaLength := MAXSAMP;
      BeginIO(ADR(Sound.ioaRequest));
      Sound2.ioaData := ADDRESS(LONGCARD(SoundData)+MAXSAMP);
      ALen := ALen-MAXSAMP;
      IF ALen<=MAXSAMP THEN
        Sound2.ioaLength := ALen;
        BeginIO(ADR(Sound2.ioaRequest));
      ELSE
        Sound2.ioaLength := MAXSAMP;
        BeginIO(ADR(Sound2.ioaRequest));
        ALen := ALen-MAXSAMP;
        err := WaitIO(ADR(Sound.ioaRequest));
        Sound.ioaData := ADDRESS(LONGCARD(SoundData)+MAXSAMP*2D);
        IF ALen<=MAXSAMP THEN
          Sound.ioaLength := ALen;
          BeginIO(ADR(Sound.ioaRequest));
        ELSE
          Sound.ioaLength := MAXSAMP;
          BeginIO(ADR(Sound.ioaRequest));
          ALen := ALen-MAXSAMP;
          err := WaitIO(ADR(Sound.ioaRequest));
          Sound2.ioaData := ADDRESS(LONGCARD(SoundData)+MAXSAMP*3D);
          Sound2.ioaLength := ALen;
          BeginIO(ADR(Sound2.ioaRequest));
        END;
      END;
      err := WaitIO(ADR(Sound.ioaRequest));
      err := WaitIO(ADR(Sound.ioaRequest));
    END;
  END;

  FreeMem(SoundData,AllocLen);

  CloseDevice(ADR(Sound));

  DeletePort(Sound.ioaRequest.ioMessage.mnReplyPort^);
END MAIN;


BEGIN
  stdout := Output();

  IF (argc<2) OR ((argv^[1]^[0]='?') AND (argv^[1]^[1]=0C)) THEN 
    WriteString('\nUsage\n\n  ');
    C := 0;
      WHILE argv^[0]^[C]#0C DO
        argv^[0]^[C] := CAP(argv^[0]^[C]); INC(C);
      END;
    WriteString(argv^[0]^);
    WriteString(' filename [ -n ] [ filename [ -n ] ...]\n\n'); 
    HALT;
  ELSE
    C := 1;
    WHILE C<argc DO
      N := C; INC(C);
      D := 1; S := 0; V := 64; 
      IF (C<argc) THEN FC := argv^[C]^[0]; END;
      WHILE (C<argc) AND ((FC='-') OR (FC='+') OR (FC='@')) DO
        IF FC='-' THEN
          D := ABS(INTEGER(ORD(argv^[C]^[1]))-ORD('0'));
          IF D>9 THEN D := 1; END; INC(C);
        ELSIF FC='+' THEN
          CC := 1;
          WHILE (argv^[C]^[CC]>='0') AND (argv^[C]^[CC]<='9') DO
            S := S * 10D;
            S := S + LONGCARD(ABS(INTEGER(ORD(argv^[C]^[CC]))-ORD('0')));
            INC(CC);
          END;
          INC(C);
        ELSIF FC='@' THEN
          V := ABS(INTEGER(ORD(argv^[C]^[1]))-ORD('0'));
          IF argv^[C]^[2]#0C THEN
            V := V * 10 + CARDINAL(ABS(INTEGER(ORD(argv^[C]^[2]))-ORD('0')));
          END;
          V := V MOD 65;
          INC(C);
        END;
        IF (C<argc) THEN FC := argv^[C]^[0]; END;
      END;
      MAIN(argv^[N],D,V,S);
    END;
  END; 
END Play8SVX.