{
 SBVOX    Ethan Brodsky     ericbrodsky@psl.wisc.edu    Last Updade: 10/18/94
 This code is released into the public domain.  You can do anything you want
 with it, but please give me credit.  If you make improvements or discover a
 bug, please send it to me.  This code incorporates nice features from many
 SBVoice libraries(Also known as CTVoice and VoxTool)  with some of my own
 ideas.  The basic procedure for using this library is shown in the VOCPLAY
 and RECPLAY example programs.  This version supercedes all other SBVox and
 SBVoice libraries written by me.  It is improved and supports VOC files that
 are larger than 64k and allows you to link the CT-VOICE driver into your
 executable.  If you want to do this, make sure that CT-VOICE.DRV is in the
 current directory and that BINOBJ (Comes with TP) is in your search path,
 and run SETUP.BAT.  After you have CT-VOICE.OBJ, $DEFINE LinkDriver in this
 unit and modify your program accordingly.  This may not be a good idea if
 you want your program to support different versions of the Sound Blaster
 sound card (The CT-VOICE driver is not compatible between sound cards)
 Good luck, and please tell me how you have used this library,
     Ethan Brodsky
}
unit SBVox;
{-} interface {--------------------------------------------------------------}
        const
            SpeakerOff = 0; SpeakerOn  = 1;

            SoundCompleted = 0;

            LoadDrvSuccess    =  0;
            LoadDrvIOerror    =  1;
            LoadDrvNoMemory   =  2;
            LoadDrvBadDriver  =  3;

            SBInitSuccess               = 0;
            SBInitSoundCardFailure      = 1;
            SBInitIOFailure             = 2;
            SBInitDMAorInterruptFailure = 3;

            BreakLoopAtEnd = 0;
            BreakLoopNow   = 1;
{$IFNDEF LinkDriver}
        function LoadDriver(DriverPath: string): integer;
          {Loads CT-VOICE.DRV into memory from the disk.                     }
        procedure UnloadDriver;
          {Unloads the driver from memory.  Call this after you are done with}
          {the Sound Blaster.   If the driver is linked into the executable, }
          {this is not needed.   Just call ShutDownDriver to shut down the SB}
{$ENDIF}
        var
            StatusWord : word;
        type
            TSound     = array[1..65535] of byte;
              {Only works to access first 64k of the sound}
            PSound     = ^TSound;
            PVOCHeader = ^TVOCHeader;
            TVOCHeader = array[1..26] of char;

        function GetDriverVersion: word;
          {Get the version number of the CT-VOICE.DRV                        }
          {Returns the Version number                                        }
          {Hi(GetDriverVersion) is the major revision number                 }
          {Lo(GetDriverVersion) is the minor revision number                 }
        procedure SetInterrupt(NewInterruptNum: word);
          {Override the interrupt number stored in the CT-VOICE driver       }
          {You must call this BEFORE InitSB                                  }
        procedure SetBaseIOAddress(NewAddress: word);
          {Override the base IO address stored inside the CT-VOICE driver    }
          {You must call this BEFORE InitSB                                  }
        function InitSB: integer;
          {Initialize the SoundBlaster.  Call this right after load driver   }
          {unless you have to change the Base IO address or interrupt number.}
          {In that case, call SetInterrupt and SetBaseIOAddress              }
          {Returns:  0 - no problem                                          }
          {          1 - sound card failiure                                 }
          {          2 - I/O failiure                                        }
          {          3 - DMA interrupt failiure                              }
        procedure InitStatusWord;
          {Sets the location of the status word.  This is the third thing you}
          {should do, after loading the driver and initializing it. The      }
          {StatusWord will contain $FFFF if input/output is in output, and 0 }
          {when it's done.  It will also hold the values of the markers in   }
          {voice files if any are encounterred, allowing you to synchronize  }
          {sound output with your program.                                   }
        function GetSoundBuffer(var Sound: PSound; BufferLength: LongInt): boolean;
          {THIS FUNCTION CAN ALLOCATE MORE THAN 64K!!!!!!!!!!!!!!!!!!!!!!!!!!}
          {Allocates a buffer for a sound.  Returns true if successful, false}
          {if memory  cannot be  allocated.    I haven't tested it in a large}
          {program yet.   It will surely work for buffers under 64k.   If you}
          {have a better way,  please contact me.   If you find a bug, please}
          {contact me so I can fix it                                        }
        procedure FreeSoundBuffer(Sound: PSound; BufferLength: LongInt);
          {Deallocates the memory allocated by GetSoundBuffer                }
        function LoadVOCFile(FileName: string; var Header: PVOCHeader; var Sound: PSound): LongInt;
          {Returns the size of the VOC buffer                                }
        procedure SetSpeakerState(State: word);
          {Set the speaker on/off.  Off is state 0, and On is anything else. }
        procedure TurnSpeakerOn;
          {Turns on the speaker                                              }
        procedure TurnSpeakerOff;
          {Turns off the speaker                                             }
        procedure PlaySound(Sound: PSound);
          {Outputs digitized sound.                                          }
          {Sound:       Pointer to the sound buffer                          }
          {To find out when the output is completed, check if StatusWord = 0 }
        procedure StopSound;
          {Stops the IO in progress                                          }
        procedure PauseSound;
          {Pauses the input or output in progress.  Resume with ContinueSound}
        procedure ContinueSound;
          {Continues input or output paused with PauseSouund                 }
        procedure BreakLoop(BreakType: word);
          {Breaks out of the current output loop.                            }
          {BreakTypes: 0 - continue round, stop when done                    }
          {            1 - stop immediately                                  }
        procedure RecordSound(Sound: PSound; SoundLength: LongInt; Rate: word);
          {Input digitized sound.                                            }
          {Sound:       Pointer to the sound buffer.                         }
          {SoundLength: Length of the input buffer.                          }
          {Rate:        Sampling frequency                                   }
          {To find out when the sound buffer is full, check if StatusWord = 0}
        procedure SetUserFunction(UserFunction: pointer);
          {Sets up a user function that the SB calls when it encounters a new}
          {data block.   It must perform a FAR return,  preserving DS, DI, SI}
          {and  the  flags  register.    Clear the Carry flag if you want the}
          {driver to process the block,  or set it if your routine will.  The}
          {carry flag must be cleared if the block type is 0,  then it is the}
          {terminate block.                                                  }
        procedure ShutDownDriver;
          {Notifies the Sound Blaster that the driver is being installed.  No}
          {need to call this directly unless you want to shut down the  Sound}
          {Blaster without removing the driver from memory,  such as when the}
          {driver is linked into the exectable.                              }
{-} implementation {---------------------------------------------------------}
{$IFDEF LinkDriver}
        uses VOXDrv;  {The driver must be aligned on a segment boundary}
{$ENDIF}
        var
            SBDriver : pointer;
            DriverSize : word;
{$IFNDEF LinkDriver}
        function LoadDriver(DriverPath: string): integer;
            type
                PTitle = ^TTitle;
                TTitle = array[1..8] of char;
            var
                f     : file;
                i     : integer;
                Title : TTitle;
            begin
                SBDriver := nil;
                LoadDriver := LoadDrvSuccess;
                Assign(f, DriverPath);
                {$I-} Reset(f,1); {$I+}
                DriverSize := FileSize(f);
                if IOResult <> 0
                    then
                        begin
                            LoadDriver := LoadDrvIOerror;
                            Exit;
                        end;
                if MaxAvail < FileSize(f)
                    then
                        begin
                            LoadDriver := LoadDrvNoMemory;
                            Exit;
                        end;
                StatusWord := 0;
                GetMem(SBDriver, DriverSize);
                BlockRead(f, SBDriver^, DriverSize);
                Close(f);

                Title := PTitle(Ptr(Seg(SBDriver^), Ofs(SBDriver^)+3))^;

                if Title <> 'CT-VOICE'
                   then
                       begin
                           LoadDriver := LoadDrvBadDriver;
                           FreeMem(SBDriver, DriverSize);
                           Exit;
                       end;
           end;
        procedure UnloadDriver;
            begin
                ShutDownDriver;
                FreeMem(SBDriver, DriverSize);
                SBDriver := nil;
            end;
{$ENDIF}
        function GetDriverVersion: word; assembler;
            asm
                PUSH  BP
                MOV   BX, 0
                CALL  SBDriver
                POP   BP
            end;
        procedure SetBaseIOAddress(NewAddress: word); assembler;
            asm
                PUSH  BP
                MOV   AX, NewAddress
                MOV   BX, 1
                CALL  SBDriver
                POP   BP
            end;
        procedure SetInterrupt(NewInterruptNum: word); assembler;
            asm
                PUSH  BP
                MOV   AX, NewInterruptNum
                MOV   BX, 2
                CALL  SBDriver
                POP   BP
            end;
        function InitSB: integer; assembler;
            asm
                PUSH  BP
                MOV   BX, 3
                CALL  SBDriver
                POP   BP
            end;
        procedure SetSpeakerState(State: word); assembler;
            asm
                PUSH  BP
                MOV   AX, State
                MOV   BX, 4
                CALL  SBDriver
                POP   BP
            end;
        procedure TurnSpeakerOn;
            begin
                SetSpeakerState(SpeakerOn);
            end;
        procedure TurnSpeakerOff;
            begin
                SetSpeakerState(SpeakerOff);
            end;
        procedure InitStatusWord;
            var
                StatusWordPtr: ^Word;
            begin
                StatusWordPtr := @StatusWord;
                    asm
                        MOV  BX, 5
                        LES  DI, StatusWordPtr
                        CALL SBDriver
                    end;
            end;
        function GetSoundBuffer(var Sound: PSound; BufferLength: LongInt): boolean;
            var
                Dummy: pointer;
            begin
                if MaxAvail < BufferLength
                    then
                        begin
                            GetSoundBuffer := false;
                            Exit;
                        end;
                GetSoundBuffer := true;
                if BufferLength < $FFFF
                    then
                        GetMem(Sound, BufferLength)
                    else
                        begin
                            GetMem(Sound, $FFFF);
                            BufferLength := BufferLength - $FFFF;
                            while BufferLength > $FFFF do
                                begin
                                    GetMem(Dummy, $FFFF);
                                    BufferLength := BufferLength - $FFFF;
                                end;
                            GetMem(Dummy, BufferLength);
                        end;
            end;
        procedure FreeSoundBuffer(Sound: PSound; BufferLength: LongInt);
            var
                Dummy: pointer;
                LeftToFree: LongInt;
            begin
                if BufferLength < $FFFF
                    then
                        FreeMem(Sound, BufferLength)
                    else
                        begin
                            Dummy := Sound;
                            LeftToFree := BufferLength;
                            FreeMem(Sound, $FFFF);
                            LeftToFree := LeftToFree - $FFFF;
                            Dummy := Ptr(Seg(Dummy^) + $1000, Ofs(Dummy^));
                            while LeftToFree > $FFFF do
                                begin
                                    FreeMem(Dummy, $FFFF);
                                    LeftToFree := LeftToFree - $FFFF;
                                    Dummy := Ptr(Seg(Dummy^) + $1000, Ofs(Dummy^));
                                end;
                            FreeMem(Dummy, LeftToFree);
                        end;
            end;
        function LoadVOCFile(FileName: string; var Header: PVOCHeader; var Sound: PSound): LongInt;
           var
                f: file;
                Dummy: Pointer;
                LeftToRead: LongInt;
            begin
                Assign(f, FileName);
                Reset(f, 1);
                LoadVOCFile := (FileSize(f) - SizeOf(Header^));
                New(Header);
                BlockRead(f, Header^, SizeOf(Header^));

                if GetSoundBuffer(Sound, FileSize(f) - SizeOf(Header^)) <> true
                    then
                        begin
                            LoadVOCfile := 0; {Failed to allocate memory}
                            Exit;
                        end;
                LeftToRead := FileSize(f) - SizeOf(Header^);
                Dummy := Sound;
                if LeftToRead < $FFF0
                    then
                        BlockRead(f, Sound^, LeftToRead)
                    else
                        begin
                            BlockRead(f, Sound^, $FFF0);
                            LeftToRead := LeftToRead - $FFF0;
                            Dummy := Ptr(Seg(Dummy^) + $1000, Ofs(Dummy^));
                            while LeftToRead > $FFF0 do
                                begin
                                    BlockRead(f, Dummy^, $FFF0);
                                    LeftToRead := LeftToRead - $FFF0;
                                    Dummy := Ptr(Seg(Dummy^) + $1000, Ofs(Dummy^));
                                end;
                            BlockRead(f, Dummy^, LeftToRead);
                        end;
                Close(f);
            end;
        procedure PlaySound(Sound: PSound);
            begin
                    asm
                        MOV  BX, 6
                        LES  DI, Sound
                        CALL SBDriver
                    end;
            end;
        procedure StopSound; assembler;
            asm
                PUSH  BP
                MOV   BX, 8
                CALL  SBDriver
                POP   BP
            end;
        procedure PauseSound; assembler;
            asm
                PUSH  BP
                MOV   BX, 10
                CALL  SBDriver
                POP   BP
            end;
        procedure ContinueSound; assembler;
            asm
                PUSH  BP
                MOV   BX, 11
                CALL  SBDriver
                POP   BP
            end;
        procedure BreakLoop(BreakType: word); assembler;
            asm
                PUSH  BP
                MOV   AX, BreakType
                MOV   BX, 12
                CALL  SBDriver
                POP   BP
            end;
        procedure RecordSound(Sound: PSound; SoundLength: LongInt; Rate: word);
            type
                LongRec =
                    record
                        Lo, Hi: Word;
                    end;
            var
                HiLength, LoLength : word;
            begin
                LoLength := LongRec(SoundLength).Lo;
                HiLength := LongRec(SoundLength).Hi;
                    asm
                        MOV  AX, Rate
                        MOV  BX, 7
                        MOV  CX, LoLength
                        MOV  DX, HiLength
                        LES  DI, Sound
                        CALL SBDriver
                    end;
            end;
        procedure SetUserFunction(UserFunction: pointer);
            var
                SegAddress, OfsAddress: word;
            begin
                SegAddress := Seg(UserFunction^);
                OfsAddress := Ofs(UserFunction^);
                    asm
                        MOV   AX, OfsAddress
                        MOV   BX, 13
                        MOV   DX, SegAddress
                        CALL  SBDriver
                    end;
            end;
        procedure ShutDownDriver; assembler;
            asm
                PUSH  BP
                MOV   BX, 9
                CALL  SBDriver
                POP   BP
            end;
    begin
{$IFDEF LinkDriver}
        SBDriver := @CTVoice;
{$ELSE}
        SBDriver := nil;
{$ENDIF}
    end.