home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 166.lha / Play8SVX.mod < prev    next >
Encoding:
Text File  |  1988-04-28  |  7.5 KB  |  252 lines
  1. MODULE Play8SVX;  (* Play8SVX 3.1  Benchmark Modula-2 *)
  2. (*
  3.    Play8SVX 3.1                Mike Scalora                  PLink : SCARY
  4.  
  5.    This MODULE is public domain.   Freely distributable as long as this 
  6.    notice stays in.
  7.  
  8.    This program was originally uploaded to PeopleLink's Amiga Zone.  The 
  9.    Amiga Zone has well over 3000 members, and a library of thousands of 
  10.    public domain files.  If you're interested in joining us, call 
  11.       800-524-0100 (voice) 
  12.    or 800-826-8855 (modem).
  13.  
  14.    SYNTAX:
  15.  
  16.      PLAY8SVX filename [-n] [+s] [@v] [ filename [-n] [+s] [@v] ...]
  17.  
  18.    WHERE:
  19.      n - [1-9] number of times to play the sample.  Default: 1
  20.      s - [1-65535] sample playback speed.  Default: VHDR.SamPerSec
  21.      v - [0-64] sample playback volume.  Default: 64
  22.  
  23. *)
  24. FROM PortsUtil   IMPORT CreatePort, DeletePort;
  25. FROM AudioDevice IMPORT AudioName, IOAudio, ADIOPerVol;
  26. FROM SYSTEM      IMPORT BYTE, ADR, ADDRESS;
  27. FROM IODevices   IMPORT CmdWrite, IOQuick, IOFlagsSet, BeginIO, WaitIO,
  28.                         OpenDevice, CloseDevice;
  29. FROM Memory      IMPORT AllocMem, FreeMem, MemReqSet, MemPublic, MemChip;
  30. FROM System      IMPORT argv, argc;
  31. FROM AmigaDOS    IMPORT Open, Read, Seek, Close, FileHandle, ModeOldFile,
  32.                         Write, Output;
  33.  
  34. CONST
  35.   FORMid = 0464F524DH;  (*FORM*)
  36.   BODYid = 0424F4459H;  (*BODY*)
  37.   VHDRid = 056484452H;  (*VHDR*)
  38.   SVXid  = 038535658H;  (*8SVX*)
  39.   MAXSAMP = 128D * 1024D - 1D;
  40.  
  41. VAR
  42.   N,C,D,CC,V : CARDINAL;
  43.   S   : LONGCARD;
  44.   FC : CHAR;
  45.   stdout : FileHandle;
  46.  
  47. PROCEDURE WriteString(S : ARRAY OF CHAR);
  48.   VAR
  49.     C : CARDINAL;
  50.     err : LONGINT;
  51.   BEGIN
  52.     IF stdout=NIL THEN RETURN; END;
  53.     C := 0; WHILE S[C]#0C DO INC(C); END;
  54.     err := Write(stdout,ADR(S),LONGCARD(C));
  55.   END WriteString;
  56.  
  57. PROCEDURE MAIN(S : ADDRESS; Count, Volume : CARDINAL; Speed : LONGCARD);
  58.  
  59. VAR
  60.   Sound,
  61.   Sound2 : IOAudio;
  62.   SoundData : ADDRESS;
  63.   I         : INTEGER;
  64.   err       : LONGINT;
  65.   SoundUnit : LONGCARD;  
  66.   Reps : CARDINAL;
  67.  
  68.   SFH : FileHandle;
  69.  
  70.   ILen : LONGINT;
  71.   AnID, ALen, AllocLen : LONGCARD;
  72.   
  73.   VHDR : RECORD
  74.     OSHS, RHS, SPHC : LONGCARD;
  75.     SamPerSec : CARDINAL;
  76.     Octave, Comp, Vol : BYTE; 
  77.     a, b, c : LONGCARD;
  78.   END;
  79.  
  80. PROCEDURE Read4(a : ADDRESS);
  81.   BEGIN
  82.     IF Read(SFH,a,4D)#4D THEN 
  83.       WriteString('Error reading from input file!\n'); Close(SFH); HALT; END;
  84.   END Read4;
  85.  
  86. BEGIN
  87.   SFH := Open(S,ModeOldFile);
  88.   IF SFH=FileHandle(0) THEN
  89.     WriteString('Could not open file input file!\n'); HALT; END;
  90.  
  91.   Read4(ADR(AnID));       (* read FORM id *)
  92.   IF AnID#FORMid THEN WriteString('Input file is not IFF format!\n');
  93.     Close(SFH); HALT; END;
  94.   Read4(ADR(ALen));       (* read FORM length *)
  95.   Read4(ADR(AnID));       (* read 8SVX id *)
  96.   IF AnID#SVXid THEN WriteString('Input file is not 8SVX IFF format!\n');
  97.     Close(SFH); HALT; END;
  98.   Read4(ADR(AnID));
  99.   IF AnID#VHDRid THEN 
  100.     WriteString('Input file is not valid 8SVX IFF format!\n'); HALT; END; 
  101.   Read4(ADR(ALen));  
  102.   ILen := Read(SFH,ADR(VHDR),ALen);    
  103.   IF LONGCARD(ILen)#ALen THEN
  104.     WriteString('Error reading file!\n'); Close(SFH); HALT; END;
  105.  
  106.   Read4(ADR(AnID));       (* read next id *)
  107.   Read4(ADR(ALen));       (* read next length *)
  108.   I := 0;
  109.   WHILE (AnID#BODYid) AND (I<20) DO INC(I);
  110.     ILen := Seek(SFH,LONGINT(ALen),0D); 
  111.     IF ILen=-1D THEN
  112.       WriteString('Error seeking file!\n'); Close(SFH); HALT; END;
  113.     Read4(ADR(AnID));       (* read next id *)
  114.     Read4(ADR(ALen));       (* read next length *)
  115.   END;
  116.   IF AnID#BODYid THEN WriteString('No BODY found in input file!\n');
  117.     Close(SFH); HALT; END;
  118.  
  119.   SoundData := AllocMem(ALen,MemReqSet{MemPublic,MemChip});
  120.   IF SoundData=NIL THEN WriteString('Could not allocate CHIP memory!\n');
  121.     Close(SFH); HALT; END;
  122.   AllocLen := ALen;
  123.  
  124.   AnID := Read(SFH,SoundData,ALen); Close(SFH);
  125.  
  126.   IF AnID<ALen THEN WriteString('Error while readin BODY chunk\n');
  127.     FreeMem(SoundData,ALen); HALT; END;
  128.  
  129.   Sound.ioaRequest.ioMessage.mnReplyPort := CreatePort(ADR('MyAIOPort'),0);
  130.   IF Sound.ioaRequest.ioMessage.mnReplyPort=NIL THEN 
  131.     FreeMem(SoundData,ALen);
  132.     WriteString('Could not create Reply Port!\n'); HALT; END;
  133.  
  134.   SoundUnit := 03050A0CH;                              (* any stereo pair *)
  135.   Sound.ioaRequest.ioMessage.mnNode.lnPri := BYTE(10);
  136.   Sound.ioaData := ADR(SoundUnit);
  137.   Sound.ioaLength := 4D; (*SIZE(SoundUnit);*)
  138.  
  139.   err := OpenDevice(ADR(AudioName),0D,ADR(Sound.ioaRequest),0D);
  140.   IF err#0D THEN WriteString('Could not open Audio Device!\n'); 
  141.     FreeMem(SoundData,ALen); HALT; END; 
  142.  
  143.   Speed := Speed MOD 10000H;
  144.   IF Speed#0D THEN
  145.     VHDR.SamPerSec := CARDINAL(Speed);
  146.   END;
  147.  
  148.   WITH Sound DO
  149.     ioaRequest.ioCommand := CmdWrite;
  150.     ioaRequest.ioFlags := IOFlagsSet{IOQuick,ADIOPerVol};
  151.     ioaData := SoundData;
  152.     ioaCycles := Count;
  153.     ioaPeriod := CARDINAL(3579545D DIV LONGCARD(VHDR.SamPerSec));
  154.     ioaVolume := Volume;
  155.   END;
  156.   Sound2 := Sound;
  157.  
  158.   IF ALen<=MAXSAMP THEN Count := 1; 
  159.   ELSE Sound.ioaCycles := 1; Sound2.ioaCycles := 1; END;
  160.  
  161.   FOR Reps := 1 TO Count DO
  162.     ALen := AllocLen;
  163.     Sound.ioaLength := ALen;
  164.     Sound.ioaData := SoundData;
  165.     IF ALen<=MAXSAMP THEN
  166.       BeginIO(ADR(Sound.ioaRequest));
  167.       err := WaitIO(ADR(Sound.ioaRequest));
  168.     ELSE
  169.       Sound.ioaLength := MAXSAMP;
  170.       BeginIO(ADR(Sound.ioaRequest));
  171.       Sound2.ioaData := ADDRESS(LONGCARD(SoundData)+MAXSAMP);
  172.       ALen := ALen-MAXSAMP;
  173.       IF ALen<=MAXSAMP THEN
  174.         Sound2.ioaLength := ALen;
  175.         BeginIO(ADR(Sound2.ioaRequest));
  176.       ELSE
  177.         Sound2.ioaLength := MAXSAMP;
  178.         BeginIO(ADR(Sound2.ioaRequest));
  179.         ALen := ALen-MAXSAMP;
  180.         err := WaitIO(ADR(Sound.ioaRequest));
  181.         Sound.ioaData := ADDRESS(LONGCARD(SoundData)+MAXSAMP*2D);
  182.         IF ALen<=MAXSAMP THEN
  183.           Sound.ioaLength := ALen;
  184.           BeginIO(ADR(Sound.ioaRequest));
  185.         ELSE
  186.           Sound.ioaLength := MAXSAMP;
  187.           BeginIO(ADR(Sound.ioaRequest));
  188.           ALen := ALen-MAXSAMP;
  189.           err := WaitIO(ADR(Sound.ioaRequest));
  190.           Sound2.ioaData := ADDRESS(LONGCARD(SoundData)+MAXSAMP*3D);
  191.           Sound2.ioaLength := ALen;
  192.           BeginIO(ADR(Sound2.ioaRequest));
  193.         END;
  194.       END;
  195.       err := WaitIO(ADR(Sound.ioaRequest));
  196.       err := WaitIO(ADR(Sound.ioaRequest));
  197.     END;
  198.   END;
  199.  
  200.   FreeMem(SoundData,AllocLen);
  201.  
  202.   CloseDevice(ADR(Sound));
  203.  
  204.   DeletePort(Sound.ioaRequest.ioMessage.mnReplyPort^);
  205. END MAIN;
  206.  
  207.  
  208. BEGIN
  209.   stdout := Output();
  210.  
  211.   IF (argc<2) OR ((argv^[1]^[0]='?') AND (argv^[1]^[1]=0C)) THEN 
  212.     WriteString('\nUsage\n\n  ');
  213.     C := 0;
  214.       WHILE argv^[0]^[C]#0C DO
  215.         argv^[0]^[C] := CAP(argv^[0]^[C]); INC(C);
  216.       END;
  217.     WriteString(argv^[0]^);
  218.     WriteString(' filename [ -n ] [ filename [ -n ] ...]\n\n'); 
  219.     HALT;
  220.   ELSE
  221.     C := 1;
  222.     WHILE C<argc DO
  223.       N := C; INC(C);
  224.       D := 1; S := 0; V := 64; 
  225.       IF (C<argc) THEN FC := argv^[C]^[0]; END;
  226.       WHILE (C<argc) AND ((FC='-') OR (FC='+') OR (FC='@')) DO
  227.         IF FC='-' THEN
  228.           D := ABS(INTEGER(ORD(argv^[C]^[1]))-ORD('0'));
  229.           IF D>9 THEN D := 1; END; INC(C);
  230.         ELSIF FC='+' THEN
  231.           CC := 1;
  232.           WHILE (argv^[C]^[CC]>='0') AND (argv^[C]^[CC]<='9') DO
  233.             S := S * 10D;
  234.             S := S + LONGCARD(ABS(INTEGER(ORD(argv^[C]^[CC]))-ORD('0')));
  235.             INC(CC);
  236.           END;
  237.           INC(C);
  238.         ELSIF FC='@' THEN
  239.           V := ABS(INTEGER(ORD(argv^[C]^[1]))-ORD('0'));
  240.           IF argv^[C]^[2]#0C THEN
  241.             V := V * 10 + CARDINAL(ABS(INTEGER(ORD(argv^[C]^[2]))-ORD('0')));
  242.           END;
  243.           V := V MOD 65;
  244.           INC(C);
  245.         END;
  246.         IF (C<argc) THEN FC := argv^[C]^[0]; END;
  247.       END;
  248.       MAIN(argv^[N],D,V,S);
  249.     END;
  250.   END; 
  251. END Play8SVX.
  252.