Skip to content

Instantly share code, notes, and snippets.

@MarkGoldberg

MarkGoldberg/ctMCI.clw

Created December 7, 2022 16:05
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Embed
What would you like to do?
Learn more about clone URLs
Download ZIP
Clarion Class ctMCI - which wraps mciSendStringA etc.
Raw
ctMCI.clw
MEMBER
INCLUDE('ctMCI.inc'),ONCE
MCIERROR EQUATE(LONG) !not really sure... what this should be
MAP
MODULE('API')
mciSendString (*CSTRING xacCommand, *CSTRING xacReturnStr, UINT xLenReturnStr, HANDLE hWndCallBack),MCIERROR,RAW,PASCAL,PROC,NAME('mciSendStringA') !http://msdn.microsoft.com/en-us/library/ms709492(VS.85).aspx
mciGetErrorSTRING(DWORD xErrorCode , *CSTRING xaErrorText , UINT nLenErrorText ),BOOL ,RAW,PASCAL,PROC,NAME('mciGetErrorStringA') !http://msdn.microsoft.com/en-us/library/ms709479(VS.85).aspx
END
END
eqDBG EQUATE('<4,2,7>')
!=======================================================================
ctMCI.CONSTRUCT PROCEDURE()
CODE
SELF.AliasQ &= NEW qtAliasQ; CLEAR(SELF.AliasQ)
SELF.AutoAlias = 1
SELF.bODS = FALSE
SELF.QLock &= NewCriticalSection()
! SELF.bIsOpen = FALSE
!=======================================================================
ctMCI.DESTRUCT PROCEDURE()
CODE
IF ~(SELF.AliasQ &= NULL)
SELF.AliasQ_Free()
DISPOSE(SELF.AliasQ)
END
SELF.QLock.Kill()
!=======================================================================
ctMCI.AliasQ_Delete PROCEDURE()
CODE
IF ~SELF.AliasQ.bOpenErr
SELF._CloseNow()
END
DELETE(SELF.AliasQ)
!=======================================================================
ctMCI.AliasQ_Free PROCEDURE()
CODE
IF SELF.bODS THEN ASSERT(0,eqDBG&'ctMCI.AliasQ_Free [start]'); SELF.AliasQ_Dump() END
LOOP
GET(SELF.AliasQ, 1)
IF ERRORCODE() THEN BREAK END
SELF.AliasQ_Delete()
END
!=======================================================================
ctMCI.AliasQ_GetErr PROCEDURE(STRING xsAlias) !LONG
CODE
SELF.AliasQ.szAlias = xsAlias
GET(SELF.AliasQ, SELF.AliasQ.szAlias)
RETURN ERRORCODE()
!=======================================================================
ctMCI.AliasQ_Dump PROCEDURE()
!WARNING: does NOT save/restore Q State
QPtr LONG,AUTO
CODE
IF SELF.bODS THEN ASSERT(0,eqDBG&'ctMCI.AliasQ_Dump [start] Records['& RECORDS(SELF.AliasQ) &']') END
SELF.QLock.Wait()
!DBG.DumpQue('ctMCI.AliasQ_Dump',SELF.AliasQ) !DBG no in scope...
LOOP QPtr = 1 TO RECORDS(SELF.AliasQ)
GET(SELF.AliasQ, QPtr) ; IF SELF.bODS THEN ASSERT(0,eqDBG&'QPtr['& QPtr &'] .bOpenErr['& SELF.AliasQ.bOpenErr &'] Fname['& SELF.AliasQ.szFname &'] Alias['& SELF.AliasQ.szAlias &']') END
SELF._Command('status ' & SELF.AliasQ.szAlias & ' mode')
END
SELF.QLock.Release()
!=======================================================================
ctMCI.GetRecords PROCEDURE()!,LONG
CODE
RETURN RECORDS(SELF.AliasQ)
!=======================================================================
ctMCI._Command PROCEDURE(<STRING xsArgs>)!,LONG,PROC
szCMD &CSTRING
szReturnStr CSTRING(256)
RetVal LONG,AUTO
CODE
!szNull =''
szCMD &= NEW CSTRING( SIZE(xsArgs) + 1)
szCMD = CLIP(xsArgs) !adding CLIP as a debugging technique...
RetVal = mciSendString(szCMD, szReturnStr, SIZE(szReturnStr)-1, 0)
IF SELF.bODS THEN ASSERT(0,eqDBG&'mciSendString ['& szReturnStr &'] ['& szCMD &'] Error['& RetVal &']=['& SELF.GetErrorString(RetVal) &']') END
DISPOSE(szCMD)
RETURN RetVal
!=======================================================================
ctMCI._CloseNow PROCEDURE(<STRING xsArgs>)!,LONG,PROC
!assumes SELF.AliasQ is lined up
RetVal LONG,AUTO
CODE
IF SELF.bODS THEN ASSERT(0,eqDBG&'ctMCI_Close .bOpenErr['& SELF.AliasQ.bOpenErr &'] Alias['& SELF.AliasQ.szAlias &']') END
RetVal = SELF._Command('close '& SELF.AliasQ.szAlias & ' ' & xsArgs)
SELF.AliasQ.bOpenErr = -1 !possibly check RetVal first..
PUT(SELF.AliasQ)
RETURN RetVal
!=======================================================================
ctMCI._Close PROCEDURE(STRING xsAlias, <STRING xsArgs>)!,LONG,PROC
RetVal LONG,AUTO
CODE
SELF.QLock.Wait()
RetVal = SELF.AliasQ_GetErr(xsAlias)
IF RetVal
RetVal = -RetVal
ELSE
RetVal = SELF._CloseNow()
END
SELF.QLock.Release()
RETURN RetVal
!=======================================================================
ctMCI._OpenNow PROCEDURE()!,LONG,PROC !assumes SELF.AliasQ is lined up.
CODE
!IF SELF.bODS THEN ASSERT(0,eqDBG&'v ctMCI._OpenNow .bOpenErr['& SELF.AliasQ.bOpenErr &'] FName['& SELF.AliasQ.szFname &']') END
IF SELF.AliasQ.bOpenErr
!SELF.AliasQ.bOpenErr = CHOOSE( SELF._Command('open '& SELF.AliasQ.szFname & ' alias '& SELF.AliasQ.szAlias &' wait') = 0 )
!do I need to use Short File Names?
SELF.AliasQ.bOpenErr = SELF._Command('open "'& SELF.AliasQ.szFname & '" alias '& SELF.AliasQ.szAlias &' wait')
PUT(SELF.AliasQ)
END
!IF SELF.bODS THEN ASSERT(0,eqDBG&'^ ctMCI._OpenNow .bOpenErr['& SELF.AliasQ.bOpenErr &'] FName['& SELF.AliasQ.szFname &']') END
RETURN SELF.AliasQ.bOpenErr
!=======================================================================
ctMCI._Open PROCEDURE(STRING xsFile, <STRING xsAlias>)!,LONG,PROC
PARAM::xsAlias EQUATE(3)
RecExists LONG !no Auto
RetVal LONG,AUTO
CODE
SELF.QLock.Wait()
IF OMITTED(PARAM::xsAlias)
!SELF.AutoAlias += 1
!SELF.AliasQ.szAlias = 'AutoAlias['& SELF.AutoAlias &']'
SELF.AliasQ.szFname = CLIP(xsFile)
GET(SELF.AliasQ, SELF.AliasQ.szFname)
IF ERRORCODE()
SELF.AliasQ.szAlias = 'TSI_' & CLIP(xsFile)
ELSE RecExists=TRUE
END
ELSIF SELF.AliasQ_GetErr(xsAlias)
SELF.AliasQ.szAlias = CLIP(xsAlias)
ELSE RecExists=TRUE
END
IF ~RecExists
SELF.AliasQ.szFname = CLIP(xsFile)
SELF.AliasQ.bOpenErr = -1
ADD(SELF.AliasQ, SELF.AliasQ.szAlias)
END
RetVal = SELF._OpenNow()
SELF.QLock.Release()
RETURN RetVal
!=======================================================================
ctMCI.StopLastPlayed PROCEDURE()
CODE
IF SELF.szLastPlayed
!status: http://msdn.microsoft.com/en-us/library/ms713277(VS.85).aspx
SELF._Command('status ' & SELF.szLastPlayed & ' mode')
!SELF._Command('status ' & SELF.szLastPlayed & ' file completion')
SELF._Command('status ' & SELF.szLastPlayed & ' position')
SELF._Command('status ' & SELF.szLastPlayed & ' length')
!SELF._Command('status ' & SELF.szLastPlayed & ' start position')
IF SELF._Command('stop '& SELF.szLastPlayed ) !&' wait')
!there was an error
IF SELF._Close( SELF.szLastPlayed,'wait') > 0 !<-- moves the AliasQ
!AliasQ Record Found, but there was an Error
SELF.AliasQ.bOpenErr = -1 !likely redundant, but clear
SELF._OpenNow() !will do a PUT(SELF.AliasQ) as .bOpenErr <> 0
END
END
END
SELF.szLastPlayed = ''
!=======================================================================
ctMCI.Play PROCEDURE(STRING xsAlias, <STRING xsArgs>)!,LONG,PROC
!Problems: Threading,
!Problems: .wav don't seem to support ' repeat'
RetVal LONG(-1)
RetValLast LONG,AUTO
CODE
IF SELF.bODS THEN ASSERT(0,eqDBG&'vvvv ctMCI.Play [start] xsAlias['& xsAlias &'] xsArgs['& xsArgs &']') END
SELF.QLock.Wait()
IF SELF.bODS THEN ASSERT(0,eqDBG&'vvvv ctMCI.Play [start] xsAlias['& xsAlias &'] xsArgs['& xsArgs &']') END
SELF.StopLastPlayed()
RetVal = SELF.AliasQ_GetErr(xsAlias)
IF RetVal
RetVal = -RetVal
ELSE
IF SELF.bODS THEN ASSERT(0,eqDBG&'ctMCI.Play -{42}') END
SELF._Command('status '& SELF.AliasQ.szAlias & ' mode')
! SELF._Command('status '& SELF.AliasQ.szAlias & ' start position')
! SELF._Command('status '& SELF.AliasQ.szAlias & ' time format')
! RetVal = SELF._Command('play ' & SELF.AliasQ.szAlias & ' from 0 ' & xsArgs) !fails when xsArgs = 'repeat'
RetVal = SELF._Command('seek ' & SELF.AliasQ.szAlias & ' to 0')
RetVal = SELF._Command('play ' & SELF.AliasQ.szAlias & ' ' & xsArgs)
IF RetVal
SELF.AliasQ.bOpenErr = -1
SELF._OpenNow()
RetVal = SELF._Command('play ' & SELF.AliasQ.szAlias & xsArgs)
END
SELF._Command('status '& SELF.AliasQ.szAlias & ' mode')
SELF.szLastPlayed = SELF.AliasQ.szAlias
END
IF SELF.bODS THEN ASSERT(0,eqDBG&'^^^^ ctMCI.Play [end] xsAlias['& xsAlias &'] xsArgs['& xsArgs &'] Returning['& RetVal &']') END
SELF.QLock.Release()
RETURN RetVal
!=======================================================================
ctMCI.PlayAdd PROCEDURE(STRING xsFile, <STRING xsAlias>, <STRING xsPlayArgs>)
CODE
!the methods called get their own CS, is this a good idea?
SELF._Open(xsFile, xsAlias )
SELF.Play( xsAlias, xsPlayArgs)
!=======================================================================
ctMCI.PlayOnce PROCEDURE(STRING xsFile, <STRING xsAlias>, <STRING xsPlayArgs>)
CODE
SELF.PlayAdd(xsFile, xsAlias, xsPlayArgs) !the methods called get their own CS, is this a good idea?
SELF.QLock.Wait()
IF INSTRING('wait', xsPlayArgs,1,1)
SELF.AliasQ_Delete()
!ELSE cleanup sometime later...
END
SELF.QLock.Release()
!=======================================================================
ctMCI.GetErrorString PROCEDURE(DWORD xErrorCode) !,STRING
!http://msdn.microsoft.com/en-us/library/ms709479(VS.85).aspx
szRetVal CSTRING(129) !documented maximum 128 (so should I use 128 or 129?)
CODE
IF ~mciGetErrorString(xErrorCode, szRetVal, SIZE(szRetVal))
szRetVal = 'Unknown Code['& xErrorCode &']'
END
RETURN szRetVal
!hmmm:
! errstr = Space(128)
! retval = mciGetErrorSTRING(errcode, errstr, Len(errstr))
! !From MMSystem.H
! #define MCIERR_BASE 256
!
! #define MCIERR_INVALID_DEVICE_ID (MCIERR_BASE + 1) ! 256
! #define MCIERR_UNRECOGNIZED_KEYWORD (MCIERR_BASE + 3) ! 259
! #define MCIERR_UNRECOGNIZED_COMMAND (MCIERR_BASE + 5) ! 261
! #define MCIERR_HARDWARE (MCIERR_BASE + 6) ! 262
! #define MCIERR_INVALID_DEVICE_NAME (MCIERR_BASE + 7) ! 263 !<------
! #define MCIERR_OUT_OF_MEMORY (MCIERR_BASE + 8) ! 264
! #define MCIERR_DEVICE_OPEN (MCIERR_BASE + 9) ! 265
! #define MCIERR_CANNOT_LOAD_DRIVER (MCIERR_BASE + 10) ! 266
! #define MCIERR_MISSING_COMMAND_STRING (MCIERR_BASE + 11) ! 267
! #define MCIERR_PARAM_OVERFLOW (MCIERR_BASE + 12) ! 268
! #define MCIERR_MISSING_STRING_ARGUMENT (MCIERR_BASE + 13) ! 269
! #define MCIERR_BAD_INTEGER (MCIERR_BASE + 14) ! 270
! #define MCIERR_PARSER_INTERNAL (MCIERR_BASE + 15) ! 271
! #define MCIERR_DRIVER_INTERNAL (MCIERR_BASE + 16) ! 272
! #define MCIERR_MISSING_PARAMETER (MCIERR_BASE + 17) ! 273
! #define MCIERR_UNSUPPORTED_FUNCTION (MCIERR_BASE + 18) ! 274
! #define MCIERR_FILE_NOT_FOUND (MCIERR_BASE + 19) ! 275
! #define MCIERR_DEVICE_NOT_READY (MCIERR_BASE + 20) ! 276
! #define MCIERR_INTERNAL (MCIERR_BASE + 21) ! 277
! #define MCIERR_DRIVER (MCIERR_BASE + 22) ! 278
! #define MCIERR_CANNOT_USE_ALL (MCIERR_BASE + 23) ! 279
! #define MCIERR_MULTIPLE (MCIERR_BASE + 24) ! 280
! #define MCIERR_EXTENSION_NOT_FOUND (MCIERR_BASE + 25) ! 281
! #define MCIERR_OUTOFRANGE (MCIERR_BASE + 26) ! 282
! #define MCIERR_FLAGS_NOT_COMPATIBLE (MCIERR_BASE + 28) ! 284
! #define MCIERR_FILE_NOT_SAVED (MCIERR_BASE + 30) ! 286
! #define MCIERR_DEVICE_TYPE_REQUIRED (MCIERR_BASE + 31) ! 287
! #define MCIERR_DEVICE_LOCKED (MCIERR_BASE + 32) ! 288
! #define MCIERR_DUPLICATE_ALIAS (MCIERR_BASE + 33) ! 289 <=======
! #define MCIERR_BAD_CONSTANT (MCIERR_BASE + 34) ! 290
! #define MCIERR_MUST_USE_SHAREABLE (MCIERR_BASE + 35) ! 291
! #define MCIERR_MISSING_DEVICE_NAME (MCIERR_BASE + 36) ! 292
! #define MCIERR_BAD_TIME_FORMAT (MCIERR_BASE + 37) ! 293
! #define MCIERR_NO_CLOSING_QUOTE (MCIERR_BASE + 38) ! 294
! #define MCIERR_DUPLICATE_FLAGS (MCIERR_BASE + 39) ! 295
! #define MCIERR_INVALID_FILE (MCIERR_BASE + 40) ! 296
! #define MCIERR_NULL_PARAMETER_BLOCK (MCIERR_BASE + 41) ! 297
! #define MCIERR_UNNAMED_RESOURCE (MCIERR_BASE + 42) ! 298
! #define MCIERR_NEW_REQUIRES_ALIAS (MCIERR_BASE + 43) ! 299
! #define MCIERR_NOTIFY_ON_AUTO_OPEN (MCIERR_BASE + 44) ! 300
! #define MCIERR_NO_ELEMENT_ALLOWED (MCIERR_BASE + 45) ! 301
! #define MCIERR_NONAPPLICABLE_FUNCTION (MCIERR_BASE + 46) ! 302
! #define MCIERR_ILLEGAL_FOR_AUTO_OPEN (MCIERR_BASE + 47) ! 303
! #define MCIERR_FILENAME_REQUIRED (MCIERR_BASE + 48) ! 304
! #define MCIERR_EXTRA_CHARACTERS (MCIERR_BASE + 49) ! 305
! #define MCIERR_DEVICE_NOT_INSTALLED (MCIERR_BASE + 50) ! 306
! #define MCIERR_GET_CD (MCIERR_BASE + 51) ! 307
! #define MCIERR_SET_CD (MCIERR_BASE + 52) ! 308
! #define MCIERR_SET_DRIVE (MCIERR_BASE + 53) ! 309
! #define MCIERR_DEVICE_LENGTH (MCIERR_BASE + 54) ! 310
! #define MCIERR_DEVICE_ORD_LENGTH (MCIERR_BASE + 55) !
! #define MCIERR_NO_INTEGER (MCIERR_BASE + 56) !
! !
! #define MCIERR_WAVE_OUTPUTSINUSE (MCIERR_BASE + 64) !
! #define MCIERR_WAVE_SETOUTPUTINUSE (MCIERR_BASE + 65) !
! #define MCIERR_WAVE_INPUTSINUSE (MCIERR_BASE + 66) !
! #define MCIERR_WAVE_SETINPUTINUSE (MCIERR_BASE + 67) !
! #define MCIERR_WAVE_OUTPUTUNSPECIFIED (MCIERR_BASE + 68) !
! #define MCIERR_WAVE_INPUTUNSPECIFIED (MCIERR_BASE + 69) !
! #define MCIERR_WAVE_OUTPUTSUNSUITABLE (MCIERR_BASE + 70) !
! #define MCIERR_WAVE_SETOUTPUTUNSUITABLE (MCIERR_BASE + 71) !
! #define MCIERR_WAVE_INPUTSUNSUITABLE (MCIERR_BASE + 72) !
! #define MCIERR_WAVE_SETINPUTUNSUITABLE (MCIERR_BASE + 73) !
! !
! #define MCIERR_SEQ_DIV_INCOMPATIBLE (MCIERR_BASE + 80) !
! #define MCIERR_SEQ_PORT_INUSE (MCIERR_BASE + 81) !
! #define MCIERR_SEQ_PORT_NONEXISTENT (MCIERR_BASE + 82) !
! #define MCIERR_SEQ_PORT_MAPNODEVICE (MCIERR_BASE + 83) !
! #define MCIERR_SEQ_PORT_MISCERROR (MCIERR_BASE + 84) !
! #define MCIERR_SEQ_TIMER (MCIERR_BASE + 85) !
! #define MCIERR_SEQ_PORTUNSPECIFIED (MCIERR_BASE + 86) !
! #define MCIERR_SEQ_NOMIDIPRESENT (MCIERR_BASE + 87) !
! !
! #define MCIERR_NO_WINDOW (MCIERR_BASE + 90) !
! #define MCIERR_CREATEWINDOW (MCIERR_BASE + 91) !
! #define MCIERR_FILE_READ (MCIERR_BASE + 92) !
! #define MCIERR_FILE_WRITE (MCIERR_BASE + 93) !
! !
! #define MCIERR_NO_IDENTITY (MCIERR_BASE + 94) !
Raw
ctMCI.inc
!-Rely On Once due to IDE Navigation Bugs-! OMIT('_EndOfInclude_',_IFDEF_ctMCI_)
!-Rely On Once due to IDE Navigation Bugs-!_IFDEF_ctMCI_ EQUATE(1)
!!===================================================================!!
!! Documentation
!! Created : January 19th, 2009 By Mark Goldberg
!! Clarion@MonolithCC.com
!! Purpose : Play MultiMedia files (created for .WMA support)
!! Notes :
!! Limitations:
!! TestBed : c:\cla\_mg\test\PlayWMA
!!
!! Example...
!! Response = MG_mciSendSTRING('open '& CLIP(xFileName) & ' alias myFile wait ') !, NULL, 0, 0) ! //load audio and (in short) name it 'myFile' !type mpegvideo
!! Response = MG_mciSendSTRING('play myFile wait' ) !, NULL, 0, 0) ! //play audio
!! Response = MG_mciSendSTRING('close myFile' ) !, NULL, 0, 0) ! //close all
!!
!! References: http://www.apitalk.com/document.php?id=1184208002_1
!! References: http://msdn.microsoft.com/en-us/library/ms712776(VS.85).aspx
!!
!! Updates :
!-----------------------------------------------------------------
!http://www.surrealization.com/blog/mcisendstring/
!-----------------------------------------------------------------
!For playing .wav files I've always pinvoked to sndPlaySoundA in the winmm.dll,
!and I just found today the function MCISendString that lets you play basically any MCI device
!(multimedia command interface).
!
!MSDN documentation here.
!Much more "cool" than sndPlaySoundA, however I've noticed threading problems
!when you start and stop playing sounds in different threads,
!it seems like if you stop on a different thread than the one you started, it can't find the device you opened.
!Possibly they store something in thread local storage about the device,
!so if you're going to use it with threading,
!either do it from the UI thread always or dedicate a thread to sending the commands
!-----------------------------------------------------------------
!Oct/10/11 - Set all methods to ,PRIVATE that are not used by B4 (this is likely to be a bit of overkill)
!!===================================================================!!
INCLUDE('winequ.clw'),ONCE
INCLUDE ('CWSYNCHM.INC'),ONCE
qtAliasQ QUEUE,TYPE
bOpenErr LONG
szFname CSTRING(260)
szAlias CSTRING(260)
END
ctMCI CLASS,TYPE,MODULE('ctMCI.CLW'),LINK('ctMCI.CLW')
QLock &ICriticalSection,PRIVATE
AliasQ &qtAliasQ,PRIVATE
AutoAlias LONG,PRIVATE
szLastPlayed CSTRING(260),PRIVATE
bODS LONG
!-----------------------------------
CONSTRUCT PROCEDURE
DESTRUCT PROCEDURE
Play PROCEDURE(STRING xsAlias, <STRING xsArgs>),LONG,PROC
PlayAdd PROCEDURE(STRING xsFile, <STRING xsAlias>, <STRING xsPlayArgs>)
PlayOnce PROCEDURE(STRING xsFile, <STRING xsAlias>, <STRING xsPlayArgs>)
_Open PROCEDURE(STRING xsFile, <STRING xsAlias>),LONG,PROC
_Close PROCEDURE(STRING xsAlias, <STRING xsArgs>),LONG,PROC
AliasQ_Dump PROCEDURE()
GetRecords PROCEDURE(),LONG
AliasQ_Delete PROCEDURE(),PRIVATE
AliasQ_Free PROCEDURE(),PRIVATE
AliasQ_GetErr PROCEDURE(STRING xsAlias),LONG,PRIVATE
_Command PROCEDURE(<STRING xsArgs>),LONG,PROC,PRIVATE
_CloseNow PROCEDURE( <STRING xsArgs>),LONG,PROC,PRIVATE
_OpenNow PROCEDURE( ),LONG,PROC,PRIVATE
GetErrorString PROCEDURE(DWORD xErrorCode),STRING,PRIVATE
StopLastPlayed PROCEDURE(),PRIVATE
END
!end-OMIT('_EndOfInclude_',_IFDEF_ctMCI_)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment