home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_disks / 300-399 / ff339.lzh / PCQ / Examples / Play8.p < prev    next >
Text File  |  1990-03-19  |  7KB  |  276 lines
  1. Program Play8;
  2.  
  3. {
  4.     Play8.p
  5.  
  6.     Play a one-shot 8SVX IFF sound file.  The command line is simply
  7.     Play8 filename, where the filename is any path and must be
  8.     present.  This code was derived from Eric Jacobsen's spIFF.c.
  9.     The differences between this and spIFF.c:
  10.        a) This was translated from C to Pascal
  11.        b) Several sound files in my collection had odd-length
  12.         name or annotation fields.  That is, the field lengths
  13.         in the file were odd, but the actual data was padded
  14.         with an extra 0 byte.  So this program handles that.
  15.        c) I added decompression routines taken from an old IFF
  16.         documentation disk.  I couldn't find any properly
  17.         formatted compressed sound files, however, so I'm not
  18.         sure if the decompression is accurate.  The program
  19.         will certainly try to decompress files, but mine came
  20.         out garbage.  Based on the samples I've accumulated,
  21.         it seems that few of them are compressed anyway.
  22.  
  23.     In my distribution, I included a sample sample, as it were,
  24.     called UseTheForce.8SVX, which obviously came from Star Wars.
  25. }
  26.  
  27. {$I ":Include/Exec.i"}
  28. {$I ":Include/Ports.i"  I include this here so ExecIO won't have to.
  29.             Otherwise it would try to load "Include/Ports.i",
  30.             which would not necessarily fit in here.}
  31. {$I ":Include/ExecIO.i"}
  32. {$I ":Include/ExecIOUtils.i"}
  33. {$I ":Include/DOS.i"}
  34. {$I ":Include/StringLib.i"}
  35. {$I ":Include/Audio.i"}
  36. {$I ":Include/Parameters.i"}
  37.  
  38. type
  39.     Voice8Header = record
  40.     oneShotHiSamples,
  41.     repeatHiSamples,
  42.     samplesPreHiCycle : Integer;
  43.     samplesPerSec : Short;
  44.     ctOctave    : Byte;
  45.     sCompression    : Byte;
  46.     volume : Integer;
  47.     end;
  48.  
  49. type
  50.     FibTable = Array [0..15] of Byte;
  51.  
  52. const
  53.     ckname : String = Nil;
  54.     NoMem  : String = "\nNot enough memory.\n";
  55.     reps : Integer = 1;
  56.     wrt_flg : Boolean = True;
  57.     ioa : IOAudioPtr = Nil;
  58.     dbuf : Address = Nil;
  59.     FP : FileHandle = Nil;
  60.     codeToDelta : FibTable = (-34, -21, -13, -8, -5, -3, -2, -1, 0,
  61.                 1, 2, 3, 5, 8, 13, 21);
  62.  
  63. var
  64.     VHeader : Voice8Header;
  65.     chan : Char;
  66.     s, ps : String;
  67.     dlen, oerr, i : Integer;
  68.     chnk : ^Integer;
  69.     ckbuffer : Array [0..2] of Short;
  70.     t : Address;
  71.  
  72. procedure BeginIO(io : IORequestPtr);
  73. begin
  74. {$A    move.l    8(a5),a1
  75.     move.l    $14(a1),a6
  76.     jsr    -$1E(a6)
  77. }
  78. end;
  79.  
  80. Function D1Unpack(source : String; n : Integer; dest : String; x : Byte) : Byte;
  81. var
  82.     d : Byte;
  83.     i, lim : Integer;
  84. begin
  85.     lim := n shl 1;
  86.     for i := 0 to lim - 1 do begin
  87.     d := Ord(Source[i shr 1]);
  88.     if Odd(i) then
  89.         d := d and 15
  90.     else
  91.         d := d shr 4;
  92.     x := x + codeToDelta[d];
  93.     dest[i] := Chr(x);
  94.     end;
  95.     D1Unpack := x;
  96. end;
  97.  
  98. Procedure DUnpack(source : String; n : Integer; dest : Address);
  99. var
  100.     x : Byte;
  101. begin
  102.     x := D1Unpack(Adr(source[1]), n - 2, dest, Ord(source[0]));
  103. end;
  104.  
  105. Procedure OpenFile;
  106. var
  107.     NameBuffer : Array [0..127] of char;
  108.     Name : String;
  109. begin
  110.     Name := Adr(NameBuffer);
  111.     GetParam(1, Name);
  112.     if strlen(Name) = 0 then begin
  113.     Writeln('Usage: Play8 filename');
  114.     Exit(10);
  115.     end;
  116.     FP := DOSOpen(Name, ModeOldFile);
  117.     if FP = Nil then begin
  118.     Writeln('Could not open ', Name);
  119.     Exit(10);
  120.     end;
  121. end;
  122.  
  123. procedure CleanUp;
  124. begin
  125.     if ioa <> Nil then begin
  126.     with ioa^.ioaRequest.ioMessage do begin
  127.         if mnReplyPort <> Nil then
  128.         DeletePort(mnReplyPort);
  129.     end;
  130.     FreeMem(ioa, SizeOf(IOAudio));
  131.     end;
  132.     if dbuf <> Nil then
  133.     FreeMem(dbuf, dlen);
  134.     if FP <> nil then
  135.     DOSClose(FP);
  136. end;
  137.  
  138.  
  139. Procedure pExit(Msg : String);
  140. begin
  141.     Writeln(Msg);
  142.     CleanUp;
  143.     Exit(20);
  144. end;
  145.  
  146. Procedure DoRead(Buffer : Address; Length : Integer);
  147. var
  148.     ReadResult : Integer;
  149. begin
  150.     ReadResult := DOSRead(FP, Buffer, Length);
  151.     if ReadResult <> Length then
  152.     pExit("Read error");
  153. end;
  154.  
  155. Procedure WriteData(len : Integer);
  156. var
  157.     MBuffer : Array [0..127] of Char;
  158.     MString : String;
  159. begin
  160.     MString := Adr(MBuffer);
  161.     if Odd(len) then
  162.     len := Succ(len);
  163.     MBuffer[127] := '\0';
  164.     while len > 127 do begin
  165.     DoRead(MString, 127);
  166.     if wrt_flg then
  167.         Write(MString);
  168.     len := len - 127;
  169.     end;
  170.     if len > 0 then begin
  171.     DoRead(MString, len);
  172.     MString[len] := '\0';
  173.     if wrt_flg then
  174.         Writeln(MString);
  175.     end;
  176.     wrt_flg := True;
  177. end;
  178.  
  179. begin
  180.     ckname := Adr(ckbuffer);
  181.     ckname[4] := '\0';
  182.     chan := Chr(15);
  183.     OpenFile;
  184.     DoRead(ckname, 4);
  185.     if streq(ckname, "FORM") then begin
  186.     DoRead(ckname,4);    { Get size out of the way. }
  187.     DoRead(ckname,4);
  188.     if streq(ckname,"8SVX") then begin
  189.         DoRead(ckname,4);
  190.         while not streq(ckname,"BODY") do begin
  191.         DoRead(Adr(dlen), 4);
  192.         if streq(ckname,"VHDR") then
  193.             DoRead(Adr(VHeader), SizeOf(Voice8Header))
  194.         else begin
  195.             chnk := Address(ckname);
  196.             case chnk^ of
  197.               $4e414d45: Write("\nName of sample: ");
  198.               $41555448: Write("\nAuthor: ");
  199.               $28432920,
  200.               $28632920,
  201.               $2843294a,
  202.               $2863294a: Write("\n(c) notice: ");
  203.               $414e4e4f: WriteLn("\nAnnotation field:");
  204.             else
  205.               wrt_flg := True;
  206.             end;
  207.             WriteData(dlen);
  208.         end;
  209.         DoRead(ckname, 4);
  210.         end;
  211.         DoRead(Adr(dlen), 4);
  212.         Writeln(dlen, ' bytes at ', VHeader.samplesPerSec, 'Hz');
  213.     end else
  214.         pExit("Not an 8SVX sound file.")
  215.     end else
  216.     pExit("Not an IFF file.");
  217.     ioa := AllocMem(SizeOf(IOAudio), MemPublic);
  218.     if ioa = Nil then
  219.     pExit(NoMem);
  220.     with ioa^.ioaRequest.ioMessage do begin
  221.     mnReplyPort := CreatePort(Nil, 0);
  222.     if mnReplyPort = nil then
  223.         pExit("Unable to allocate port");
  224.     end;
  225.  
  226.     dbuf := AllocMem(dlen, MemPublic + MemChip);
  227.     if dbuf = Nil then
  228.     pExit(NoMem);
  229.  
  230.     with ioa^ do begin
  231.     ioaRequest.ioMessage.mnNode.lnPri := 10;
  232.     ioaData := Adr(chan);
  233.     ioaLength := 1;
  234.     ioaAllocKey := 0;
  235.     end;
  236.  
  237.     oerr := OpenDevice(AUDIONAME, 0, IORequestPtr(ioa), 0);
  238.     if oerr <> 0 then
  239.     pExit("Can't open audio device");
  240.  
  241.     if dlen > 131000 then begin  { Supposed hardware limitation. }
  242.     dlen := 131000;
  243.     end else if Odd(dlen) then
  244.     dlen := Pred(dlen);
  245.     DoRead(dbuf, dlen);
  246.  
  247.     if VHeader.sCompression = 1 then begin
  248.     t := AllocMem(dlen shl 1, MemChip + MemPublic);
  249.     if t = Nil then
  250.         pExit("Not enough memory for decompression");
  251.     DUnpack(dbuf, dlen, t);
  252.     FreeMem(dbuf, dlen);
  253.     dbuf := t;
  254.     dlen := dlen shl 1;
  255.     end else if VHeader.sCompression > 1 then
  256.     pExit("Unknown compression type");
  257.  
  258.     with ioa^ do begin
  259.     ioaRequest.ioCommand := CMD_WRITE;
  260.     ioaRequest.ioFlags := ADIOF_PERVOL;
  261.     ioaData := dbuf;
  262.     ioaCycles := 1;        { 1 or from command line. }
  263.     ioaLength := dlen;
  264.     ioaPeriod := 3579546 div VHeader.samplesPerSec;
  265.     ioaVolume := 64;         { Always use maximum volume. }
  266.     end;
  267.  
  268.     BeginIO(IORequestPtr(ioa));
  269.     oerr := WaitIO(IORequestPtr(ioa));
  270.  
  271.     if oerr <> 0 then
  272.     Writeln('Error ', oerr, ' playing sample');
  273.     CloseDevice(IORequestPtr(ioa));
  274.     CleanUp;
  275. end.
  276.