'' ------------------------------------------------------------------------ ''
''  @@ Source Documentation                     *** BASIC Version ***       ''
''                                                                          ''
''  TITLE : SBKBLST.BAS                                                     ''
''                                                                          ''
''  Description :                                                           ''
''      Use switch /Fs for Microsoft Basic PDS 7.1 compiler.                ''
''      The program retrieves the BLASTER environment variable              ''
''      for the card settings. It does not perform any test on              ''
''      the hardware settings on the card.                                  ''
''                                                                          ''
''  Copyright (c) Creative Technology Ltd, 1993. All rights reserved.       ''
''                                                                          ''
'' ------------------------------------------------------------------------ ''

' Local functions
DECLARE FUNCTION GetSetting% (BLASTER$, pointer%, radix%)
DECLARE SUB DisplaySetting ()

CONST MAXCARD = 6 + 1

REM $DYNAMIC
CLEAR

DIM CardType$(MAXCARD)

CardType$(0) = "- Creative Sound Blaster Series -"
CardType$(1) = "Sound Blaster"
CardType$(2) = "Sound Blaster Pro"
CardType$(3) = "Sound Blaster 2.0"
CardType$(4) = "Sound Blaster Pro 2.0"
CardType$(5) = "Sound Blaster Pro MCV"
CardType$(6) = "Sound Blaster 16"


TYPE CTBLASTER
    cardid        AS INTEGER 'card type
    sbioaddx      AS INTEGER 'i/o address
    sbintr        AS INTEGER 'interrupt
    dma           AS INTEGER 'dma channel
    hdma          AS INTEGER 'high dma channel
    midi          AS INTEGER 'midi port
    mixer         AS INTEGER 'mixer port
    pbioaddx      AS INTEGER 'printer port (used only by Port Blaster)
    pbintr        AS INTEGER 'printer port interrupt
END TYPE

DIM StBlst AS CTBLASTER
DIM StLen  AS INTEGER, StOff AS INTEGER
DIM BLASTER AS STRING, pointer AS INTEGER
DIM BlstLen AS INTEGER, param AS STRING

   ' initializes the BLASTER struct to null
    DEF SEG = VARPTR(StBlst.cardid)
    StLen = LEN(StBlst)

    DEF SEG = VARSEG(StBlst.cardid)
    StOff = VARPTR(StBlst.cardid)
    FOR I% = 0 TO StLen - 1
        ou% = StOff + I%
        POKE ou%, 0
    NEXT I%
    DEF SEG

    ' retrieves the BLASTER setting environment
    BLASTER = ENVIRON$("BLASTER")

    ' get length of the BLASTER environment string
    BlstLen = LEN(BLASTER)
    IF BlstLen <> 0 THEN
        pointer = 1

        WHILE pointer < BlstLen
            param = MID$(BLASTER,pointer,1)
            pointer = pointer + 1

            SELECT CASE param

                CASE "A"  ' Sound Blaster i/o address
                      ' Extracts the value set for each parameter in the
                      ' BLASTER environment
                      StBlst.sbioaddx = GetSetting%(BLASTER, pointer, 16)

                CASE "I"  ' Sound Blaster interrupt
                      StBlst.sbintr = GetSetting%(BLASTER, pointer, 10)

                CASE "D"  ' DMA channel
                      StBlst.dma = GetSetting%(BLASTER, pointer, 10)

                CASE "T"  ' Card type
                      StBlst.cardid = GetSetting%(BLASTER, pointer, 10)

                CASE "M"  ' Mixer port
                      StBlst.mixer = GetSetting(BLASTER, pointer, 16)

                CASE "P"  ' Midi port
                      StBlst.midi = GetSetting(BLASTER, pointer, 16)

                CASE "H"  ' High DMA channel
                      StBlst.hdma = GetSetting(BLASTER, pointer, 10)

                CASE "L"
                      param = MID$(BLASTER, pointer, 1)
                      IF param = "P" THEN
                          pointer = pointer + 1
                          param = MID$(BLASTER, pointer, 1)

                          SELECT CASE param

                              CASE "T"  ' Port Blaster i/o address
                                  pointer = pointer + 2
                                  StBlst.pbioaddx = GetSetting(BLASTER,_
                                                       pointer, 10)

                              CASE "I"  ' Port Blaster interrupt
                                  pointer = pointer + 2
                                  StBlst.pbintr = GetSetting(BLASTER,_
                                                       pointer, 10)

                          END SELECT
                      END IF
            END SELECT
        WEND

        CALL DisplaySetting     ' Displays the BLASTER environment
    ELSE
        PRINT "BLASTER environment not set."
    END IF


'-------------------------------------------------------------------------- '
'   @@ Usage                                                                '
'                                                                           '
'   FUNCTION  GetSetting% (blaster$, pointer%, radix%)                      '
'                                                                           '
'   Description :                                                           '
'       Extracts individual parameter from the BLASTER environment.         '
'                                                                           '
'   Entry :                                                                 '
'       blaster - string contains the BLASTER environment.                  '
'       pointer - offset of the parameter to be retrieved (by reference).   '
'       radix   - specifies the return value in hexadecimal or decimal.     '
'                                                                           '
'   Exit  :                                                                 '
'       param   - the converted parameter.                                  '
'                                                                           '
'-------------------------------------------------------------------------- '

FUNCTION GetSetting% (BLASTER$, pointer%, radix%)

    CONST SPACE = 32  ' space character
    CONST HEXA  = 16  ' hexadecimal value
    CONST DECI  = 10  ' decimal value
    CONST NUM   = 48  ' base ASCII value of the numeric characters (0 - 9)
    CONST UCASE = 65  ' base ASCII value of the UCASE characters (A - F)
    CONST LCASE = 97  ' base ASCII value of the LCASE characters (a - f)

    DIM param AS INTEGER, BlstLen AS INTEGER
    DIM value AS INTEGER, digit AS INTEGER
    DIM NumOfDigit AS INTEGER


    ' length of the BLASTER string
    BlstLen = LEN(BLASTER$)
    IF pointer% > BlstLen THEN
        GetSetting% = 0
        EXIT FUNCTION
    END IF

    NumOfDigit = 0

    ' Determines the number of digit for each value
    DO
        IF ASC(MID$(BLASTER$,pointer%,1)) = SPACE THEN
            EXIT DO
        END IF
        NumOfDigit = NumOfDigit + 1
        pointer% = pointer% + 1
    LOOP until pointer% > BlstLen

    pointer% = pointer% - NumOfDigit
    param = 0
    digit = 0

    FOR N%=1 TO NumOfDigit

        ' Returns the ASCII value of each character
        value = ASC(MID$(BLASTER$, pointer%, 1))

        pointer% = pointer% + 1
        digit = digit + 1

        SELECT CASE value

            CASE NUM TO NUM+9  ' numeric character (0 - 9)
                value = value - NUM
            CASE LCASE TO LCASE+5   ' lower case alphabet (a - f)
                value = value - LCASE + 10
            CASE UCASE TO UCASE+5   ' upper case alphabet (A - F)
                value = value - UCASE + 10
        END SELECT

        ' converts to hexadecimal value
        IF radix% = HEXA THEN
            FOR I% = 1 TO (NumOfDigit - digit)
                value = value * 16
            NEXT I%
            param = param + value

        ' converts to decimal value
        ELSEIF radix% = DECI THEN
            FOR I% = 1 TO (NumOfDigit - digit)
                value = value * 10
            NEXT I%
            param = param + value
        END IF
    NEXT N%

    GetSetting% = param

END FUNCTION


' ------------------------------------------------------------------------- '
'   @@ Usage                                                                '
'                                                                           '
'   SUB DisplaySetting()                                                    '
'                                                                           '
'   Description :                                                           '
'       Displays the BLASTER enviroment accordingly.                        '
'                                                                           '
'   Entry :                                                                 '
'       none                                                                '
'                                                                           '
'   Exit :                                                                  '
'       none                                                                '
'                                                                           '
' ------------------------------------------------------------------------- '

SUB DisplaySetting

    SHARED StBlst AS CTBLASTER
    SHARED CardType$()


    IF StBlst.cardid THEN

        IF (StBlst.cardid < 7) AND (StBlst.cardid > 0) THEN
            PRINT CardType$(StBlst.cardid); " card installed at"
        ELSE
            PRINT "Unknown card installed at"
        END IF

        PRINT TAB(4);"I/O port         : ";HEX$(StBlst.sbioaddx);" Hex"
        PRINT TAB(4);"Interrupt        : ";StBlst.sbintr
        PRINT TAB(4);"DMA channel      : ";StBlst.dma

        IF StBlst.hdma THEN
            PRINT TAB(4);"High DMA channel : ";StBlst.hdma
        END IF

        IF StBlst.midi THEN
            PRINT TAB(4);"Midi port        : ";HEX$(StBlst.midi);" Hex"
        END IF

        IF StBlst.mixer THEN
            PRINT TAB(4);"Mixer port       : ";HEX$(StBlst.mixer);" Hex"
        END IF

    END IF

    IF StBlst.pbioaddx THEN
        PRINT " "
        PRINT "Port Blaster card installed at"
        PRINT TAB(4);"Printer port     :  LPT";StBlst.pbioaddx
        PRINT TAB(4);"Interrupt        : ";StBlst.pbintr
    END IF

END SUB
' End of File
