[Back to SOUND SWAG index] [Back to Main SWAG index] [Original]

    {
                                      SBDSP
                              Version 1.03 (9/23/94)
                             Written by Ethan Brodsky
              Copyright 1994 by Ethan Brodsky.  All rights reserved.

    This library is distributed AS IS.  The author specifically disclaims
    any responsibility for any loss of profit or any consequential,
    incidental, or other damages.  SBDSP is freeware and is distributed
    with full Turbo Pascal source code.  You are free to incorporate parts
    of the code into your own programs as long as you give credit to Ethan
    Brodsky.  This source code may only be distributed in it's original
    form, including this documentation file.

    ------------------------------------------------------------------------

        You may have used my SBVox and SBVoice units.  They played VOC files
    on a Sound Blaster using Creative Labs' CT-VOICE driver.  Since they
    used the CT-VOICE driver, they wouldn't work on other sound cards.  The
    driver needed to be included with the program, either in a separate file
    or linked into the executable.

        SBDSP performs the same functions as the SBVox unit without using
    the CT-VOICE driver.  It has only been tested on a SB16 and PAS16, but
    it should work on all Sound Blaster compatible sound cards.  By using
    DMA transfers, it plays sound without using the CPU, saving processor
    cycles for your program.

        I have many improvements planned, including 16-bit sound, stereo
    effects, and mixing, along with new library for FM music.  But I NEED
    FEEDBACK!  If you use my code, tell me about it!  If you make any
    modifications, send them to me!  If you have any suggestions for
    improvements, tell me about them!  If you want me to write a C version,
    or a version to play WAV files, tell me!

       You don't need to pay me for using this unit.  All you have to do
    is put my name in the credits for your product.  I'd appreciate it if
    you'd send me a message telling me how you used SBDSP.  (If you used
    it in a game, tell me where I can get it)  And finally, if you ever
    have a sound programming job, think of me.

        You can find out most of the things you need to know in order to
    use this library by looking at the PlayVOC example program, but I'll
    go over it again.  The first thing you need to do is to reset the DSP,
    initialize SBDSP's internal variables, and install the interrupt
    handler.  In order to do this, you need to know the sound cards base
    address, IRQ number, and 8-bit DMA channel.   If this is being used
    on a Sound Blaster, this information can be obtained from the BLASTER
    environment variable.  I don't know whether other cards use this.  You
    can use the EnvironmentSet function to find out if the environment
    variable is set.  If it is, you can call the function InitSBFromEnv.
    Otherwise, you'll have to find out the settings some other way and pass
    them to the InitSB function.

        Use the LoadVOCFile function to allocate a sound buffer.  Make sure
    that you save the value returned from this function.  It is the size of
    the allocated buffer.  It will be needed when you deallocate the buffer.
    The memory needed for Sound will be allocated inside this function. You
    do NOT need to allocate it beforehand.

        Before you can play any sounds, you have to turn on the speaker
    output.  Do this by calling TurnSpeakerOn.  Make sure you turn it off
    at the end of the program.  If you want to install a marker handler,
    make sure you do it now by calling SetMarkerProc.  A marker handler
    will be called each time a marker block is reached.  Before you install
    your marker handler, save the old one using GetMarkerProc.  If the value
    returned is not nil, then another marker procedure has been installed.
    Call it each time your marker procedure is called.  This is a good
    practice to get into when setting up a handler such as this.  It will
    make it possible to install more than one marker procedure.

        To play a sound, pass a pointer to the sound buffer to PlaySound.
    Any sound output in progress will be stopped.  To find out if the sound
    is finished, check the SoundPlaying variable.  The VOC file format has
    a provision for repeating sounds.  The sound can be set to repeat for
    a number of times (Or forever)  You can break out of the loop by calling
    BreakLoop.  The current iteration will finish and it will continue to
    the next block.  When the program is completely finished playing sound,
    call the ShutDownSB procedure.  This will stop any sound output in
    progress and remove the interrupt handler.  You should deallocate all
    sound buffers by using FreeBuffer.  The pointer to the buffer should be
    typecasted as a pointer.  Make sure that you pass the buffer size that
    was returned by LoadVOCFile so that the right amount of memory is
    deallocated.

        This library will not allow you to play 16 bit or stereo VOC files.
    It will not work in protected mode since it uses DMA transfers.  If you
    have any other questions, feel free to ask.  If you would like me to
    make any modifications or a customized version of this unit to use in
    your program, contact me and we can work out some arrangements.

    There are several ways to contact me:
        E-Mail:  ericbrodsky@psl.wisc.edu    (Preferred)
        Phone:   (608) 238-4830
        Mail:
            Ethan Brodsky
          4010 Cherokee Dr.
          Madison, WI 53711

    Bug fixes and other announcements will be posted in:
        comp.lang.pascal
        comp.sys.ibm.pc.soundcard
        comp.sys.ibm.pc.soundcard.tech
        rec.games.programmer
    }

    {       SBDSP is Copyright 1994 by Ethan Brodsky.  All rights reserved.      }
    unit Mem;
        interface
            function GetBuffer(var Buffer: pointer; BufferLength: LongInt): boolean;
            procedure FreeBuffer(Buffer: pointer; BufferLength: LongInt);
            function GetAbsoluteAddress(p: pointer): LongInt;
        implementation
            function GetBuffer(var Buffer: pointer; BufferLength: LongInt): boolean;
                var
                    Dummy: pointer;
                begin
                    if MaxAvail < BufferLength
                        then
                            begin
                                GetBuffer := false;
                                Buffer := nil;
                                Exit;
                            end;
                    GetBuffer := true;
                    if BufferLength < $FFFF
                        then
                            GetMem(Buffer, BufferLength)
                        else
                            begin
                                GetMem(Buffer, $FFFF);
                                BufferLength := BufferLength - $FFFF;
                                while BufferLength > $FFFF do
                                    begin
                                        GetMem(Dummy, $FFFF);
                                        BufferLength := BufferLength - $FFFF;
                                    end;
                                GetMem(Dummy, BufferLength);
                            end;
                end;
            procedure FreeBuffer(Buffer: pointer; BufferLength: LongInt);
                var
                    Dummy: pointer;
                    LeftToFree: LongInt;
                begin
                    if BufferLength < $FFFF
                        then
                            FreeMem(Buffer, BufferLength)
                        else
                            begin
                                Dummy := Buffer;
                                LeftToFree := BufferLength;
                                FreeMem(Buffer, $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 GetAbsoluteAddress(p: pointer): LongInt;
                begin
                    GetAbsoluteAddress := LongInt(Seg(p^))*16 + LongInt(Ofs(p^));
                end;
        end.

    {       SBDSP is Copyright 1994 by Ethan Brodsky.  All rights reserved.      }
    unit VOC;
        interface
            const
                EndBlockNum            = 0;
                VoiceBlockNum          = 1;
                VoiceContinueBlockNum  = 2;
                SilenceBlockNum        = 3;
                MarkerBlockNum         = 4;
                MessageBlockNum        = 5;
                RepeatBlockNum         = 6;
                RepeatEndBlockNum      = 7;
                ExtendedInfoBlockNum   = 8;
                NewVoiceBlockNum       = 9;
                BlockNames : array[0..9] of string =
                    (
                     'Terminator',
                     'Voice Data',
                     'Voice Continuation',
                     'Silence',
                     'Marker',
                     'Message',
                     'Repeat Loop',
                     'End Repeat Loop',
                     'Extended Info',
                     'New Voice Data'
                    );
                {Used in block type 1 and 8}
                Unpacked8  = 0; {8 bit (Uncompressed)}
                Packed4    = 1; {4 bit}
                Packed26   = 2; {2.6 bit}
                Packed2    = 3; {2 bit}
                PackingNames : array[0..10] of string =
                    (
                     '8 bit unpacked',
                     '4 bit packed',
                     '2.6 bit packed',
                     '2 bit packed',
                     '1 channel multi',
                     '2 channel multi',
                     '3 channel multi',
                     '4 channel multi',
                     '5 channel multi',
                     '6 channel multi',
                     '7 channel multi'
                    );
                {Used in block type 9}
                Uncompressed8     = $0000;
                Compressed4       = $0001;
                Compressed26      = $0002;
                Compressed2       = $0003;
                Uncompressed16    = $0004;
                CompressedALAW    = $0006;
                CompressedMULAW   = $0007;
                CompressedADPCM   = $0200; {Why couldn't they make this $0008?}
                CompressionNames : array[0..7] of string =
                    (
                        '8 bit uncompressed',
                        '4 bit compressed',
                        '2.6 bit compressed',
                        '2 bit compressed',
                        '16 bit uncompressed',
                        '',
                        'ALAW compressed',
                        'MULAW compressed'
                    );
                ExtendedMono   = 0;
                ExtendedStereo = 1;
                ExtendedModeNames : array[0..1] of string = ('Mono', 'Stereo');

                NewMono   = 1;      {This is Creative Labs' fault}
                NewStereo = 2;      {Blame it on Creative Labs}
                NewModeNames : array[1..2] of string = ('Mono', 'Stereo');
            type
                PSound = ^TSound;
                TSound = array[0..65520] of byte;

                PVOCHeader = ^TVOCHeader;
                TVOCHeader = array[1..26] of byte;

                TripleByte = array[1..3] of byte;

                PBlock = ^TBlock;
                TBlock =
                    record
                        BlockType: byte;
                        BlockLength: TripleByte;
                    end;

                PEndBlock = ^TEndBlock;
                TEndBlock =
                    record
                        BlockType : byte;
                    end;

                PVoiceBlock = ^TVoiceBlock;
                TVoiceBlock =
                    record
                        BlockType : byte;
                        BlockLength : TripleByte;
                        SR : byte;
                        Packing : byte;
                        Data : array[0..65520] of byte;
                    end;

                PVoiceContinueBlock = ^TVoiceContinueBlock;
                TVoiceContinueBlock =
                    record
                        BlockType : byte;
                        BlockLength : TripleByte;
                        Data : array[0..65520] of byte;
                    end;

                PSilenceBlock = ^TSilenceBlock;
                TSilenceBlock =
                    record
                        BlockType : byte;
                        BlockLength : TripleByte;
                        Duration : word;
                        SR : byte;
                    end;

                PMarkerBlock = ^TMarkerBlock;
                TMarkerBlock =
                    record
                        BlockType : byte;
                        BlockLength : TripleByte;
                        Marker : word;
                    end;

                PMessageBlock = ^TMessageBlock;
                TMessageBlock =
                    record
                        BlockType : byte;
                        BlockLength : TripleByte;
                        Data: array[0..65520] of char;
                    end;

                PRepeatBlock = ^TRepeatBlock;
                TRepeatBlock =
                    record
                        BlockType : byte;
                        BlockLength : TripleByte;
                        Count: word;
                    end;

                PRepeatEndBlock = ^TRepeatEndBlock;
                TRepeatEndBlock =
                    record
                        BlockType : byte;
                        BlockLength : TripleByte;
                    end;
                PExtendedInfoBlock = ^TExtendedInfoBlock;
                TExtendedInfoBlock =
                    record
                        BlockType : byte;
                        BlockLength : TripleByte;
                        ExtendedSR : word;
                        Packing : byte;
                        Mode : byte; {0 = mono, 1 = stereo}
                    end;
                PNewVoiceBlock = ^TNewVoiceBlock;
                TNewVoiceBlock =
                    record
                        BlockType : byte;
                        BlockLength : TripleByte;
                        SamplingRate : word; {HZ}
                        Dummy1 : array[1..2] of byte;
                        BitsPerSample : byte; {Uncompressed bits per sample}
                        Mode : byte; {1 = mono, 2 = stereo}
                        Compression: word;
                        Dummy2 : array[1..4] of byte;
                        Data : array[0..64000] of byte;
                    end;
            function TripleByteToLongint(TB: TripleByte): LongInt;
            function GetSamplingRate(SR: byte): LongInt;
            function GetSRByte(SamplingRate: word): byte;
            function GetExtendedSamplingRate(ExtendedSR: word; Mode: byte): LongInt;
            function BlockSize(Block: PBlock): LongInt;
            procedure IncrementPtr(var P: pointer; Count: word);
            function FindNextBlock(Block: PBlock): PBlock;
            function LoadVOCFile(FileName: string; var Sound: PSound): LongInt;
        implementation
            uses
                Mem;
            function TripleByteToLongint(TB: TripleByte): LongInt;
                begin
                    TripleByteToLongint := LongInt(TB[1]) + LongInt(TB[2]) SHL 8 + LongInt(TB[3]) SHL 16;
                end;
            function GetSamplingRate(SR: byte): LongInt;
                begin
                    GetSamplingRate := -1000000 div (SR - 256);
                end;
            function GetSRByte(SamplingRate: word): byte;
                begin
                    GetSRByte := 256-(1000000 div SamplingRate);
                end;
            function GetExtendedSamplingRate(ExtendedSR: word; Mode: byte): LongInt;
                begin
                    case Mode
                        of
                            ExtendedMono:
                                GetExtendedSamplingRate := -256000000 div (ExtendedSR-65536);
                            ExtendedStereo:
                                GetExtendedSamplingRate := (-256000000 div (ExtendedSR-65536)) div 2;
                        end;
                end;
            function BlockSize(Block: PBlock): LongInt;
                begin
                    BlockSize := TripleByteToLongInt(Block^.BlockLength) + 4;
                end;
            procedure IncrementPtr(var P: pointer; Count: word);
              {Easier to implement in assembly}
                begin
                    asm
                        LES  DI, P
                        MOV  BX, Count
                        MOV  AX, ES:[DI]
                        MOV  DX, ES:[DI+2]
                        ADD  AX, BX
                        CMP  AX, $000F
                        JNA  @1
                        MOV  BX, AX
                        AND  AX, $F
                        AND  BX, $FFF0
                        MOV  CL, 4
                        SHR  BX, CL
                        ADD  DX, BX
                      @1:
                        MOV  ES:[DI], AX
                        MOV  ES:[DI+2], DX
                    end;
                end;
            function FindNextBlock(Block: PBlock): PBlock;
                var
                    NewBlock: PBlock;
                    BlockSize: LongInt;
                begin
                    if Block^.BlockType = EndBlockNum
                        then
                            begin
                                FindNextBlock := nil;
                                Exit;
                            end;
                    NewBlock := Block;
                    BlockSize := TripleByteToLongInt(Block^.BlockLength) + 4;
                    while BlockSize > 0 do
                        begin
                            if BlockSize > 64000
                                then
                                    begin
                                        IncrementPtr(pointer(NewBlock), 64000);
                                        Dec(BlockSize, 64000);
                                    end
                                else
                                    begin
                                        IncrementPtr(pointer(NewBlock), BlockSize);
                                        BlockSize := 0;
                                    end;
                        end;
                    FindNextBlock := NewBlock;
                end;
            function LoadVOCFile(FileName: string; var Sound: PSound): LongInt;
               var
                    f: file;
                    Dummy: Pointer;
                    LeftToRead: LongInt;
                    Header: PVOCHeader;
                begin
                    Assign(f, FileName);
                    {$I-}
                    Reset(f, 1);
                    {$I+}
                    if IOResult <> 0
                        then
                            begin
                                LoadVOCFile := 0; {Couldn't open file}
                                Exit;
                            end;
                    LeftToRead := FileSize(f) - SizeOf(Header^);
                    LoadVOCFile := LeftToRead;
                    New(Header);
                    BlockRead(f, Header^, SizeOf(Header^));

                    if GetBuffer(pointer(Sound), LeftToRead) <> true
                        then
                            begin
                                LoadVOCfile := 0; {Failed to allocate memory}
                                Exit;
                            end;
                    Dummy := Sound;
                    while LeftToRead > 0 do
                        begin
                            if LeftToRead < 64000
                                then
                                    begin
                                        BlockRead(f, Dummy^, LeftToRead);
                                        LeftToRead := 0;
                                    end
                                else
                                    begin
                                        BlockRead(f, Dummy^, 64000);
                                        LeftToRead := LeftToRead - 64000;
                                        IncrementPtr(Dummy, 64000);
                                    end;
                        end;
                    Close(f);
                    Dispose(Header);
                end;
        begin
        end.

    {       SBDSP is Copyright 1994 by Ethan Brodsky.  All rights reserved.      }

    {$X+} {Extended syntax on}
    unit SBDSP;
        interface
            uses
                VOC;
            const
                On = true;
                Off = false;
            type
                Proc = procedure;
            function InitSB(IRQ: byte; BaseIO: word; DMAChannel: byte): boolean;
              {This function must be called before any sound is played.  It will }
              {initialize internal variables, reset the DSP chip, and install the}
              {interrupt handler.                                                }
              {IRQ:           The sound card's IRQ setting (Usually 5 or 7)      }
              {BaseIO:        The sound card's base IO address (Usually $220)    }
              {DMAChannel:    The sound card's 8-bit DMA channel (Usually 1)     }
              {Returns:                                                          }
              {    TRUE:      Sound card initialized correctly                   }
              {    FALSE:     Error initializing sound card                      }
            function EnvironmentSet: boolean;
              {Returns:                                                          }
              {    TRUE:  The BLASTER environment variable is set                }
              {    FALSE: The BLASTER environment variable isn't set             }
            function InitSBFromEnv: boolean;
              {This function initializes the sound card from the settings stored }
              {in the BLASTER environment variable.  I'm not sure if all sound   }
              {cards use the enviroment variable.                                }
              {Returns:                                                          }
              {    TRUE:  Environment variable found and sound card initialized  }
              {    FALSE: Environment variable not set or error initializing card}
            procedure ShutDownSB;
              {This procedure must be called at the end of the program.  It stops}
              {sound output, removes the interrupt handler, and restores the old }
              {interrupt handler.                                                }
            procedure InstallHandler;
              {This procedure will reinstall the }
            procedure UninstallHandler;
              {This procedure will remove the interrupt handler.  You should not }
              {need to call this.  If you do, sound output won't work until the  }
              {handler is reinstalled.                                           }
            function ResetDSP: boolean;
              {This function resets the sound card's DSP chip.                   }
              {Returns:                                                          }
              {    TRUE:    The sound card's DSP chip was successfully reseted   }
              {    FALSE:   The chip couldn't be initialized (Don't use it)      }
            function GetDSPVersion: string;
              {This function returns a string containing the DSP chip version.   }
            procedure TurnSpeakerOn;
              {This procedure turns on the speaker.  This should be called before}
              {a sound is played, but after the sound card is initialized.       }
            procedure TurnSpeakerOff;
              {Turn off the speaker so that sound can't be heard.  You should do }
              {this when your program is finished playing sound.                 }
            function GetSpeakerState: boolean;
              {Returns the state of the speaker.  Only works on SBPro and higher.}
              {Returns:                                                          }
              {    TRUE:    Speaker is on                                        }
              {    FALSE:   Speaker is off                                       }
            procedure PlaySound(Sound: PSound);
              {Stops any sound in progress and start playing the sound specified.}
              {Sound:       Pointer to buffer that the VOC file was loaded into  }
            procedure PauseSound;
              {Pauses the sound output in progress.                              }
            procedure ContinueSound;
              {Continues sound output stopped by Pause.                          }
            procedure BreakLoop;
              {Stops the loop at the end of the current iteration and continues  }
              {with the next block.                                              }
            procedure SetMarkerProc(MarkerProcedure: pointer);
              {Installs a marker handler.  Each time a marker block is reached,  }
              {the procedure specified is called.  Before installing a handler,  }
              {you should store the old handler.  Your handler should also call  }
              {the old handler.  Look in the example program to see how this is  }
              {done.                                                             }
              {MarkerProcedure:  Pointer to the marker procedure                 }
            procedure GetMarkerProc(var MarkerProcedure: pointer);
              {Gets the current marker procedure.                                }
              {MarkerProcedure:  Current marker procedure (nil if none)          }
            var
                SoundPlaying  : boolean;
                Looping       : boolean;
                UnknownBlock  : boolean;
                UnplayedBlock : boolean;
                LastMarker    : word;
        implementation
            uses
                DOS,
                CRT,
                Mem;
            const
                {DSP Commands}
                CmdDirectDAC       = $10;
                CmdNormalDMADAC    = $14;
                Cmd2BitDMADAC      = $16;
                Cmd2BitRefDMADAC   = $17;
                CmdDirectADC       = $20;
                CmdNormalDMAADC    = $24;
                CmdSetTimeConst    = $40;
                CmdSetBlockSize    = $48;
                Cmd4BitDMADAC      = $74;
                Cmd4BitRefDMADAC   = $75;
                Cmd26BitDMADAC     = $76;
                Cmd26BitRefDMADAC  = $77;
                CmdSilenceBlock    = $80;
                CmdHighSpeedDMADAC = $91;
                CmdHighSpeedDMAADC = $99;
                CmdHaltDMA         = $D0;
                CmdSpeakerOn       = $D1;
                CmdSpeakerOff      = $D3;
                CmdGetSpeakerState = $D8;
                CmdContinueDMA     = $D4;
                CmdGetVersion      = $E1;
                DACCommands : array[0..3] of byte = (CmdNormalDMADAC, Cmd4BitDMADAC, Cmd26BitDMADAC, Cmd2BitDMADAC);
            var
                ResetPort    : word;
                ReadPort     : word;
                WritePort    : word;
                PollPort     : word;

                PICPort      : byte;
                IRQStartMask : byte;
                IRQStopMask  : byte;
                IRQIntVector : byte;
                IRQHandlerInstalled : boolean;

                DMAStartMask : byte;
                DMAStopMask  : byte;
                DMAModeReg   : byte;

                OldIntVector : pointer;
                OldExitProc  : pointer;

                MarkerProc   : pointer;
            var
                VoiceStart     : LongInt;
                CurPos         : LongInt;
                CurPageEnd     : LongInt;
                VoiceEnd       : LongInt;
                LeftToPlay     : LongInt;
                TimeConstant   : byte;
                SoundPacking   : byte;
                CurDACCommand  : byte;

                LoopStart      : PBlock;
                LoopsRemaining : word;
                EndlessLoop    : boolean;

                SilenceBlock   : boolean;

                CurBlock       : PBlock;
                NextBlock      : PBlock;

            procedure EnableInterrupts;  InLine($FB); {STI}
            procedure DisableInterrupts; InLine($FA); {CLI}
            procedure WriteDSP(Value: byte);
                Inline
                  (
                    $8B/$16/>WritePort/    {MOV   DX, WritePort (Variable)  }
                    $EC/                   {IN    AL, DX                    }
                    $24/$80/               {AND   AL, 80h                   }
                    $75/$FB/               {JNZ   -05                       }
                    $58/                   {POP   AX                        }
                    $8B/$16/>WritePort/    {MOV   DX, WritePort (Variable)  }
                    $EE                    {OUT   DX, AL                    }
                  );
            function ReadDSP: byte;
                Inline
                  (
                    $8B/$16/>PollPort/     {MOV   AL, PollPort  (Variable)  }
                    $EC/                   {IN    AL, DX                    }
                    $24/$80/               {AND   AL, 80h                   }
                    $74/$FB/               {JZ    -05                       }
                    $8B/$16/>ReadPort/     {MOV   DX, ReadPort  (Variable)  }
                    $EC                    {IN    AL,DX                     }
                  );
            function InitSB(IRQ: byte; BaseIO: word; DMAChannel: byte): boolean;
                const
                    IRQIntNums : array[0..15] of byte =
                        ($08, $09, $0A, $0B, $0C, $0D, $0E, $0F,
                         $70, $71, $72, $73, $74, $75, $76, $77);
                var
                    Success: boolean;
                begin
                    if IRQ <= 7
                        then PICPort := $21   {INTC1}
                        else PICPort := $A1;  {INTC2}
                    IRQIntVector := IRQIntNums[IRQ];
                    IRQStopMask  := 1 SHL (IRQ mod 8);
                    IRQStartMask := not(IRQStopMask);

                    ResetPort := BaseIO + $6;
                    ReadPort  := BaseIO + $A;
                    WritePort := BaseIO + $C;
                    PollPort  := BaseIO + $E;

                    DMAStartMask := DMAChannel + $00; {000000xx}
                    DMAStopMask  := DMAChannel + $04; {000001xx}
                    DMAModeReg   := DMAChannel + $48; {010010xx}

                    Success := ResetDSP;
                    if Success then InstallHandler;
                    InitSB := Success;
                end;
            function EnvironmentSet: boolean;
                begin
                    EnvironmentSet := GetEnv('BLASTER') <> '';
                end;
            function GetSetting(BLASTER: string; Letter: char; Hex: boolean; var Value: word): boolean;
                var
                    EnvStr: string;
                    NumStr: string;
                    ErrorCode: integer;
                begin
                    EnvStr := BLASTER + ' ';
                    Delete(EnvStr, 1, Pos(Letter, EnvStr));
                    NumStr := Copy(EnvStr, 1, Pos(' ', EnvStr)-1);
                    if Hex
                        then Val('$' + NumStr, Value, ErrorCode)
                        else Val(NumStr, Value, ErrorCode);
                    if ErrorCode <> 0
                        then GetSetting := false
                        else GetSetting := true;
                end;
            function GetSettings(var BaseIO, IRQ, DMAChannel: word): boolean;
                var
                    EnvStr: string;
                    i: byte;
                begin
                    EnvStr := GetEnv('BLASTER');
                    for i := 1 to Length(EnvStr) do EnvStr[i] := UpCase(EnvStr[i]);
                    GetSettings := true;
                    if EnvStr = ''
                        then
                            GetSettings := false
                        else
                            begin
                                if not(GetSetting(EnvStr, 'A', true, BaseIO))
                                    then GetSettings := false;
                                if not(GetSetting(EnvStr, 'I', false, IRQ))
                                    then GetSettings := false;
                                if not(GetSetting(EnvStr, 'D', false, DMAChannel))
                                    then GetSettings := false;
                            end;
                end;
            function InitSBFromEnv: boolean;
                var
                    IRQ, BaseIO, DMAChannel: word;
                begin
                    if GetSettings(BaseIO, IRQ, DMAChannel)
                        then InitSBFromEnv := InitSB(IRQ, BaseIO, DMAChannel)
                        else InitSBFromEnv := false;
                end;
            procedure ShutDownSB;
                begin
                    ResetDSP;
                    UninstallHandler;
                end;
            function ResetDSP: boolean;
                var
                    i: byte;
                begin
                    Port[ResetPort] := 1;
                    Delay(1);
                    Port[ResetPort] := 0;
                    i := 1;
                    while (ReadDSP <> $AA) and (i < 100) do
                        Inc(i);
                    if i < 100
                        then ResetDSP := true
                        else ResetDSP := false;
                end;
            function GetDSPVersion: string;
                var
                    MajorByte, MinorByte: byte;
                    MajorStr, MinorStr: string;
                begin
                    WriteDSP(CmdGetVersion);
                    MajorByte := ReadDSP;   Str(MajorByte, MajorStr);
                    MinorByte := ReadDSP;   Str(MinorByte, MinorStr);
                    GetDSPVersion := MajorStr + '.'  + MinorStr;
                end;
            procedure TurnSpeakerOn;
                begin
                    WriteDSP(CmdSpeakerOn);
                end;
            procedure TurnSpeakerOff;
                begin
                    WriteDSP(CmdSpeakerOff);
                end;
            function GetSpeakerState: boolean;
                var
                    SpeakerByte: byte;
                begin
                    WriteDSP(CmdGetSpeakerState);
                    SpeakerByte := ReadDSP;
                    if SpeakerByte = 0
                        then GetSpeakerState := Off
                        else GetSpeakerState := On;
                end;
            procedure StartDMADSP;
                var
                    Page: byte;
                    Offset: word;
                    Length: word;
                    NextPageStart: LongInt;
                begin
                    Page := CurPos shr 16;
                    Offset := CurPos mod 65536;
                    if VoiceEnd < CurPageEnd
                        then Length := LeftToPlay-1
                        else Length := CurPageEnd - CurPos;

                    Inc(CurPos, LongInt(Length)+1);
                    Dec(LeftToPlay, LongInt(Length)+1);
                    Inc(CurPageEnd, 65536);

                    WriteDSP(CmdSetTimeConst);
                    WriteDSP(TimeConstant);
                    Port[$0A] := DMAStopMask;
                    Port[$0C] := $00;
                    Port[$0B] := DMAModeReg;
                    Port[$02] := Lo(Offset);
                    Port[$02] := Hi(Offset);
                    Port[$03] := Lo(Length);
                    Port[$03] := Hi(Length);
                    Port[$83] := Page;
                    Port[$0A] := DMAStartMask;
                    WriteDSP(CurDACCommand);
                    WriteDSP(Lo(Length));
                    WriteDSP(Hi(Length));
                end;
            procedure CallMarkerProc;
                begin
                    if MarkerProc <> nil then Proc(MarkerProc);
                end;
            function HandleBlock(Block: PBlock): boolean;
                begin
                    HandleBlock := false;
                    case Block^.BlockType
                        of
                            EndBlockNum:
                                begin
                                    SoundPlaying := false;
                                    HandleBlock := true;
                                end;
                            VoiceBlockNum:
                                begin
                                    VoiceStart := GetAbsoluteAddress(Block) + 6;
                                    CurPageEnd := ((VoiceStart shr 16) shl 16) + 65536 - 1;
                                    LeftToPlay := BlockSize(Block) - 6;
                                    VoiceEnd := VoiceStart + LeftToPlay;
                                    CurPos := VoiceStart;
                                    TimeConstant := PVoiceBlock(Block)^.SR;
                                    SoundPacking := PVoiceBlock(Block)^.Packing;
                                    CurDACCommand := DACCommands[SoundPacking];
                                    StartDMADSP;
                                    HandleBlock := true;
                                end;
                            VoiceContinueBlockNum:
                                begin
                                    VoiceStart := GetAbsoluteAddress(Block)+4;
                                    LeftToPlay := BlockSize(Block) - 4;
                                    VoiceEnd := VoiceStart + LeftToPlay;
                                    CurPos := VoiceStart;
                                    StartDMADSP;
                                    HandleBlock := true;
                                end;
                            SilenceBlockNum:
                                 begin
                                     SilenceBlock := true;
                                     WriteDSP(CmdSetTimeConst);
                                     WriteDSP(PSilenceBlock(Block)^.SR);
                                     WriteDSP(CmdSilenceBlock);
                                     WriteDSP(Lo(PSilenceBlock(Block)^.Duration+1));
                                     WriteDSP(Hi(PSilenceBlock(Block)^.Duration+1));
                                     HandleBlock := true;
                                 end;
                            MarkerBlockNum:
                                 begin
                                     LastMarker := PMarkerBlock(Block)^.Marker;
                                     CallMarkerProc;
                                 end;
                            MessageBlockNum:
                                begin
                                end;
                            RepeatBlockNum:
                                begin
                                     LoopStart := NextBlock;
                                     LoopsRemaining := PRepeatBlock(Block)^.Count+1;
                                     if LoopsRemaining = 0 {Wrapped around from $FFFF}
                                         then EndlessLoop := true
                                         else EndlessLoop := false;
                                     Looping := true;
                                 end;
                            RepeatEndBlockNum:
                                 begin
                                     if not(EndlessLoop)
                                         then
                                             begin
                                                 Dec(LoopsRemaining);
                                                 if LoopsRemaining = 0
                                                     then
                                                         begin
                                                             Looping := false;
                                                             Exit;
                                                         end;
                                             end;
                                     NextBlock := LoopStart;
                                 end;
                            NewVoiceBlockNum:
                                 begin
                                     if (PNewVoiceBlock(Block)^.Mode = NewStereo) or (PNewVoiceBlock(Block)^.BitsPerSample = 16)
                                         then
                                             UnplayedBlock := true
                                         else
                                             begin
                                                 VoiceStart := GetAbsoluteAddress(Block) + 16;
                                                 CurPageEnd := ((VoiceStart shr 16) shl 16) + 65536 - 1;
                                                 LeftToPlay := BlockSize(Block) - 16;
                                                 VoiceEnd := VoiceStart + LeftToPlay;
                                                 CurPos := VoiceStart;
                                                 TimeConstant := GetSRByte(PNewVoiceBlock(Block)^.SamplingRate);
                                                 SoundPacking := PNewVoiceBlock(Block)^.Compression;
                                                 CurDACCommand := DACCommands[SoundPacking];
                                                 StartDMADSP;
                                                 HandleBlock := true;
                                             end;
                                 end;
                            else
                                 UnknownBlock := true;
                        end;
                end;
            procedure ProcessBlocks;
                begin
                    repeat
                        CurBlock := NextBlock;
                        NextBlock := FindNextBlock(pointer(CurBlock));
                    until HandleBlock(CurBlock);
                end;
            procedure ClearInterrupt;
                var
                    Temp: byte;
                begin
                    Temp := Port[PollPort];
                    Port[$20] := $20;
                end;
            procedure IntHandler; interrupt;
                begin
                    if SilenceBlock {Interrupted because a silence block ended}
                        then
                            begin
                                SilenceBlock := false;
                                ProcessBlocks;
                            end
                        else {Interrupted because a DMA transfer was completed}
                            if LeftToPlay <> 0
                                then StartDMADSP
                                else ProcessBlocks;

                    ClearInterrupt;
                end;
            procedure PlaySound(Sound: PSound);
                begin
                    PauseSound;
                    NextBlock      := PBlock(Sound);
                    SoundPlaying   := true;
                    Looping        := false;
                    LastMarker     := 0;
                    UnknownBlock   := false;
                    UnplayedBlock  := false;

                    LoopStart      := nil;
                    LoopsRemaining := 0;
                    EndlessLoop    := false;

                    ProcessBlocks;
                end;
            procedure PauseSound;
                begin
                    WriteDSP(CmdHaltDMA);
                end;
            procedure ContinueSound;
                begin
                    WriteDSP(CmdContinueDMA);
                end;
            procedure BreakLoop;
                begin
                    LoopsRemaining := 1;
                    EndlessLoop := false;
                end;

            procedure StopSBIRQ;
                begin
                    Port[PICPort] := Port[PICPort] OR IRQStopMask;
                end;
            procedure StartSBIRQ;
                begin
                    Port[PICPort] := Port[PICPort] AND IRQStartMask;
                end;
            procedure InstallHandler;
                begin
                    DisableInterrupts;
                    StopSBIRQ;
                    GetIntVec(IRQIntVector, OldIntVector);
                    SetIntVec(IRQIntVector, @IntHandler);
                    StartSBIRQ;
                    EnableInterrupts;
                    IRQHandlerInstalled := true;
                end;
            procedure UninstallHandler;
                begin
                    DisableInterrupts;
                    StopSBIRQ;
                    SetIntVec(IRQIntVector, OldIntVector);
                    EnableInterrupts;
                    IRQHandlerInstalled := false;
                end;

            procedure SetMarkerProc(MarkerProcedure: pointer);
                begin
                    MarkerProc := MarkerProcedure;
                end;
            procedure GetMarkerProc(var MarkerProcedure: pointer);
                begin
                    MarkerProcedure := MarkerProc;
                end;
            procedure SBDSPExitProc; far;
                begin
                    ExitProc := OldExitProc;
                    ResetDSP;
                    if (IRQHandlerInstalled = true) then UninstallHandler;
                end;
        begin
            MarkerProc   := nil;
            OldExitProc  := ExitProc;
            ExitProc     := @SBDSPExitProc;
            SoundPlaying := false;
        end.

    {       SBDSP is Copyright 1994 by Ethan Brodsky.  All rights reserved.      }
    {$M 16384, 0, 419430   Give some memory to the DOS shell.  If you are not}
    {going to shell to DOS, you can remove this line and let your program use}
    {all available memory for the heap.}
    program PlayVOCDirect;
        uses
            CRT,
            DOS,
            Mem,
            SBDSP,
            VOC;
        const
            IRQ        = 5;
            BaseIO     = $220;
            DMAChannel = 1;
            DefaultVOC = 'C:\MUSIC\ESCAPE2.VOC';
             {Put the name of the VOC file to play here}
             {or pass it as a parameter to the program.}
        var
            VOCFileName : string;
            SoundSize   : LongInt;
            Sound       : PSound;
            Chr         : char;
            OldMarkerProc : pointer;
        function GetHexWordStr(w: word): string;
            const
                HexChars: array [0..$F] of Char = '0123456789ABCDEF';
            begin
                GetHexWordStr := HexChars[Hi(w) shr 4] + HexChars[Hi(w) and $F] +
                                 HexChars[Lo(w) shr 4] + HexChars[Lo(w) and $F];
            end;
        procedure DisplayMarker; far;
            var
                Hour, Minute, Second, Sec100: word;
            begin
                GetTime(Hour, Minute, Second, Sec100);
                writeln('Reached marker ', LastMarker,
                        ' at ', Hour, ':', Minute, ':', Second, '.', Sec100);
                if (OldMarkerProc <> nil) then Proc(OldMarkerProc);
                  {If another handler is installed, call it}
            end;
        procedure WriteInstructions;
            begin
                writeln('Begining output of sound file');
                writeln('Press <B> to break loop');
                writeln('Press <P> to pause output');
                writeln('Press <C> to continue output');
                writeln('Press <D> to shell to DOS');
                writeln('Press <X> to stop output and exit');
            end;
        begin
            writeln; writeln;

            if EnvironmentSet
                then
                    begin
                        if InitSBFromEnv
                            then
                                begin
                                    writeln('Sound card initialized correctly using the BLASTER environment variable!');
                                    writeln('DSP version ', GetDSPVersion);
                                end
                            else
                                begin
                                    writeln('Error initializing sound card!');
                                    Halt(255);
                                end;
                    end
                else
                    begin
                        writeln('BLASTER environment variable not set, using default settings');
                        writeln('IRQ = ', IRQ, '    Base IO = $', GetHexWordStr(BaseIO), '    DMA Channel = ', DMAChannel );
                        if InitSB(IRQ, BaseIO, DMAChannel)
                            then
                                begin
                                    writeln('Sound card initialized correctly!');
                                    writeln('DSP version ', GetDSPVersion);
                                end
                            else
                                begin
                                    writeln('Error initializing sound card!');
                                    Halt(255);
                                end;
                    end;

            if ParamCount = 0
                then VOCFileName := DefaultVOC
                else VOCFileName := ParamStr(1);
            SoundSize := LoadVOCfile(VOCFileName, Sound);  writeln('Sound file loaded');
            if SoundSize = 0
                then
                    begin
                        writeln('Error loading VOC file.  Probably because:');
                        writeln('    1.  There is no VOC file by name ', VOCFileName, '.');
                        writeln('    2.  There is not enough memory to load it.');
                        writeln('        Largest available block:  ', MaxAvail, ' bytes');
                        Halt;
                    end;

            GetMarkerProc(OldMarkerProc);
            SetMarkerProc(@DisplayMarker);

            TurnSpeakerOn;
            WriteInstructions;
            PlaySound(Sound);
            repeat
                if KeyPressed
                    then
                        begin
                            Chr := UpCase(ReadKey);
                            case Chr
                                of
                                    'B':
                                        begin
                                            BreakLoop;
                                            writeln('Broke out of loop');
                                        end;

                                    'P':
                                        begin
                                            PauseSound;
                                            writeln('Sound output paused');
                                        end;
                                    'C':
                                        begin
                                            ContinueSound;
                                            writeln('Sound output continued');
                                        end;
                                    'D':
                                        begin
                                            SwapVectors;
                                            Exec(GetEnv('COMSPEC'), '');
                                            if DOSError <> 0
                                                then
                                                    begin
                                                        writeln('Error running COMMAND.COM!');
                                                        Halt(255);
                                                    end;
                                            SwapVectors;
                                            WriteInstructions;
                                        end;
                                    'X':
                                        begin
                                            PauseSound;
                                            writeln('Sound output stopped!');
                                            Exit;
                                        end;
                                end;
                        end;
                if UnknownBlock
                    then
                        begin
                            writeln('An unknown VOC block was reached.  It is probably');
                            writeln('block 8, which I didn''t implement because it is');
                            writeln('useless. (At least for this library it is)');
                            UnknownBlock := false;
                        end;
                if UnplayedBlock
                   then
                       begin
                           writeln('A 16-bit or stereo block was reached.  This library');
                           writeln('doesn''t support either of these.');
                           UnplayedBlock := false;
                       end;
            until (SoundPlaying = false);
            TurnSpeakerOff;

            SetMarkerProc(OldMarkerProc); {Not really necessary}
            FreeBuffer(pointer(Sound), SoundSize);
            ShutDownSB;
        end.

[Back to SOUND SWAG index] [Back to Main SWAG index] [Original]