''--------------------------------------------------------------------------''
''  @@ Source Documentation             *** BASIC Version ***               ''
''                                                                          ''
''  TITLE : DEMOFADE.BAS                                                    ''
''                                                                          ''
''  DESCRIPTION :                                                           ''
''      This program demostrates how to use the AUXDRV.DRV driver to        ''
''      perform fading effect and volume control on the playing midi        ''
''      file.                                                               ''
''                                                                          ''
''      Note that the BLASTER environment has to be set before executing    ''
''      this program.                                                       ''
''                                                                          ''
''  Note :                                                                  ''
''      Use switch /Fs for Microsoft Basic PDS 7.1 compiler.                ''
''      Input MIDI file size is limited by MIDIxBUFFER.                     ''
''                                                                          ''
''  Copyright (c) Creative Technology Ltd, 1993. All rights reserved.       ''
''                                                                          ''
''--------------------------------------------------------------------------''

'$INCLUDE: 'SBKAUX.BI'
'$INCLUDE: 'SBKMIDI.BI'
'$INCLUDE: 'SBKX.BI'

' Function prototypes
DECLARE FUNCTION PrepareCTMIDIDrv%(BlasterAddx AS LONG)
DECLARE FUNCTION PrepareCTAUXDrv%(BlasterAddx AS LONG)
DECLARE FUNCTION PlayMidi%(lpMidiBuffer AS LONG)
DECLARE FUNCTION LoadFile& (szFilename$)
DECLARE SUB SoundEffect()
DECLARE SUB WaitEffectEnd()

CONST   DRIVERxSIZE  = 32768&
CONST   FILExSIZE    = 76800&


REM $DYNAMIC
CLEAR

' Set memory buffers for AUXDRV.DRV, CTMIDI.DRV and MIDI music file '
Dummy = SETMEM(-DRIVERxSIZE)
Dummy = SETMEM(-DRIVERxSIZE)
Dummy = SETMEM(-FILExSIZE)


DIM BlasterEnv AS STRING            
DIM SHARED wMidiStatus AS INTEGER   ' Midi music output status
DIM SHARED wFadeStatus AS INTEGER   ' Fading effect output status
DIM dwAddx AS LONG
DIM NumArg AS INTEGER
DIM szCmdArg(1 TO 1) AS STRING


    PRINT "Output MIDI music with fading effect."

    ' get command line argument
    CALL sbkGetCmdLine(NumArg,szCmdArg(),1)
    IF NumArg < 1 THEN
        PRINT "Usage : DEMOFADE mid_filename"
        SYSTEM
    END IF

    ' Retrieve the BLASTER environment settings
    BlasterEnv= ENVIRON$("BLASTER")
    IF BlasterEnv <> "" THEN

        ' convert to null terminated string
        dwAddx = sbkMakeAsciizString&(BlasterEnv)

        ' Load CTMIDI.DRV into memory
        IF PrepareCTMIDIDrv%(dwAddx) <> 0 THEN

            ' Load the CTAUXDRV.DRV into memory
            IF PrepareCTAUXDrv%(dwAddx) <> 0 THEN

                ' Initialize CTMIDI.DRV driver
                IF ctmdInit% = 0 THEN
                   ' Loads file into memory
                    dwAddx = LoadFile&(szCmdArg(1))
                    IF dwAddx <> 0 THEN
                        ' Output midi music
                        IF PlayMidi%(dwAddx) = 0 THEN
                            ' Adds fading effect
                            CALL SoundEffect
                        END IF
                    END IF

                    ' Terminate CTMIDI.DRV driver
                    retVal% = ctmdTerminate%
                END IF
            END IF
        END IF
    ELSE
        PRINT "BLASTER environment not set."
    END IF

' Return memory to system
Dummy = SETMEM(FILExSIZE)
Dummy = SETMEM(DRIVERxSIZE)
Dummy = SETMEM(DRIVERxSIZE)

END


'---------------------------------------------------------------------------'
'   @@ Usage                                                                '
'                                                                           '
'   FUNCTION PrepareCTMIDIDrv% (BlasterAddx AS LONG)                        '
'                                                                           '
'   Description :                                                           '
'       Load and endorse CTMIDI.DRV driver.                                 '
'                                                                           '
'   Entry :                                                                 '
'       BlasterAddx - Far address of the BLASTER setting.                   '
'                                                                           '
'   Exit :                                                                  '
'       segment of the loaded driver if successful else return 0.           '
'                                                                           '
'---------------------------------------------------------------------------'

FUNCTION PrepareCTMIDIDrv%(BlasterAddx AS LONG)

    DIM ctmidi AS INTEGER


    ctmidi = sbkLoadDriver%("CTMIDI.DRV",UNUSED)
    IF ctmidi <> 0 THEN

        CALL ctmdSetDriverEntry(ctmidi)

        IF ctmdGetDrvVer% >= &H0100 THEN

            IF ctmdGetEnvSettings%(BlasterAddx) = 0 THEN
                PrepareCTMIDIDrv% = ctmidi
                EXIT FUNCTION
            ELSE
                PRINT "BLASTER environment is not valid"
            END IF
        ELSE
            PRINT "Invalid CTMIDI.DRV - ";
            PRINT "I need CTMIDI.DRV version 1.00 or higher."
        END IF

        CALL sbkFreeMem(ctmidi)
    ELSE
        PRINT "Error loading CTMIDI.DRV or CTMIDI.DRV not found."
    END IF

    PrepareCTMIDIDrv% = 0

END FUNCTION


'---------------------------------------------------------------------------'
'   @@ Usage                                                                '
'                                                                           '
'   FUNCTION PrepareCTAUXDrv%(BlasterAddx AS LONG)                          '
'                                                                           '
'   Description :                                                           '
'       Load and endorse AUXDRV.DRV driver.                                 '
'                                                                           '
'   Entry :                                                                 '
'       BlasterAddx - Far address of the BLASTER setting.                   '
'                                                                           '
'   Exit :                                                                  '
'       segment of the driver if sucessful else return 0.                   '
'                                                                           '
'---------------------------------------------------------------------------'

FUNCTION PrepareCTAUXDrv%(BlasterAddx AS LONG)

    DIM CTAuxDrv AS INTEGER


    CTAuxDrv = sbkLoadDriver%("AUXDRV.DRV",UNUSED)
    IF CTAuxDrv <> 0 THEN

        ' Initialises the CTAUX.DRV driver entry point
        CALL ctadSetDriverEntry((CTAuxDrv))

        ' Retrieves AUXDRV.DRV version
        IF ctadGetDrvVer% >= &H0302 THEN

            ' Passes BLASTER environment settings to the driver
            IF ctadGetEnvSettings((BlasterAddx)) = 0 THEN
                PrepareCTAUXDrv% = CTAuxDrv
                EXIT FUNCTION
            ELSE
                PRINT "BLASTER environment is not valid"
            END IF
        ELSE
            PRINT "Invalid AUXDRV.DRV - ";
            PRINT "I need AUXDRV.DRV version 3.02 or higher."
        END IF

        CALL sbkFreeMem(CTAuxDrv)
    ELSE
        PRINT "Error loading AUXDRV.DRV or AUXDRV.DRV not found."
    END IF

    PrepareCTAUXDrv% = 0

END FUNCTION


'---------------------------------------------------------------------------'
'   @@ Usage                                                                '
'                                                                           '
'    FUNCTION PlayMidi%(lpMidiBuffer AS LONG)                               '
'                                                                           '
'    DESCRIPTION:                                                           '
'       Play a Midi file in the background and return.                      '
'                                                                           '
'    ENTRY:                                                                 '
'       lpMidiBuffer :- far address to MIDI buffer.                         '
'                                                                           '
'    EXIT:                                                                  '
'       zero if successful, else return non-zero.                           '
'                                                                           '
'---------------------------------------------------------------------------'

FUNCTION PlayMidi%(lpMidiBuffer AS LONG)

    DIM retVal AS INTEGER, dwValue AS LONG


    ' Reset MIDI device parameter
    IF ctmdResetMidiDriver% = 0 THEN

        ' Set MIDI output status address
        IF ctmdSetOutputStatusAddx%(wMidiStatus) = 0 THEN
            ' initialize output parameters with reference to the
            ' MIDI file
            IF ctmdPrepareMidiStart%(lpMidiBuffer) = 0 THEN
                ' Start MIDI output
                IF ctmdPlayMidiMusic% = 0 THEN
                    PlayMidi% = 0
                    EXIT FUNCTION
                END IF
            END IF
        ELSE
            PRINT "Error setting MIDI status address."
        END IF
    ELSE
        PRINT "Error resetting MIDI device."
    END IF

    PlayMidi% = 1

END FUNCTION


'---------------------------------------------------------------------------'
'   @@ Usage                                                                '
'                                                                           '
'   FUNCTION LoadFile&(szFilename$)                                         '
'                                                                           '
'   DESCRIPTION:                                                            '
'       Load file into memory.                                              '
'                                                                           '
'   ENTRY:                                                                  '
'       szFileName  - File to be loaded.                                    '
'                                                                           '
'   EXIT:                                                                   '
'       pointer to the buffer of the loaded file if successful,             '
'       otherwise 0 is returned.                                            '
'                                                                           '
'---------------------------------------------------------------------------'

REM $STATIC
FUNCTION LoadFile& (szFilename$)

    DIM iHandle%, filelen&, segment%


    LoadFile& = 0

    iHandle% = sbkDosOpen%(sbkMakeAsciizString&(szFilename$))

    IF (iHandle% <> -1) THEN
        filelen& = sbkFileSize&(iHandle%)
        segment% = sbkAllocMem%(INT((filelen& + 15) / 16))
        IF segment% <> 0 THEN

            IF sbkDosRead%(iHandle%, segment%, 0, filelen&) <> 0 THEN
                LoadFile& = sbkMakeDWord&(segment%,0)
            ELSE
                PRINT "Read file error."
                CALL sbkFreeMem(segment%)
            END IF
        ELSE
            PRINT "DOS : Error allocating MIDI output buffer."
        END IF

        CALL sbkDosClose(iHandle%)
    ELSE
        PRINT "Open " + szFilename$ + "error."
    END IF

END FUNCTION


'---------------------------------------------------------------------------'
'   @@ Usage                                                                '
'                                                                           '
'    SUB SoundEffect ()                                                     '
'                                                                           '
'    DESCRIPTION:                                                           '
'        Adds fading effect on the playback midi.                           '
'                                                                           '
'    ENTRY:                                                                 '
'        None.                                                              '
'                                                                           '
'    EXIT:                                                                  '
'        None.                                                              '
'                                                                           '
'---------------------------------------------------------------------------'

SUB SoundEffect

    DIM     wPrevVol AS INTEGER
    DIM     retVal AS INTEGER


    PRINT "Fading effect...."
    PRINT TAB(4)"[Esc] - to stop"
    PRINT TAB(4)"[P  ] - to pause"
    PRINT TAB(4)"[C  ] - to continue"

    ' initialise AUXDRV.DRV driver
    CALL ctadInit

    ' preserves the previous MIDI volume settings
    wPrevVol = ctadGetVolume%(MIXERVOLxMIDI)

    ' sets address of the pan status
    CALL ctadSetFadeStAddx(wFadeStatus)

    PRINT ""

    WHILE wMidiStatus <> 0

        ' set MIDI left/right volume to &H8080
        retVal = ctadSetVolume%(MIXERVOLxMIDI, &H8080)

        ' Setup MIDI volume fading in mode 0
        PRINT "Fading effect...zoommmmm....in..."
        retVal = ctadFade%(MIXERVOLxMIDI, &Hf0f0, 4000, 0, 0)
        retVal = ctadStartCtrl%
        CALL WaitEffectEnd

        ' set MIDI left/right volume to &Hf0f0
        retVal = ctadSetVolume%(MIXERVOLxMIDI,&Hf0f0)

        ' Setup MIDI volume fading in mode 0
        PRINT "Fading effect...zoommmmm....out...  "
        retVal = ctadFade%(MIXERVOLxMIDI, &H8080, 4000, 0, 0)
        retVal = ctadStartCtrl
        CALL WaitEffectEnd
    WEND

    PRINT "End of fading effect..."

    ' set MIDI left/right volume back to previous status
    retVal = ctadSetVolume%(MIXERVOLxMIDI, wPrevVol)

    CALL ctadTerminate

END SUB


'---------------------------------------------------------------------------'
'   @@ Usage                                                                '
'                                                                           '
'   SUB WaitEffectEnd ()                                                    '
'                                                                           '
'   DESCRIPTION:                                                            '
'       Control fading effect of the digitized sound.                       '
'                                                                           '
'   ENTRY:                                                                  '
'       None                                                                '
'                                                                           '
'   EXIT:                                                                   '
'       None                                                                '
'                                                                           '
'---------------------------------------------------------------------------'

SUB WaitEffectEnd

    SHARED wFadeStatus AS INTEGER, wMidiStatus AS INTEGER
    DIM retVal AS INTEGER, pause AS INTEGER


    ' End of sound effect process ?
    WHILE (wFadeStatus)

        ' Stop effect if no MIDI output process
        IF wMidiStatus = 0 THEN
            retVal = ctadStopCtrl%
        END IF

        c$ = INKEY$
        IF c$ <> "" THEN
            userkey = INT(ASC(LEFT$(c$,1)))

            SELECT CASE userkey
                CASE ASC("S"),ASC("s"),27
                    retVal = ctadStopCtrl%
                    retVal = ctmdStopMidiMusic%

                CASE ASC("P"),ASC("p")
                    IF pause = 0 THEN
                        PRINT "Effect pause...                 "
                        retVal = ctadPauseCtrl%
                        retVal = ctmdPauseMidiMusic%
                        pause = 1
                    END IF

                CASE ASC("C"),ASC("c")
                    IF pause <> 0 THEN
                        PRINT "Effect continue...              "
                        retVal = ctadStartCtrl%
                        retVal = ctmdResumeMidiMusic%
                        pause = 0
                    END IF

            END SELECT
        END IF
    WEND

END SUB
'End Of File
