home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / msdos / pascal / playvoc / playvoc.pas
Encoding:
Pascal/Delphi Source File  |  1992-01-17  |  6.6 KB  |  202 lines
  1. {$M 16384,0,231072}
  2. {Don't need overly large main memory amounts}
  3. { Hatched via Pascal24 - MM'92 }
  4. program SB;
  5. {
  6.         This Program Uses the Sound Blaster & XMS memory to load and play a
  7.          .VOC file.  However, it has some problems....
  8. }
  9.  
  10. uses SBV,XMS;   {Ask on Fido for XMS.PAS source.}
  11. {
  12.  SBVoice -=- Voice Driver
  13.  XMS     -=- XMS memory Driver
  14. }
  15.  
  16. CONST
  17.         BUFSIZ = 32768;      {Voice driver and XMS block size}
  18.         MTRIAL = 6;
  19.  
  20. TYPE
  21.         PLHType = ^LHType;              {Pointer to Linked list of XMS handles}
  22.         LHType = Record
  23.                         Handle : Word;
  24.                         Size : Word;    {Need this in case EOF or different
  25. BUFSIZ}
  26.                         Next : PLHType;
  27.                     END;
  28.         PBufType = ^BufType;    {Pointer to Buffer Type}
  29.         BufType = Array [1..BUFSIZ+32] of Byte; {Buffer Type}
  30.  
  31. Function LoadFile : PLHType;
  32. {
  33.         This function returns the root pointer to a list of XMS memory handles
  34.         for the file in paramstr(1).
  35. }
  36.  
  37. TYPE
  38.         PBufType = ^BufType;            {Don't need as large of a buffer for
  39. this}
  40.         BufType = Array [1..BUFSIZ] of Char;
  41.  
  42. VAR                                     {Sorry about VAR names}
  43.         PLHRoot : PLHType;
  44.         TPLH1,TPLH2     : PLHType;
  45.         InFile : File;
  46.         BFile : File of Byte;
  47.         FSize : Word;
  48.         Buffer : PBufType;
  49.         NumRead : Word;
  50.         Order : Integer;
  51.  
  52. BEGIN
  53.         PLHRoot := NIL;
  54.         Assign(InFile,ParamStr(1));
  55.         Reset(InFile,1);
  56.         New(Buffer);FSize := BUFSIZ;Seek(InFile,1);
  57.         Repeat
  58.                 blockread(InFile,Buffer^,FSize,NumRead);
  59.                 If PLHRoot = NIL Then
  60.                 BEGIN
  61.                         New(PLHRoot);
  62.                         PLHRoot^.Handle := EMBGetMem((NumRead DIV 1024)+1);
  63.                         MoveToEMB(Buffer^,PLHRoot^.Handle,NumRead);
  64.                         PLHRoot^.Next := NIL;PLHRoot^.Size := NumRead;
  65.                 END Else
  66.                 BEGIN
  67.                         TPLH1 := PLHRoot;
  68.                         While TPLH1^.Next <> NIL Do
  69.                                 TPLH1 := TPLH1^.Next;
  70.                         New(TPLH2);
  71.                         TPLH1^.Next := TPLH2;
  72.                         TPLH2^.Next := NIL;TPLH2^.Size := NumRead;
  73.                         TPLH2^.Handle := EMBGetMem((NumRead DIV 1024)+1);
  74.                         If XMSError <> 0 Then
  75.                                 Writeln(XMSErrorString(XMSError));
  76.                         MovetoEMB(Buffer^,TPLH2^.Handle,NumRead);
  77.                 END;
  78.         Until NumRead <> BUFSIZ;
  79.         LoadFile := PLHRoot;
  80.         Close(InFile);Dispose(Buffer);
  81. END;
  82.  
  83. Procedure SetSize(pntr:Pointer;SBSize:LongInt);
  84. {
  85.         This procedure modifies the array(buffer) pointed to by pntr so the
  86.         voice driver will know how long the buffer is
  87. }
  88.  
  89. VAR
  90.         ptr : PBufType;
  91. BEGIN
  92.         ptr := Pntr;
  93.         Ptr^[28] := SBSize MOD 256; {Low Byte}
  94.         Ptr^[29] := ((SBSize - (Ptr^[28])) DIV 256) MOD 256;{Mid Byte}
  95.         Ptr^[30] := SBSize DIV 65536; {High Byte}
  96. END;
  97.  
  98. Procedure PlayFile(Root:PLHType);
  99. {
  100.         This procedure plays the voice file pointed to by the linked list of
  101.         XMS memory handles
  102. }
  103.  
  104. VAR
  105.         TPLH1 : PLHType;                {Need two buffers}
  106.         Buffer : Array [0..1] of PBufType;
  107.         Preserved : PBufType;
  108.         Index : Integer;                {Which buffer currently in use}
  109.         SoundBlock : Pointer;   {Pointer to block to play}
  110.         First : Boolean;                {Is this the first block?}
  111.         SBSize : LongInt;               {Size of current block}
  112.  
  113. Procedure Common;
  114. CONST
  115.         Count : Integer = 0;
  116. {
  117.         This procedure is common routines for each buffer after the first block
  118.         is played.
  119. }
  120. BEGIN
  121.                         SBSize := Root^.Size;
  122.                         SetSize(Buffer[Index],SBSize-30);
  123.                         Inc(Count);Writeln(Count,' ',SBSize,' ',Root^.Handle,'
  124. ',Index);
  125.                         EMBFreeMem(Root^.Handle);
  126.                         Dispose(Root);
  127.                         Root := TPLH1;
  128.                         SoundBlock := Buffer[Index];
  129.                         Repeat
  130.                         asm
  131.                                 NOP
  132.                         END;
  133.                         Until StatusWord = 0;
  134.                         Repeat
  135.                         asm
  136.                                 NOP
  137.                         END;
  138.                         Until StatusWord = 0;
  139.                         asm
  140.                                 NOP
  141.                                 NOP
  142.  
  143.                         END;
  144.  sb_Output(MemW[seg(SoundBlock):ofs(SoundBlock)+2],MemW[seg(SoundBlock):ofs(
  145. oundBlock)]+26);
  146.                         Index := 1 - Index;
  147. END;
  148.  
  149. BEGIN
  150.         New(Buffer[0]);New(Buffer[1]);Index := 0;  {Smaller .EXE file by using}
  151.         New(Preserved);
  152.         First := True;                                             {create on
  153. the fly VARS}
  154.  
  155.         Repeat
  156.                 If Root <> NIL Then
  157.                 If Index = 0 Then
  158.                 BEGIN
  159.                         TPLH1 := Root^.Next;
  160.                         If First Then
  161.                         BEGIN
  162.  MoveFromEMB(Root^.Handle,Buffer[0]^,Root^.Size);
  163.                                 MoveFromEMB(Root^.Handle,Buffer[1]^,32); {Get
  164. header info}
  165.                                 MoveFromEMB(Root^.Handle,Preserved^,32)
  166.                         END
  167.                         Else
  168.                                 MoveFromEMB(Root^.Handle, {preserve header
  169. info}
  170.  Ptr(MemW[seg(Buffer[Index]):ofs(Buffer[Index])+2],
  171.  MemW[seg(Buffer[Index]):ofs(Buffer[Index])]+32)^,Root^.Size);
  172.                         First := False;
  173.                         Common;
  174.                 END Else  {Index = 1}
  175.                 BEGIN
  176.                         TPLH1 := Root^.Next;
  177.                         MoveFromEMB(Root^.Handle,
  178.                         Ptr(MemW[seg(Buffer[Index]):ofs(Buffer[Index])+2],
  179.  MemW[seg(Buffer[Index]):ofs(Buffer[Index])]+32)^,Root^.Size);
  180.                         Common;
  181.                 END;
  182.         Until Root = NIL;
  183.  
  184.         Dispose(Buffer[0]);Dispose(Buffer[1]);
  185. END;
  186.  
  187. {
  188.         Main program.  This program has little or no file error checking.
  189. }
  190.  
  191. BEGIN
  192.         TRIAL := MTRIAL;
  193.         If SBFound Then
  194.         BEGIN
  195.                 If ParamCount>0 Then
  196.                         PlayFile(LoadFile)
  197.                 Else
  198.                 Writeln('Usage: SB [d:\path\]filename.voc');
  199.         END Else
  200.         Writeln('SoundBlaster Init Error.  SoundBlaster not Found.');
  201. END.
  202.