'' ------------------------------------------------------------------------ ''
''  @@ Source Documentation                     *** BASIC Version ***       ''
''                                                                          ''
''  TITLE : DEMOMIDI.BAS                                                    ''
''                                                                          ''
''  DESCRIPTION :                                                           ''
''      This program demonstrates how to use the CTMIDI.DRV driver          ''
''      to play a midi file.                                                ''
''                                                                          ''
''      Note that the BLASTER environment has to be set before executing    ''
''      this program. Set MIDI=SYNTH:1|2 MAP:G|E|B. If MIDI is not set,     ''
''      the default SYNTH:1 and MAP:E will be used.                         ''
''                                                                          ''
''  NOTE :                                                                  ''
''      Use switch /Fs for Microsoft Basic PDS 7.1 compiler.                ''
''                                                                          ''
''  Copyright (c) Creative Technology Ltd, 1993. All rights reserved.       ''
''                                                                          ''
'' ------------------------------------------------------------------------ ''

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

DECLARE FUNCTION PrepareCTMIDIDrv%(BlasterAddx AS LONG)
DECLARE FUNCTION SetMidiOutParameters% ()
DECLARE FUNCTION PlayMidi% (lpMidiBuffer AS LONG)
DECLARE FUNCTION WaitMusicEnd% ()
DECLARE FUNCTION LoadFile& (sFileName AS STRING)
DECLARE FUNCTION SearchFile% (sFileName() AS STRING, FileList() AS STRING)
DECLARE SUB DisplayMenu ()

CONST TRUE  = 1
CONST FALSE = 0

CONST MAXxFILES   = 100     '* Maximum files searched *'
CONST NAMExLEN    = 13      '* Length of file name *'

CONST CopyRight1$ = "Creative MIDI Player Version 4FUN"
CONST CopyRight2$ = "Copyright (c) Creative Technology Ltd 1993. All rights reserved"
CONST CLEARLINE$  = "                                                       "

CONST DRIVERxSIZE = 51200&
CONST FILExSIZE   = 76800&

REM $DYNAMIC
CLEAR

'* Set buffers for CTMIDI driver and MIDI music *'
Dummy = SETMEM(-DRIVERxSIZE)
Dummy = SETMEM(-FILExSIZE)


DIM SHARED wMidiStatus AS INTEGER   '* Midi music output status *'
DIM SHARED sMapper(0 TO 2) AS STRING * 13
DIM SHARED sCurrentPlay AS STRING * NAMExLEN
DIM SHARED wFilePos AS INTEGER
DIM SHARED wTotalFile AS INTEGER

DIM FileList(0 TO MAXxFILES-1) AS STRING
DIM sFilePath(1 TO 1) AS STRING
DIM lpMidiBuffer AS LONG
DIM sFileName AS STRING


    sMapper(0) = "General Midi"
    sMapper(1) = "Extended Midi"
    sMapper(2) = "Basic Midi"

    PRINT CopyRight1$
    PRINT CopyRight2$

    CALL sbkGetCmdLine (NumArgs%,sFilePath(),1)
    IF NumArgs% < 1 THEN
        PRINT "Usage : DEMOMIDI mid_filename or *.mid"
        SYSTEM
    END IF

    '* find file *'
    wTotalFile = SearchFile%(sFilePath(),FileList())
    IF wTotalFile = 0 THEN
       SYSTEM
    END IF

    sFileName = ENVIRON$("BLASTER")
    IF sFileName = "" THEN
        PRINT "BLASTER environment not set."
        SYSTEM
    END IF

    '* Load CTMIDI.DRV into memory *'
    IF PrepareCTMIDIDrv%(sbkMakeAsciizString&(sFileName)) <> 0 THEN
        '* Initialize CTMIDI.DRV driver *'
        IF ctmdInit% = 0 THEN
            '* Set MIDI output parameters *'
            IF SetMidiOutParameters% = 0 THEN

                CALL DisplayMenu
                wFilePos = 0

                DO
                    sCurrentPlay = FileList(wFilePos)
                    sFileName = sFilePath(1)
                    sFileName = sFileName + FileList(wFilePos)

                    '* Load midi file into memory buffer *'
                    lpMidiBuffer = LoadFile&(sFileName)

                    IF lpMidiBuffer <> 0 THEN
                        iretVal% = PlayMidi%(lpMidiBuffer)
                        CALL sbkFreeMem(sbkHighWord%(lpMidiBuffer))
                    ELSE
                        iretVal% = 1
                    END IF

                LOOP UNTIL iretVal% <> 0
            END IF

            '* Terminate CTMIDI.DRV driver *'
            iretVal% = ctmdTerminate%
        ELSE
            PRINT "Error initialising CTMIDI.DRV driver."
        END IF
    END IF

'* return memory to system *'
Dummy = SETMEM(FILExSIZE)
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
    DIM szMidiEnv AS STRING


    ctmidi = sbkLoadDriver%("CTMIDI.DRV",UNUSED)
    IF ctmidi <> 0 THEN
        '* Set driver entry point *'
        CALL ctmdSetDriverEntry(ctmidi)
        '* Check driver version *'
        IF ctmdGetDrvVer% >= &H0100 THEN

            '* Pass BLASTER environment to driver *'
            IF ctmdGetEnvSettings%(BlasterAddx) = 0 THEN
                '* get MIDI environment environment setting *'
                szMidiEnv = ENVIRON$("MIDI")

                IF szMidiEnv <> "" THEN
                    '* set synthesizer type and mapper channel *'
                    iretVal% = ctmdGetMidiEnvSettings%(sbkMakeAsciizString(szMidiEnv))
                END IF

                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 not found."
    END IF

    PrepareCTMIDIDrv% = 0

END FUNCTION


'* ------------------------------------------------------------------------ *'
'*  @@ Usage                                                                *'
'*                                                                          *'
'*   SetMidiOutParameters%()                                                *'
'*                                                                          *'
'*   DESCRIPTION:                                                           *'
'*       Set necessary Midi output parameters.                              *'
'*                                                                          *'
'*   ENTRY:                                                                 *'
'*      none.                                                               *'
'*                                                                          *'
'*   EXIT:                                                                  *'
'*       zero if successful else return 1.                                  *'
'*                                                                          *'
'* ------------------------------------------------------------------------ *'

FUNCTION SetMidiOutParameters%

    '* Reset MIDI device parameter *'
    IF ctmdResetMidiDriver% = 0 THEN

        '* Set MIDI output status address *'
        IF ctmdSetOutputStatusAddx%(wMidiStatus) = 0 THEN
            SetMidiOutParameters% = 0
            EXIT FUNCTION
        ELSE
            PRINT "Error setting MIDI status address."
        END IF
    ELSE
        PRINT "Error resetting MIDI device."
    END IF

    SetMidiOutParameters% = 1

END FUNCTION


'* ------------------------------------------------------------------------ *'
'*  @@ Usage                                                                *'
'*                                                                          *'
'*  PlayMidi%(lpMidiBuffer AS LONG)                                         *'
'*                                                                          *'
'*  Description :                                                           *'
'*      Start sending out MIDI code.                                        *'
'*                                                                          *'
'*  Entry :                                                                 *'
'*      lpMidiBuffer :- Music buffer.                                       *'
'*                                                                          *'
'*  Exit :                                                                  *'
'*      0 if successful else non-zero                                       *'
'*                                                                          *'
'* ------------------------------------------------------------------------ *'

FUNCTION PlayMidi% (lpMidiBuffer AS LONG)

    IF ctmdResetMidiDriver% = 0 THEN

        IF ctmdPrepareMidiStart%(lpMidiBuffer) = 0 THEN

            IF ctmdPlayMidiMusic% = 0 THEN
                PlayMidi% = WaitMusicEnd%
                EXIT FUNCTION
            ELSE
                PRINT "Error outputing music."
            END IF
        ELSE
            PRINT "Error preparing MIDI output."
        END IF
    ELSE
        PRINT "Error resetting MIDI driver."
    END IF

    PlayMidi% = 1

END FUNCTION


'* ------------------------------------------------------------------------ *'
'*  @@ Usage                                                                *'
'*                                                                          *'
'*   WaitMusicEnd%                                                          *'
'*                                                                          *'
'*   DESCRIPTION:                                                           *'
'*      Control MIDI music output.                                          *'
'*                                                                          *'
'*   ENTRY:                                                                 *'
'*       none                                                               *'
'*                                                                          *'
'*   EXIT:                                                                  *'
'*       0 if successful or continue else return non-zero.                  *'
'*                                                                          *'
'* ------------------------------------------------------------------------ *'

SUB ClrLine(R%)
    LOCATE R%,1
    PRINT CLEARLINE
    LOCATE R%,1
END SUB

FUNCTION WaitMusicEnd%

    DIM mapperType AS INTEGER, retVal AS INTEGER
    DIM transpose AS INTEGER, tempo AS INTEGER
    DIM pause AS INTEGER
    DIM sCommandEnv AS STRING * 64, char AS STRING * 1
    STATIC ROW AS INTEGER


    pause = FALSE
    transpose = 0
    tempo = 0
    mapperType = 0

    ROW = CSRLIN - 1

    CALL ClrLine (ROW)
    PRINT "Title : " + sCurrentPlay

    '* End of music ? *'
    WHILE wMidiStatus <> 0

        inpKey$ = INKEY$
        IF (inpKey$ <> "") THEN

            char = UCASE$(mid$(inpKey$,1,1))

            SELECT CASE char

                CASE CHR$(&H1b)
                    retVal = ctmdStopMidiMusic%
                    WaitMusicEnd% = 1
                    EXIT FUNCTION

                CASE "N"
                    retVal = ctmdStopMidiMusic%

                CASE "L"
                    retVal = ctmdStopMidiMusic%
                    wFilePos = wFilePos - 1
                    IF wFilePos < 0 THEN
                        wFilePos = 0
                    END IF
                    WaitMusicEnd% = 0
                    EXIT FUNCTION

                CASE "P"
                    IF pause = FALSE THEN
                        CALL ClrLine(ROW)
                        PRINT "Music pause..."
                        retVal = ctmdPauseMidiMusic%
                        pause = TRUE
                    END IF

                CASE "R"
                    IF pause = TRUE THEN
                        CALL ClrLine(ROW)
                        PRINT "Music continue..."
                        retVal = ctmdResumeMidiMusic%
                        pause = FALSE
                    END IF

                CASE "M"
                    mapperType = mapperType + 1
                    IF mappertype > 2 THEN
                        mapperType = 0
                    END IF
                    retVal = ctmdSetMapperType%(mapperType)
                    CALL ClrLine(ROW)
                    PRINT sMapper(mapperType)

                CASE "T"
                    CALL ClrLine(ROW)
                    PRINT "Title : " + sCurrentPlay

                CASE CHR$(0)

                    SELECT CASE MID$(inpKey$,2,1)

                        CASE CHR$(72)
                            IF tempo < 20 THEN
                                tempo = tempo + 1
                            END IF
                            IF ctmdSetMusicTempo%(tempo) = 0 THEN
                                CALL ClrLine(ROW)
                                PRINT "Tempo :"; tempo
                            END IF

                        CASE CHR$(80)
                            IF tempo > -20 THEN
                                tempo = tempo - 1
                            END IF
                            IF ctmdSetMusicTempo%(tempo) = 0 THEN
                                CALL ClrLine(ROW)
                                PRINT "Tempo :"; tempo
                            END IF

                        CASE CHR$(77)
                            IF transpose < 12 THEN
                                transpose = transpose + 1
                            END IF
                            IF ctmdSetMusicTranspose%(transpose) = 0 THEN
                                Call ClrLine(ROW)
                                PRINT "Transpose :"; transpose
                            END IF

                        CASE CHR$(75)
                            IF transpose > -12 THEN
                                transpose = transpose - 1
                            END IF
                            IF ctmdSetMusicTranspose%(transpose) = 0 THEN
                                Call ClrLine(ROW)
                                PRINT "Transpose :"; transpose
                            END IF
                    END SELECT
            END SELECT
        ENd IF
    WEND

    wFilePos = wFilePos + 1
    IF wFilePos < wTotalFile THEN
        WaitMusicEnd% = 0
    ELSE
        WaitMusicEnd% = 1
    END IF

END FUNCTION


'* ------------------------------------------------------------------------ *'
'*  @@ Usage                                                                *'
'*                                                                          *'
'*   LoadFile& (sFileName AS STRING)                                        *'
'*                                                                          *'
'*   DESCRIPTION:                                                           *'
'*       Load file into memory.                                             *'
'*                                                                          *'
'*   ENTRY:                                                                 *'
'*       sFileName :- File to be loaded.                                    *'
'*                                                                          *'
'*   EXIT:                                                                  *'
'*       far pointer of the loader music buffer else return nil.            *'
'*                                                                          *'
'* ------------------------------------------------------------------------ *'

REM $STATIC
FUNCTION LoadFile& (sFileName AS STRING)

    DIM iHandle%, filelen&, segment%


    LoadFile& = 0&

    iHandle% = sbkDosOpen%(sbkMakeAsciizString&(sFileName))

    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 music buffer."
        END IF

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

END FUNCTION


'* ------------------------------------------------------------------------ *'
'*  SearchFile% (sFileName() AS STRING, FileList() AS STRING)               *'
'*                                                                          *'
'*  Description :                                                           *'
'*      Search the file specified or wild card and put into global list.    *'
'*                                                                          *'
'*  Entry :                                                                 *'
'*      sFileName :- file to be search.                                     *'
'*      FileList  :- array to store searched files.                         *'
'*                                                                          *'
'*  Exit :                                                                  *'
'*      Total number of files found.                                        *'
'*                                                                          *'
'* ------------------------------------------------------------------------ *'

FUNCTION SearchFile% (sFileName() AS STRING, FileList() AS STRING)

    DIM S AS SEARCHxREC


    x% = LEN(sFileName(1))
    i% = 1

    DO
        IF ((MID$(sFileName(1),i%,1) = ".") AND ((MID$(sFileName(1),i%+1,1) = "M")_
            OR (MID$(sFileName(1),i%+1,1) = "m") OR (MID$(sFileName(1),i%+1,1) = "*"))) THEN
            EXIT DO
        END IF
        i% = i% + 1
    LOOP UNTIL i% > x%

    IF i% > x% THEN
        sFileName(1) = sFileName(1) + ".MID"
    END IF

    IF sbkFindFirst%(sbkMakeAsciizString&(sFileName(1)),READONLY,S) = 0 THEN

        pathMark% = 0
        x% = LEN(sFileName(1))
        FOR i% = 1 TO x%
            IF (MID$(sFileName(1),i%,1) = "\" OR MID$(sFileName(1),i%,1) = ":") THEN
                pathMark% = i%
            END IF
        NEXT i%

        sTemp$ = sFileName(1)

        sFileName(1) = ""
        FOR i% = 1 TO pathMark%
            sFileName(1) = sFileName(1) + MID$(sTemp$,i%,1)
        NEXT i%

        i% = 0

        DO
            IF i% >= MAXxFILES THEN
                SearchFile% = i%
                EXIT DO
            END IF

            FileList(i%) = ""

            FOR y% = 1 TO 13
                IF MID$(S.szName,y%,1) <> CHR$(0) THEN
                    FileList(i%) =  FileList(i%) + MID$(S.szName, y%, 1)
                ELSE
                    EXIT FOR
                END IF
            NEXT y%

            i% = i% + 1
            x% = sbkFindNext%(S)

        LOOP UNTIL x% <> 0

        SearchFile% = i%
        EXIT FUNCTION
    ELSE
        PRINT "< " + sFileName(1) + " > - no file found."
    END IF

    SearchFile% = 0

END FUNCTION


'* ------------------------------------------------------------------------ *'
'*  Display Menu                                                            *'
'* ------------------------------------------------------------------------ *'

SUB DisplayMenu

    PRINT "  Press"
    PRINT "     Esc      - to exit"
    PRINT "     N        - next song       T        - to display title"
    PRINT "     L        - previous song   M        - to change mapper"
    PRINT "     P        - to pause        <- or -> - to transpose"
    PRINT "     R        - to resume         or   - to change tempo"
    PRINT ""
    PRINT ""

END SUB
'* End of file *'
