Announcement

**Tony Burcham** · 30 Jan 2006, 05:10 PM

You can download the zip file from:OpenAlDemo.zip

TheirCorp's SourceForge project includes:
API Helper --- a code generator for the Win32 API
"Flex" --- an editor with novel features
GDI Debug --- catches programming errors that could lead
to resource leaks
TheirEdit --- an editor for PowerBASIC code
TheirSheet --- a spreadsheet
SrcFrmt --- a source code formatter
Tooltipper --- a tooltip code generator

------------------
Tony Burcham
TheirCorp

[This message has been edited by Tony Burcham (edited January 31, 2006).]

**Jim Fritts** · 14 Jun 2020, 12:27 PM

Update to Tony's code:

Code:

'**************************************
'   "OpenALDemo.bas"

'By Tony Burcham
'https://forum.powerbasic.com/forum/user-to-user-discussions/source-code/25481-3d-sound-demo-using-openal#post25481

'Modified by Jim Fritts on 2020 JUN 14
'to work with PBWIN10.4 and J. Roca includes III_107
'To get ALUT.dll   go to here...
'https://www.dll4free.com/alut.dll.html

'Provided Zip contents:
' "Motor.wav"    6.89 KB
' "Horn.wav"     5.35 KB
' ALUT.dll       5.10.2914.0 32bit   5KB   English
' OpenAL32.DLL   6.14.357.24 32bit   106KB English
' OpenAlDemo.bas 27.7 KB
' OpenALDemo.exe 51.5 KB
' Wrap_oal.dll   2.2.0.5     32bit   434KB English

'Thank you Tony and Jose
'
'Tony's Notes:

'! This demo might GPF and crash your computer, especially if run in the
'! debugger!  Save all open files before running this.

'You can get the OpenAL and ALut binaries, SDK and (PDF) manuals from:
'www.openal.org

'OpenAL Archives (about 9MB of messages):
'http://opensource.creative.com/pipermail/openal/

'The OpenAL functions are in two main categories: one with the prefix "al",
'and the other with "alc". They each have their own set of equates too.

'Don't pass a closed device to alcGetError, or it will GPF

'alcOpenDevice GPFs (and crashes the computer) with dynamic and Asciz
'strings, but not with string equates, for some reason.

'To globally disable checking for "al" errors REM-out or delete "%Debug".
'To remove all the error-checking calls for "al" (not "alc") imports, do
'a replace-all of " : alge" with "", then delete the Sub "alge".

'alGetError and alcGetError are called very frequently for your use while
'debugging. This demo doesn't respond to many of the error values it
'retrieves.

'This uses part of "motor_a8.wav" from the OpenAL SDK.

'This used to freeze or GPF when calling alcOpenDevice, but it seems fine now.
'This was using PBEdit's debugger, but that might not have been related.
'It's something to watch out for. It never had a problem after running a demo
'from the OpenAL SDK, for some reason.

'Mono WAV files are preferrable for use with 3D sound, because adding stereo
'effects to sound is what the 3D sound hardware/software is for in the first
'place. Also, stereo WAVs are converted to mono anyway before any effects are
'applied and that means extra large files to load and more processing to do
'to them with no benefit whatsoever.

'It's usually preferrable to use WAVs which are recorded with no natural
'acoustics in them, because they might still be audible after artificial 3D
'effects are added.
' It could be helpful in some cases though, to have some natural acoustics if the
'original acoustics are the kind you need and if they don't need to be changed
'during use, for example.

'   Coordinate system: (from OpenAL specification)
'OpenAL -- like OpenGL -- uses a right-handed Cartesian coordinate system (RHS),
'where in a frontal default view X (thumb) points right, Y (index finger) points
'up, and Z (middle finger) points towards the viewer/camera. To switch from a
'left handed coordinate system (LHS) to a right handed coordinate systems, flip
'the sign on the Z coordinate.

'This code is Public domain by TheirCorp 2006
'**************************************

#COMPILE EXE "OpenALDemo.exe"
#DIM ALL
#REGISTER ALL
'#Debug Error On
'#Tools On

%Debug              = 1
%PrintErrorsToFile  = 1 '(instead of a messagebox)

#INCLUDE "Win32API.inc"
#INCLUDE "Alc.inc"
#INCLUDE "Al.inc"
#INCLUDE "Alut.inc"

GLOBAL alError  AS LONG

'**************************************

'Take your pick... , or let the demo find out what's available.
$WaveDevice =   "Generic Hardware"
'$WaveDevice =   "Generic Software"
'$WaveDevice =   "DirectSound3D"

'WAV files
$WavMotor   = "Motor.wav"
$WavHonk    = "Horn.wav"

%NUM_SOURCES    = 2
%NUM_BUFFERS    = 2
%Buffer_Motor   = 0
%Buffer_Horn    = 1
%Source_Motor   = 0
%Source_Horn    = 1

'This generates a compiler error when some values are out of range
#IF (%NUM_SOURCES = 0) OR (%NUM_BUFFERS = 0)
'! You must have at least one buffer and one source.
'! Set %NUM_SOURCES and %NUM_BUFFERS as needed.
#ENDIF

'**************************************
'   EAX equates

'used by DSPROPERTY_EAXLISTENER_ENVIRONMENT
%EAX_ENVIRONMENT_GENERIC                      = 0
%EAX_ENVIRONMENT_PADDEDCELL                   = 1
%EAX_ENVIRONMENT_ROOM                         = 2
%EAX_ENVIRONMENT_BATHROOM                     = 3
%EAX_ENVIRONMENT_LIVINGROOM                   = 4
%EAX_ENVIRONMENT_STONEROOM                    = 5
%EAX_ENVIRONMENT_AUDITORIUM                   = 6
%EAX_ENVIRONMENT_CONCERTHALL                  = 7
%EAX_ENVIRONMENT_CAVE                         = 8
%EAX_ENVIRONMENT_ARENA                        = 9
%EAX_ENVIRONMENT_HANGAR                       = 10
%EAX_ENVIRONMENT_CARPETEDHALLWAY              = 11
%EAX_ENVIRONMENT_HALLWAY                      = 12
%EAX_ENVIRONMENT_STONECORRIDOR                = 13
%EAX_ENVIRONMENT_ALLEY                        = 14
%EAX_ENVIRONMENT_FOREST                       = 15
%EAX_ENVIRONMENT_CITY                         = 16
%EAX_ENVIRONMENT_MOUNTAINS                    = 17
%EAX_ENVIRONMENT_QUARRY                       = 18
%EAX_ENVIRONMENT_PLAIN                        = 19
%EAX_ENVIRONMENT_PARKINGLOT                   = 20
%EAX_ENVIRONMENT_SEWERPIPE                    = 21
%EAX_ENVIRONMENT_UNDERWATER                   = 22
%EAX_ENVIRONMENT_DRUGGED                      = 23
%EAX_ENVIRONMENT_DIZZY                        = 24
%EAX_ENVIRONMENT_PSYCHOTIC                    = 25
%EAX_ENVIRONMENT_COUNT                        = 26

%DSPROPERTY_EAXLISTENER_NONE                  = 0
%DSPROPERTY_EAXLISTENER_ALLPARAMETERS         = 1
%DSPROPERTY_EAXLISTENER_ROOM                  = 2
%DSPROPERTY_EAXLISTENER_ROOMHF                = 3
%DSPROPERTY_EAXLISTENER_ROOMROLLOFFFACTOR     = 4
%DSPROPERTY_EAXLISTENER_DECAYTIME             = 5
%DSPROPERTY_EAXLISTENER_DECAYHFRATIO          = 6
%DSPROPERTY_EAXLISTENER_REFLECTIONS           = 7
%DSPROPERTY_EAXLISTENER_REFLECTIONSDELAY      = 8
%DSPROPERTY_EAXLISTENER_REVERB                = 9
%DSPROPERTY_EAXLISTENER_REVERBDELAY           = 10
%DSPROPERTY_EAXLISTENER_ENVIRONMENT           = 11
%DSPROPERTY_EAXLISTENER_ENVIRONMENTSIZE       = 12
%DSPROPERTY_EAXLISTENER_ENVIRONMENTDIFFUSION  = 13
%DSPROPERTY_EAXLISTENER_AIRABSORPTIONHF       = 14
%DSPROPERTY_EAXLISTENER_FLAGS                 = 15

%DSPROPERTY_EAXBUFFER_NONE                    = 0
%DSPROPERTY_EAXBUFFER_ALLPARAMETERS           = 1
%DSPROPERTY_EAXBUFFER_DIRECT                  = 2
%DSPROPERTY_EAXBUFFER_DIRECTHF                = 3
%DSPROPERTY_EAXBUFFER_ROOM                    = 4
%DSPROPERTY_EAXBUFFER_ROOMHF                  = 5
%DSPROPERTY_EAXBUFFER_ROOMROLLOFFFACTOR       = 6
%DSPROPERTY_EAXBUFFER_OBSTRUCTION             = 7
%DSPROPERTY_EAXBUFFER_OBSTRUCTIONLFRATIO      = 8
%DSPROPERTY_EAXBUFFER_OCCLUSION               = 9
%DSPROPERTY_EAXBUFFER_OCCLUSIONLFRATIO        = 10
%DSPROPERTY_EAXBUFFER_OCCLUSIONROOMRATIO      = 11
%DSPROPERTY_EAXBUFFER_OUTSIDEVOLUMEHF         = 12
%DSPROPERTY_EAXBUFFER_AIRABSORPTIONFACTOR     = 13
%DSPROPERTY_EAXBUFFER_FLAGS                   = 14
%DSPROPERTY_EAX_BUFFERPROPERTY                = 15

'**************************************
'EAX 2.0 buffer property set {0306A6A7-B224-11d2-99E5-0000E8D8C722}
$DSPROPSETID_EAX20_BufferProperties = GUID$("{0306A6A7-B224-11d2-99E5-0000E8D8C722}")

'Listener properties {0306A6A8-B224-11D2-99E5-0000E8D8C722}
$DSPROPSETID_EAX20_ListenerProperties = GUID$("{0306A6A8-B224-11D2-99E5-0000E8D8C722}")

%DSPROPERTY_EAXLISTENER_IMMEDIATE = &H00000000  'changes take effect immediately
%DSPROPERTY_EAXLISTENER_DEFERRED  = &H80000000  'changes take effect later
%DSPROPERTY_EAXLISTENER_COMMITDEFERREDSETTINGS = %DSPROPERTY_EAXLISTENER_NONE OR %DSPROPERTY_EAXLISTENER_IMMEDIATE

%DSPROPERTY_EAXBUFFER_IMMEDIATE = &H00000000 'changes take effect immediately
%DSPROPERTY_EAXBUFFER_DEFERRED  = &H80000000 'changes take effect later
%DSPROPERTY_EAXBUFFER_COMMITDEFERREDSETTINGS = %DSPROPERTY_EAXBUFFER_NONE OR %DSPROPERTY_EAXBUFFER_IMMEDIATE

'for coordinates, for example
TYPE THREESINGLES DWORD
    x AS SINGLE
    y AS SINGLE
    z AS SINGLE
END TYPE

'for orientation, for example
TYPE SIXSINGLES DWORD
    fx AS SINGLE
    fy AS SINGLE
    fz AS SINGLE
    ux AS SINGLE
    uy AS SINGLE
    uz AS SINGLE
END TYPE

TYPE EAXBUFFERPROPERTIES DWORD
    lDirect               AS LONG   'direct path level
    lDirectHF             AS LONG   'direct path level at high frequencies
    lRoom                 AS LONG   'room effect level
    lRoomHF               AS LONG   'room effect level at high frequencies
    flRoomRolloffFactor   AS SINGLE 'like DS3D flRolloffFactor but for room effect
    lObstruction          AS LONG   'main obstruction control (attenuation at high frequencies)
    flObstructionLFRatio  AS SINGLE 'obstruction low-frequency level re. main control
    lOcclusion            AS LONG   'main occlusion control (attenuation at high frequencies)
    flOcclusionLFRatio    AS SINGLE 'occlusion low-frequency level re. main control
    flOcclusionRoomRatio  AS SINGLE 'occlusion room effect level re. main control
    lOutsideVolumeHF      AS LONG   'outside sound cone level at high frequencies
    flAirAbsorptionFactor AS SINGLE 'multiplies DSPROPERTY_EAXLISTENER_AIRABSORPTIONHF
    dwFlags               AS DWORD  'modifies the behavior of properties
END TYPE


'**************************************

FUNCTION PBMAIN() AS LONG
LOCAL n           AS LONG
LOCAL b           AS BYTE
LOCAL eaxSet      AS DWORD 'pointer to function
LOCAL alcError    AS LONG
LOCAL SingVal     AS SINGLE
LOCAL Buffers()   AS DWORD
LOCAL Contextx    AS DWORD
LOCAL Device      AS DWORD
LOCAL FormatCode  AS LONG  'the WAV format code
LOCAL DataPtr     AS LONG  'pointer to WAV data
LOCAL DataSize    AS LONG  'size of WAV data
LOCAL Frequency   AS LONG  'frequency
LOCAL LoopFlag    AS LONG  'looping
LOCAL Sources()   AS DWORD 'source
LOCAL ThreeSing   AS THREESINGLES
LOCAL SixSing     AS SIXSINGLES
LOCAL EaxBufProp  AS EAXBUFFERPROPERTIES
LOCAL ls          AS STRING
LOCAL ts          AS STRING

'extensions to check for
DATA "al_ext_offset"
DATA "AL_EXT_LINEAR_DISTANCE"
DATA "AL_EXT_EXPONENT_DISTANCE"
DATA "alc_EXT_capTure"
DATA "EAX2.0"

    '--------------------------------------------------
    '   Check for available hardware devices and "software devices"
    '--------------------------------------------------
    'Check for Direct Sound 3D
    'b = 0 : ls = "" : ts = ""      'In case these are altered above
    n = LoadLibrary("DSOUND3D.DLL")
    IF n THEN
        FreeLibrary(n)
        INCR b
        ts = "DirectSound3D"    ' "ts" holds a clean list of the device names, because "ls" needs extra formatting for display
        ls = FORMAT$(b) & ".  " & $DQ & ts & $DQ & $CRLF
        ts = ts & ","
    END IF

    'Enumerate devices using OpenAL
    'If sent NULL instead of a string for &ALC_DEVICE_SPECIFIER, alcGetString returns
    'a list of NULL-terminated device names. The list itself is terminated by two NULLs.
    Device = alcGetString(0, %ALC_DEVICE_SPECIFIER) ' "Device" is being used as a string pointer here, since it's still available
    IF Device THEN

        DO
            INCR b  'b holds the device count
            n = lstrlen(BYVAL Device)
            IF n THEN
                ts = ts & PEEK$(Device, n) & ","
                ls = ls & FORMAT$(b) & ".  " & $DQ & PEEK$(Device, n) & $DQ & $CRLF
            ELSE
                EXIT DO
            END IF

            Device = Device + n + 1

        LOOP WHILE n

    END IF


    ts = TRIM$(ts, ANY ", ")
    IF b > 1 THEN       'Found more than one, so offer a selection
        ls = "Enter the number of the device to use:" & $CRLF & $CRLF & ls
        n = VAL(INPUTBOX$(ls, "The following devices were found:", "1"))
        n = MAX&(MIN&(n, PARSECOUNT(ts)), 1)

    ELSEIF b = 1 THEN   'Found one, so show it, then use it
        MSGBOX "The following device was found: """ & ts & """"
        n = 1

    ELSE                'Nothing found so exit
        MSGBOX "No devices found. Exiting program..."
        EXIT FUNCTION

    END IF

    ls = PARSE$(ts, n)    'Get the selected device's name


    '--------------------------------------------------
    '   Setup the demo
    '--------------------------------------------------
    IF 1 THEN 'This block-IF is to make it easy to skip code in case of errors

        '--------------------------------------------------
        '   Open a device and get a current context
        '--------------------------------------------------

        ' NOTE: In the debugger, alcOpenDevice often GPFs (and crashes the computer) with
        ' dynamic and Asciz strings, but not with equates.
        'Also: alcOpenDevice doesn't like being stepped through in the debugger, so set a
        'breakpoint beyond it and run through it.

        ' Use this when running in the debugger to avoid GPFs
        'Device = alcOpenDevice($WaveDevice)     'Open a device (in debugger)

        ' You can use this when not running in the debugger
        Device = alcOpenDevice(BYVAL STRPTR(ls))     'Open a device (not in the debugger)

        IF Device = 0 THEN
            MSGBOX ls & " was not found. Try another one."
            EXIT FUNCTION
        END IF

        alcError = alcGetError(BYVAL Device)        'Clear any existing error value
        Contextx = alcCreateContext(Device, BYVAL 0) 'Create a context
        alcError = alcGetError(BYVAL Device)

        alcMakeContextCurrent(Contextx)  'Make the created context current
        alcError = alcGetError(BYVAL Device)


        '--------------------------------------------------
        '   Get and display available extensions
        '--------------------------------------------------
        '"alIsExtensionPresent" seems to need a context to be made current, so it was put here.
        ls = $CRLF & _
        "******************************************" & $CRLF & _
        "           Present Extensions:" & $CRLF & _
        "******************************************" & $CRLF & $CRLF
        FOR n = 1 TO DATACOUNT
            b = alIsExtensionPresent(READ$(n))
            ls = ls & IIF$(b = %AL_TRUE, "(YES):  ", "(NO) :  ") & READ$(n) & $CRLF
        NEXT n
        MSGBOX ls
        alge    'clear the current error value


        '--------------------------------------------------
        '   Set listener properties
        '--------------------------------------------------
        ThreeSing.x = 0 : ThreeSing.y = 0 : ThreeSing.z = 0
        alListenerfv(%AL_POSITION, BYVAL VARPTR(ThreeSing)) : alge 'Set listener position
        alListenerfv(%AL_VELOCITY, BYVAL VARPTR(ThreeSing)) : alge 'Set listener velocity

        'Set listener orientation: the direction he/she's facing, then the head's orientation
        SixSing.fx = -1 'Forward x
        SixSing.fy = 0  'Forward y
        SixSing.fz = 0  'Forward z
        SixSing.ux = 0  'Up x
        SixSing.uy = 1  'Up y
        SixSing.uz = 0  'Up z
        alListenerfv(%AL_ORIENTATION, BYVAL VARPTR(SixSing)) : alge


        '--------------------------------------------------
        '   Generate and load buffers with WAV data
        '--------------------------------------------------
        'These are referred to as "names", but that term doesn't seem to fit them very well
        REDIM Sources(%NUM_SOURCES - 1)  'DIM-ension array of source "names"
        REDIM Buffers(%NUM_BUFFERS - 1)  'DIM-ension array of buffer "names"

        alGenBuffers(%NUM_BUFFERS, Buffers(0)) : alge   'Generate the needed number of buffers
        IF alError THEN EXIT IF     'Couldn't create the buffers

        'Load "motor.wav" into buffer 0
        IF LEN(DIR$($WavMotor)) = 0 THEN EXIT IF                                                'Make sure "motor.wav" is present
        alutLoadWAVFile($WavMotor, FormatCode, DataPtr, DataSize, Frequency, LoopFlag)          'Load it into a temporary data buffer
        alBufferData(Buffers(%Buffer_Motor), FormatCode, DataPtr, DataSize, Frequency) : alge   'Load it into the second buffer generated above
        IF alError THEN EXIT IF     'Couldn't buffer the WAV data
        alutUnloadWAV(FormatCode, DataPtr, DataSize, Frequency)                                 'Free the temporary buffer

        'Load "horn.wav" into buffer 1
        IF LEN(DIR$($WavHonk)) = 0 THEN EXIT IF                                                 'Make sure "horn.wav" is present
        alutLoadWAVFile($WavHonk, FormatCode, DataPtr, DataSize, Frequency, LoopFlag)           'Load it into a temporary data buffer
        alBufferData(Buffers(%Buffer_Horn), FormatCode, DataPtr, DataSize, Frequency) : alge    'Load it into the second buffer generated above
        IF alError THEN EXIT IF     'Couldn't buffer the WAV data
        alutUnloadWAV(FormatCode, DataPtr, DataSize, Frequency)                                 'Free the temporary buffer

        '--------------------------------------------------
        '   Generate sources, assign buffers and adjust their initial settings
        '--------------------------------------------------
        alGenSources(%NUM_SOURCES, Sources(%Source_Motor)) : alge   'Generate the needed number of sources
        IF alError THEN EXIT IF     'Couldn't generate the sources

        alSourcei(Sources(%Source_Motor), %AL_BUFFER, CLNG(Buffers(%Buffer_Motor))) : alge  'Assign motor's buffer to a source
        IF alError THEN EXIT IF     'Couldn't assign the buffer
        alSourcei(Sources(%Source_Horn), %AL_BUFFER, CLNG(Buffers(%Buffer_Horn))) : alge    'Assign horn's buffer to the other source
        IF alError THEN EXIT IF     'Couldn't assign the buffer


        'Lower the gain for the "no effects" part of the demo
        alSourcef(Sources(%Source_Motor), %AL_GAIN, 0.3) : alge
        alSourcef(Sources(%Source_Horn), %AL_GAIN, 0.3) : alge


        '--------------------------------------------------
        '   Listen with no effects
        '--------------------------------------------------
        MSGBOX "Here are the two waves played together, with no effects (at half volume)" & $CRLF & $CRLF & _
               "Press ""Okay"" to hear them."
        alSourcePlay Sources(%Source_Motor) : alge  'Play the motor
        alSourcePlay Sources(%Source_Horn) : alge   'Play the horn
        SLEEP 500                                   'Let them finish playing
        alSourceStop Sources(%Source_Motor) : alge  'Stop the motor
        alSourceStop Sources(%Source_Horn) : alge   'Stop the horn

        MSGBOX "That was the two waves played together with no effects applied" & $CRLF & _
               "(at half volume). The longest WAV is about 1/3 second." & $CRLF & $CRLF & _
               "Press ""Okay"" to listen with the effects applied" & $CRLF & _
               "It will last for around 10 seconds (just wait for" & $CRLF & _
               "the next messagebox to appear)." & $CRLF & $CRLF & _
                "The demo simulates a car driving down an alley from" & $CRLF & _
                "your right side and honking as it passes you."


        '--------------------------------------------------
        '   Apply all the effects to the WAV buffers
        '--------------------------------------------------
        'Apply acoustic effects to the motor
        alSourcei(Sources(%Source_Motor), %AL_LOOPING, 1) : alge     'Turn motor's looping on
        alSourcef(Sources(%Source_Motor), %AL_GAIN, 1.0) : alge      'Set the motor's gain to 1.0
        alSourcef(Sources(%Source_Motor), %AL_PITCH, 1.0) : alge     'Set the motor's pitch to 1.0

        'Apply acoustic effects to the horn
        alSourcei(Sources(%Source_Horn), %AL_LOOPING, 0) : alge      'Make sure horn's looping is off
        alSourcef(Sources(%Source_Horn), %AL_GAIN, 1.0) : alge       'Set the horn's gain to 1.0
        alSourcef(Sources(%Source_Horn), %AL_PITCH, 1.0) : alge      'Set the horn's pitch to 1.0

        '--------------------------------------------------
        '   Here are some predefined acoustic environments
        '   try as many as you like...
        '   "Alley" acoustics was chosen for this demo.
        '--------------------------------------------------
        'n = %EAX_ENVIRONMENT_GENERIC
        'n = %EAX_ENVIRONMENT_PADDEDCELL
        'n = %EAX_ENVIRONMENT_ROOM
        'n = %EAX_ENVIRONMENT_BATHROOM
        'n = %EAX_ENVIRONMENT_LIVINGROOM
        'n = %EAX_ENVIRONMENT_STONEROOM
        'n = %EAX_ENVIRONMENT_AUDITORIUM
        'n = %EAX_ENVIRONMENT_CONCERTHALL
        'n = %EAX_ENVIRONMENT_CAVE
        'n = %EAX_ENVIRONMENT_ARENA
        'n = %EAX_ENVIRONMENT_HANGAR
        'n = %EAX_ENVIRONMENT_CARPETEDHALLWAY
        'n = %EAX_ENVIRONMENT_HALLWAY
        'n = %EAX_ENVIRONMENT_STONECORRIDOR
        n = %EAX_ENVIRONMENT_ALLEY
        'n = %EAX_ENVIRONMENT_FOREST
        'n = %EAX_ENVIRONMENT_CITY
        'n = %EAX_ENVIRONMENT_MOUNTAINS
        'n = %EAX_ENVIRONMENT_QUARRY
        'n = %EAX_ENVIRONMENT_PLAIN
        'n = %EAX_ENVIRONMENT_PARKINGLOT
        'n = %EAX_ENVIRONMENT_SEWERPIPE
        'n = %EAX_ENVIRONMENT_UNDERWATER
        'n = %EAX_ENVIRONMENT_DRUGGED
        'n = %EAX_ENVIRONMENT_DIZZY
        'n = %EAX_ENVIRONMENT_PSYCHOTIC
        'n = %EAX_ENVIRONMENT_COUNT


        '--------------------------------------------------
        '   Apply the predefined environment to the listener
        '--------------------------------------------------
        eaxSet = alGetProcAddress("EAXSet") 'Get the address of "EAXSet"
        IF eaxSet THEN                      'If eaxSet is a valid code pointer then go ahead...
            CALL DWORD eaxSet USING CallEaxSet($DSPROPSETID_EAX20_ListenerProperties, %DSPROPERTY_EAXLISTENER_ENVIRONMENT OR %DSPROPERTY_EAXLISTENER_IMMEDIATE, 0, VARPTR(n), 4)
        END IF

        '**************************************************
        '               The main demo
        '**************************************************
        '--------------------------------------------------
        '   This demo simulates a car driving down an alley from
        '   your right side and honking as it passes you.
        '--------------------------------------------------
        n = 0
        FOR SingVal = -50 TO 50 STEP 0.5

            '--------------------------------------------------
            'Add doppler effects (you can exagerate these as much as you want, for added effect)
            ThreeSing.z = -SGN(SingVal) * 10
            ThreeSing.x = 0
            alSourcefv(Sources(%Source_Motor), %AL_VELOCITY, BYVAL VARPTR(ThreeSing)) : alge    'Update motor's velocity
            alSourcefv(Sources(%Source_Horn), %AL_VELOCITY, BYVAL VARPTR(ThreeSing)) : alge     'Update horn's velocity

            '--------------------------------------------------
            'Set positions of sources
            ThreeSing.z = SingVal
            ThreeSing.x = -2
            alSourcefv(Sources(%Source_Motor), %AL_POSITION, BYVAL VARPTR(ThreeSing)) : alge    'Update motor's position
            alSourcefv(Sources(%Source_Horn), %AL_POSITION, BYVAL VARPTR(ThreeSing)) : alge     'Update horn's position

            '--------------------------------------------------
            'Start the car
            IF n = 0 THEN alSourcePlay Sources(%Source_Motor) : n = 1 : alge     'Start the motor on the first loop

            '--------------------------------------------------
            'Honk the horn when about 2.5 meters away, and still approaching
            IF (n < 2) AND (SingVal > -2.5) THEN alSourcePlay Sources(%Source_Horn) : n = 2 : alge

            '--------------------------------------------------
            SLEEP 50    'Don't make it reprocess the WAV data too frequently.

        NEXT SingVal

        '!'**************************************************
        '!'               End of the main demo
        '!'**************************************************

        alSourceStop Sources(%Source_Motor) : alge   'Stop the motor
        alSourceStop Sources(%Source_Horn) : alge    'Stop the horn

        MSGBOX "End of demonstration."

    END IF  'If 1


    '--------------------------------------------------
    '   Clean up
    '--------------------------------------------------
    'A buffer can't be deleted while attached to a source, so replace them with NULL buffers
    alSourcei(Sources(%Source_Motor), %AL_BUFFER, 0) : alge     'Assign a NULL buffer to clear the motor's source
    alSourcei(Sources(%Source_Horn), %AL_BUFFER, 0) : alge      'Assign a NULL buffer to clear the horn's source
    alDeleteBuffers %NUM_BUFFERS, Buffers(0) : alge             'Delete all the buffers

    alDeleteSources %NUM_SOURCES, Sources(%Source_Motor) : alge 'Delete all the sources

    alcError = alcGetError(BYVAL Device)    'Clear existing error value

    Contextx = alcGetCurrentContext()        'Get active context
    alcError = alcGetError(BYVAL Device)

    alcMakeContextCurrent(0)                'Disable the context
    alcError = alcGetError(BYVAL Device)

    Device = alcGetContextsDevice(Contextx)  'Get device for active context
    alcError = alcGetError(BYVAL Device)

    alcDestroyContext Contextx               'Destroy the context
    alcError = alcGetError(BYVAL Device)

    alcCloseDevice(BYVAL Device)            'Close the device

    'NOTE: never pass a closed device to alcGetError, or it will GPF

END FUNCTION

'**************************************

'**************************************
'   Call DWord prototype (this might not work for all calls, as is)
DECLARE FUNCTION CallEaxSet(ListPropGuid AS ASCIZ * 17, BYVAL Param AS LONG, BYREF Value AS DWORD, BYVAL pParam2 AS DWORD, BYVAL szParam2 AS LONG) AS LONG

'   alut.DLL imports
DECLARE SUB alutLoadWAVFile LIB "alut.DLL" ALIAS "alutLoadWAVFile"(WaveFileName AS ASCIZ * %MAX_PATH, BYREF FormatCode AS LONG, BYREF DataBuffer AS LONG, BYREF DataSize AS LONG, BYREF Frequency AS LONG, BYREF LoopFlag AS LONG)
DECLARE SUB alutUnloadWAV LIB "alut.DLL" ALIAS "alutUnloadWAV"(BYVAL FormatCode AS LONG, BYVAL pDataBuffer AS LONG, BYVAL DataSize AS LONG, BYVAL Frequency AS LONG)

'**************************************

SUB alge()  'checks for errors after calls to "al" (not "alc") imports
#IF %DEF(%Debug)

    DIM alError  AS GLOBAL LONG
    STATIC cnt  AS LONG
    LOCAL ls    AS STRING

    INCR cnt
    alError = alGetError()
    SELECT CASE alError
        CASE %AL_INVALID
            ls = "Invalid"
        CASE %AL_INVALID_VALUE
            ls = "Invalid value"
        CASE %AL_INVALID_NAME
            ls = "Invalid name"
        CASE %AL_ILLEGAL_ENUM
            ls = "Illegal enum"
        CASE %AL_INVALID_ENUM
            ls = "Invalid enum"
        CASE %AL_ILLEGAL_COMMAND
            ls = "Illegal command"
        CASE %AL_INVALID_OPERATION
            ls = "Invalid operation"
        CASE %AL_OUT_OF_MEMORY
            ls = "Out of memory"
        CASE %AL_NO_ERROR
            ls = ""
        CASE ELSE 'unknown error
            ls = "(unknown)"
    END SELECT

    IF LEN(ls) THEN
        ls = "Error: " & ls & $CRLF & "...at ""al"" call number: " & FORMAT$(cnt)

#IF %DEF(%PrintErrorsToFile)
        STATIC ff   AS LONG
        IF ff = 0 THEN
            ff = FREEFILE
            OPEN "AlError.Log" FOR OUTPUT AS #ff
            PRINT# ff, "Error log for calls to ""al"" imports."
            PRINT# ff, "Time and Date: " & TIME$ & ", " & DATE$
            PRINT# ff,
        END IF
        PRINT# ff, ls
#ELSE
        MSGBOX ls
#ENDIF

    END IF

#ENDIF
END SUB

**Jim Fritts** · 14 Jun 2020, 12:27 PM

Retracted

**Jim Fritts** · 14 Jun 2020, 10:53 PM

Provided Zip contents:

Code:

 "Motor.wav"    6.89 KB
 "Horn.wav"     5.35 KB
 ALUT.dll       5.10.2914.0 32bit   5KB   English
 OpenAL32.DLL   6.14.357.24 32bit   106KB English
 OpenAlDemo.bas 27.7 KB
 OpenALDemo.exe 51.5 KB
 Wrap_oal.dll   2.2.0.5     32bit   434KB English

OpenALDemo.zip

Thank you Tony and Jose.

Announcement

Forum Guidelines

3D Sound Demo - using OpenAL

3D Sound Demo - using OpenAL

Comment

Comment

Comment

Comment