'' ------------------------------------------------------------------------ ''
''  @@ Source Documentation                     *** BASIC Version ***       ''
''                                                                          ''
''  Copyright (c) Creative Technology Ltd, 1993. All rights reserved.       ''
''                                                                          ''
''  TITLE : MIDIIN.BAS                                                      ''
''                                                                          ''
''  DESCRIPTION :                                                           ''
''      This program demostrates how to use the CTMIDI.DRV driver           ''
''      to input MIDI codes from external MIDI instrunment.                 ''
''                                                                          ''
''      Note that the BLASTER environment has to be set before executing    ''
''      this program.                                                       ''
''                                                                          ''
''  Note :                                                                  ''
''      You need to link with CALLBACK.OBJ(.ASM) in order to run this       ''
''      program.                                                            ''
''      Uses switch /Fs for Microsoft Basic PDS version 7.1 compiler.       ''
''                                                                          ''
'' ------------------------------------------------------------------------ ''

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

DECLARE FUNCTION PrepareCTMIDIDrv%(BlasterAddx AS LONG)
DECLARE SUB SaveFile (lpBuf&)
DECLARE SUB InputMidi ()
DECLARE FUNCTION lpMidiCallBack& () '* this function in file CALLBACK.ASM *'

CONST   MAXxEVENT   = 8192            '* in unit of 4 bytes *'
CONST   TRUE        = 1
CONST   FALSE       = 0

CONST   DRIVERxSIZE = 51200&
CONST   MIDIxSIZE   = (MAXxEVENT * 4&)

REM $DYNAMIC
CLEAR

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

DIM SHARED wMIdiInStatus AS INTEGER     '* MIDI input status *'
DIM SHARED boRecIntoFile AS INTEGER
DIM SHARED sRecFile(1 TO 1) AS STRING
DIM sEnv AS STRING * 64


    PRINT "Input MIDI codes from external MIDI instrument."

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

    '* Get command line argument. *'
    CALL sbkGetCmdLine(NumArgs%,sRecFile(),1)

    '* Load CTMIDI.DRV into memory *'
    IF PrepareCTMIDIDrv%(sbkMakeAsciizString&(sEnv)) <> 0 THEN

        IF NumArgs% < 1 THEN
            boRecIntoFile = FALSE
            PRINT "Usage : MIDIIN [record.raw]"
            PRINT "    Where with [record.raw] specified, MIDI codes will be saved."
        ELSE
            boRecIntoFile = TRUE
            PRINT "Raw MIDI code will be saved into < " + sRecFile(1) + " >"
        END IF

        '* Initialize CTMIDI.DRV driver *'
        IF ctmdInit% = 0 THEN

            '* Get Midi input *'
            CALL InputMidi

            '* Terminate CTMIDI.DRV driver *'
            retVal% = ctmdTerminate%
        END IF
    END IF

'* Return memory *'
Dummy = SETMEM(MIDIxSIZE)
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
        '* Set driver entry point *'
        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                                                                 '
'                                                                           '
'   SUB SaveFile (lpBuf&)                                                   '
'                                                                           '
'   DESCRIPTION:                                                            '
'       Save recorded MIDI codes from memory to file.                       '
'                                                                           '
'   ENTRY:                                                                  '
'       lpBuf - recorded MIDI codes buffer.                                 '
'                                                                           '
'   EXIT:                                                                   '
'       None                                                                '
'                                                                           '
' ------------------------------------------------------------------------- '

SUB SaveFile (lpBuf&)

    DIM iHandle AS INTEGER, dwCodeSize AS LONG
    DIM wCodeOff AS INTEGER, wCodeSeg AS INTEGER


    PRINT "Saving < " + sRecFile(1) + " >..."

    ' Create a file
    iHandle = sbkDosCreate%(sbkMakeAsciizString&(sRecFile(1)))

    IF (iHandle <> -1) THEN

        ' Get the MIDI code block length (4 bytes) from buffer
        wCodeOff = sbkLowWord%(lpBuf&)
        wCodeSeg = sbkHighWord%(lpBuf&)
        DEF SEG = wCodeSeg
            dwCodeSize = PEEK(wCodeOff)
            dwCodeSize = dwCodeSize + INT(PEEK(wCodeOff + 1)) * &H100
            dwCodeSize = dwCodeSize + CLNG(PEEK(wCodeOff + 2)) * &H10000
            dwCodeSize = dwCodeSize + CLNG(PEEK(wCodeOff + 3)) * &H1000000
        DEF SEG

        ' Start of the MIDI codes
        wCodeOff = wCodeOff + 1
        dwCodeSize = dwCodeSize * 4 '* 4 bytes for long *'

        ' Write the buffer
        IF sbkDosWrite%(iHandle,wCodeSeg,wCodeOff,dwCodeSize) = 0 THEN
            PRINT "Error writing < " + sRecFile(1)+ " >"
        END IF

        CALL sbkDosClose(iHandle)
    ELSE
        PRINT "Error creating < " + sRecFile(1)+ " >"
    END IF

END SUB


'* ------------------------------------------------------------------------ *'
'*  @@ Usage                                                                *'
'*                                                                          *'
'*  InputMidi                                                               *'
'*                                                                          *'
'*  DESCRIPTION:                                                            *'
'*      Input Midi code.                                                    *'
'*                                                                          *'
'*  ENTRY:                                                                  *'
'*      none.                                                               *'
'*                                                                          *'
'*  EXIT:                                                                   *'
'*      none.                                                               *'
'*                                                                          *'
'* ------------------------------------------------------------------------ *'

SUB InputMidi

    DIM lpMidiBuffer AS LONG
    DIM wTmp AS INTEGER


    retVal% = ctmdResetMidiDriver%

    '* Set MIDI input status address *'
    IF ctmdSetInputStatusAddx%(wMidiInStatus) <> 0 THEN
        PRINT "Error setting MIDI input status address."
        EXIT SUB
    END IF

    '* Set time stamping mode - default is DIFFERENTIATE_MODE *'
    '* retVal% = ctmdSetTimeStampMode%(ELAPSEDxMODE) *'

    '* Input midi to file *'
    IF boRecIntoFile = TRUE THEN

        '* allocate memory *'
        lpMidiBuffer = sbkMakeDWord&(sbkAllocMem%(INT((MIDIxSIZE + 15) / 16)),0)
        IF lpMidiBuffer = 0 THEN
            PRINT "Error allocating MIDI input buffer."
            EXIT SUB
        END IF

        '* set the first 4 bytes to 0 *'
        wOff% = sbkLowWord%(lpMidiBuffer)
        wSeg% = sbkHighWord%(lpMidiBuffer)
        DEF SEG = wSeg%
            POKE wOff%, 0
            POKE (wOff% + 1), 0
            POKE (wOff% + 2), 0
            POKE (wOff% + 3), 0
        DEF SEG

        '* set input buffer *'
        IF ctmdSetMidiInputBuffer%(lpMidiBuffer,MAXxEVENT) <> 0 THEN
            PRINT "Error setting MIDI input buffer."
            CALL sbkFreeMem(sbkHighWord%(lpMidiBuffer))
            EXIT SUB
        END IF

        PRINT "Number of MIDI events can be stored is"; MAXxEVENT-1
    END IF

    '* set MIDI call back function to print out MIDI code *'
    IF ctmdSetMidiCallBackFunct%(lpMidiCallBack&,UNUSED) = 0 THEN

        '* start MIDI input *'
        IF ctmdStartMidiInput% = 0 THEN

            PRINT "Press [ESC] to stop..."

            '* poll for MIDI input status *'
            WHILE wMidiInStatus <> 0

                '* stop MIDI input *'
                IF INKEY$ = CHR$(27) THEN
                    retVal% = ctmdStopMidiInput%
                END IF
            WEND
            PRINT "Input end."

            '* save into file *'
            IF boRecIntoFile = TRUE THEN
                CALL SaveFile(lpMidiBuffer)
                CALL sbkFreeMem(sbkHighWord%(lpMidiBuffer))
                EXIT SUB
            END IF
        ELSE
            PRINT "Error during MIDI input."
        END IF
    ELSE
        PRINT "Error setting up call back function."
    END IF

    IF boRecIntoFile = TRUE THEN
        CALL sbkFreeMem(sbkHighWord%(lpMidiBuffer))
    END IF

END SUB
'* End of file *'
