home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PNL010.ZIP / DIGISND.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-03-01  |  3.3 KB  |  135 lines
  1. (*------------------------------------------*)
  2. (* Unit DIGISND                             *)
  3. (* by Alex Boisvert, March 1992             *)
  4. (*------------------------------------------*)
  5. (* For use with RESPLAY v1.0                *)
  6. (* Distribute freely!                       *)
  7. (*------------------------------------------*)
  8.  
  9. unit DigiSnd;
  10.  
  11. interface
  12.  
  13. uses dos,crt;
  14.  
  15. type
  16.     arrptr=array[1..10] of pointer;
  17.  
  18.     ResplayObject = object
  19.       SoundPtr : array [1..10] of pointer;
  20.       SoundRegs : registers;
  21.       SoundNum,
  22.       SoundMax : integer;
  23.       EntireFileLoaded : boolean;
  24.       SoundFile : file;
  25.       SoundSize : longint;
  26.       constructor Init;
  27.       function Setup(Mode, OutKind, Speed : integer) : boolean;
  28.       procedure Load(SoundFileName : string);
  29.       procedure Play;
  30.       destructor Done;
  31.     end;
  32.  
  33. implementation
  34.  
  35. constructor ResplayObject.Init;
  36. begin
  37.   SoundNum := 0;
  38.   SoundMax := 0;
  39.   SoundSize := 0;
  40. end;
  41.  
  42. function ResplayObject.Setup(Mode, OutKind, Speed : integer) : boolean;
  43. begin
  44.   {check if Resplay is loaded}
  45.   with SoundRegs do begin
  46.     AX := $8201;
  47.     Intr($2f,SoundRegs);
  48.     if AX <> $7746 then begin
  49.       Setup := false;
  50.       exit;
  51.     end;
  52.   end;
  53.   {check if setup is correct}
  54.   with SoundRegs do begin
  55.     AX := $8210;
  56.     CL := Mode;
  57.     BL := OutKind;
  58.     BH := Speed;
  59.     Intr($2f,SoundRegs);
  60.     if AX <> 4096 then Setup := false
  61.       else Setup := true;
  62.   end;
  63. end; { setup }
  64.  
  65.  
  66. procedure ResplayObject.Load(SoundFileName : string);
  67. Var SoundCount : integer;
  68.     ByteRead : word;
  69.     TempFile : file of byte;
  70. begin
  71.   {get size of file}
  72.   Assign(TempFile, SoundFileName);
  73.   Reset(TempFile);
  74.   SoundSize := FileSize(TempFile);
  75.   Close(TempFile);
  76.   {read file}
  77.   Assign(SoundFile, SoundFileName);
  78.   Reset(SoundFile);
  79.   {get total available memory - except 40k for Turbo Pascal}
  80.   SoundMax := Trunc((MaxAvail-40000)/65535);
  81.   SoundNum := 0;
  82.   repeat
  83.     Inc(SoundNum);
  84.     GetMem(SoundPtr[SoundNum],65535);
  85.     BlockRead(SoundFile, SoundPtr[SoundNum]^, 65535, ByteRead);
  86.   until (ByteRead=0) or (SoundNum=SoundMax);
  87.   if (SoundNum=SoundMax) and (ByteRead <> 0) then EntireFileLoaded := false
  88.     else begin
  89.       EntireFileLoaded := true;
  90.       Dec(SoundNum);
  91.     end;
  92.   Close(SoundFile);
  93. end;
  94.  
  95. procedure ResplayObject.Play;
  96. var SoundCount : integer;
  97.  
  98.   procedure PlaySoundSeg( MemSeg : pointer; SegSize : longint);
  99.   begin
  100.     with SoundRegs do begin
  101.       AX := $8200;
  102.       DX := Seg(MemSeg^);
  103.       DI := Ofs(MemSeg^);
  104.       CX := Trunc(SegSize/65536);
  105.       BX := SegSize - Trunc(CX * SegSize/65536);
  106.     end;
  107.     Intr($2f,SoundRegs);
  108.     If SoundRegs.AX = $2000 then begin
  109.       WriteLn('Complete Failure!');
  110.       Sound(1000);
  111.       Delay(500);
  112.       NoSound;
  113.       Halt(1);
  114.     end;
  115.   end;
  116.  
  117. begin
  118.   {play each allocated pointer}
  119.   if (SoundNum = 1) then PlaySoundSeg(SoundPtr[1], SoundSize)
  120.     else begin
  121.       For SoundCount := 1 to SoundNum-1 do PlaySoundSeg(SoundPtr[SoundCount],65535);
  122.       if not EntireFileLoaded then PlaySoundSeg(SoundPtr[SoundNum], 65535)
  123.         else PlaySoundSeg(SoundPtr[SoundNum], SoundSize-(SoundNum-1)*65535);
  124.     end;
  125. end;
  126.  
  127. destructor ResplayObject.Done;
  128. var SoundCount : Integer;
  129. begin
  130.   For SoundCount :=1 to SoundNum do FreeMem(SoundPtr[SoundCount],65535);
  131. end;
  132.  
  133. end. {unit}
  134.  
  135.