This is an example of using Odyce to extend eTcl so it can plays multiumedia files (WAV, MP3, ...).
package require odyce
package require critcl
# DLLs can be imported for all Odyce handles
# ::odyce::odyce dllimport winmm.dll
::odyce::odyce dllimport user32.dll
::odyce::odyce dllimport winmm
# PlaySound() is in winmm.dll on Win32 systems
# critcl::clibraries winmm
# And in coredll.dll on WinCE. Since coredll is
# automatically imported at startup, no need to
# load library explicitely
# Odyce doesn't embed all Win32 headers. Either provide
# your own winmm.h, or define here required symbols
critcl::ccode {
#include <windows.h>
#include <winuser.h>
/* Support both UNICODE and ANSI versions */
extern BOOL PlaySoundA(LPCSTR pszSound, HMODULE hmod, DWORD fdwSound);
extern BOOL PlaySoundW(LPCWSTR pszSound, HMODULE hmod, DWORD fdwSound);
#define SND_SYNC 0
#define SND_ASYNC 1
#define SND_NODEFAULT 2
#define SND_MEMORY 4
#define SND_LOOP 8
#define SND_NOSTOP 16
#define SND_NOWAIT 0x2000
#define SND_ALIAS 0x10000
#define SND_ALIAS_ID 0x110000
#define SND_FILENAME 0x20000
#define SND_RESOURCE 0x40004
#define SND_PURGE 0x40
#define SND_APPLICATION 0x80
#define SND_ALIAS_START 0x00
#define MCI_OPEN 0x803
#define MCI_CLOSE 0x804
#define MCI_ESCAPE 0x805
#define MCI_PLAY 0x806
#define MCI_SEEK 0x807
#define MCI_STOP 0x808
#define MCI_PAUSE 0x809
#define MCI_NOTIFY 1
#define MCI_WAIT 2
#define MCI_FROM 4
#define MCI_TO 8
#define MCI_OPEN_SHAREABLE 256
#define MCI_OPEN_ELEMENT 512
#define MCI_OPEN_TYPE_ID 0x1000
#define MCI_OPEN_TYPE 0x2000
typedef DWORD MCIERROR;
typedef UINT MCIDEVICEID;
#define MCI_ALL_DEVICE_ID ((MCIDEVICEID)-1)
typedef struct tagMCI_OPEN_PARMSA {
DWORD dwCallback;
MCIDEVICEID wDeviceID;
LPCSTR lpstrDeviceType;
LPCSTR lpstrElementName;
LPCSTR lpstrAlias;
} MCI_OPEN_PARMSA,*PMCI_OPEN_PARMSA,*LPMCI_OPEN_PARMSA;
typedef struct tagMCI_OPEN_PARMSW {
DWORD dwCallback;
MCIDEVICEID wDeviceID;
LPCWSTR lpstrDeviceType;
LPCWSTR lpstrElementName;
LPCWSTR lpstrAlias;
} MCI_OPEN_PARMSW,*PMCI_OPEN_PARMSW,*LPMCI_OPEN_PARMSW;
typedef struct tagMCI_PLAY_PARMS {
DWORD dwCallback;
DWORD dwFrom;
DWORD dwTo;
} MCI_PLAY_PARMS,*PMCI_PLAY_PARMS,*LPMCI_PLAY_PARMS;
/* Prototypes for functions */
MCIERROR mciSendCommand(
MCIDEVICEID IDDevice,
UINT uMsg,
DWORD fdwCommand,
DWORD_PTR dwParam
);
BOOL WINAPI mciGetErrorStringA(MCIERROR,LPSTR,UINT);
#define MCI_SETAUDIO 0x0873
#define MCI_DGV_SETAUDIO_VOLUME 0x4002
#define MCI_DGV_SETAUDIO_ITEM 0x00800000
#define MCI_DGV_SETAUDIO_VALUE 0x01000000
#define MCI_DGV_STATUS_VOLUME 0x4019
}
if {0} {
# NOT YET IMPLEMENTED
# http://msdn2.microsoft.com/en-us/library/ms711484.aspx
# http://msdn2.microsoft.com/en-us/library/ms711491.aspx
# Set volume, range range 0 - 1000
critcl::ccode {
typedef struct tagMCI_DGV_SETAUDIO_PARMS {
DWORD dwCallback;
DWORD dwItem;
DWORD dwValue;
DWORD dwOver;
PChar lpstrAlgorithm;
PChar lpstrQuality;
} MCI_DGV_SETAUDIO_PARMS,*PMCI_DGV_SETAUDIO_PARMS,*LPMCI_DGV_SETAUDIO_PARMS;
typedef struct tagMCI_STATUS_PARMS {
DWORD dwCallback;
DWORD dwReturn;
DWORD dwItem;
DWORD dwTrack;
} MCI_STATUS_PARMS,*PMCI_STATUS_PARMS,*LPMCI_STATUS_PARMS;
}
critcl::cproc setvolume {int volume} void {
/* TMediaPlayer MP; */
MCI_DGV_SETAUDIO_PARMS p;
p.dwCallback = 0;
p.dwItem = MCI_DGV_SETAUDIO_VOLUME;
p.dwValue = Volume;
p.dwOver = 0;
p.lpstrAlgorithm = nil;
p.lpstrQuality = nil;
mciSendCommand(0 /*MP.DeviceID*/, MCI_SETAUDIO, MCI_DGV_SETAUDIO_VALUE | MCI_DGV_SETAUDIO_ITEM, &p);
}
# Get volume, range range 0 - 1000
critcl::cproc getvolume {} int {
/* TMediaPlayer MP; */
MCI_STATUS_PARMS p;
p.dwCallback = 0;
p.dwItem = MCI_DGV_STATUS_VOLUME;
mciSendCommand(0 /*MP.DeviceID*/, MCI_STATUS, MCI_STATUS_ITEM, &p);
return p.dwReturn;
}
}
# Either define a simple play function using cproc
# See
# http://msdn2.microsoft.com/en-us/library/ms712864.aspx
critcl::cproc playsimple {char* name} void {
MCI_OPEN_PARMSA openParms;
MCI_PLAY_PARMS pp;
MCIDEVICEID pDevice;
int mcicode;
openParms.dwCallback = NULL;
openParms.lpstrElementName = name;
/* Open command */
mcicode=-1;
if (mcicode!=0) {
openParms.lpstrDeviceType = (char*) "waveaudio";
mcicode=mciSendCommandA(0, MCI_OPEN,
MCI_OPEN_TYPE|MCI_OPEN_ELEMENT,
(DWORD) (LPVOID) &openParms);
}
if (mcicode!=0) {
/* Retry with different device type */
openParms.lpstrDeviceType = (char*) "MPEGVideo";
mcicode=mciSendCommandA(0, MCI_OPEN,
MCI_OPEN_TYPE|MCI_OPEN_ELEMENT,
(DWORD) (LPVOID) &openParms);
}
if (mcicode!=0) {
// mciGetErrorStringA(mcicode, szErr, 128);
MessageBoxA(NULL,name,"MCI error",
MB_ICONSTOP|MB_OK|MB_TASKMODAL|MB_SETFOREGROUND);
return;
}
pDevice = openParms.wDeviceID;
/* Play command */
pp.dwCallback = NULL;
pp.dwFrom = 0;
mciSendCommandA(pDevice, MCI_PLAY, MCI_NOTIFY|MCI_FROM, (DWORD) &pp);
return;
if (name==NULL || name[0]==0) {
PlaySoundA(NULL,NULL,SND_SYNC);
} else {
PlaySoundA(name,NULL,
SND_LOOP|SND_ASYNC|SND_NODEFAULT|SND_FILENAME);
}
return;
}
# A more complete implementation
critcl::ccommand play {dummy interp objc objv} {
int i;
int rc;
DWORD sndopts;
Tcl_DString ds;
Tcl_Obj *filenameObj;
CONST char *filename;
CONST char *nativename;
int filenameLength;
int subindex;
int optsync;
int optloop;
int optstop;
int optwait;
int optcomplain;
static CONST char *playswitches[] = {
"-sync","-loop",
"-nostop","-nowait",
"-nocomplain",
(char *) NULL
};
enum playopts {
SUBCMD_PLAY_SYNC,SUBCMD_PLAY_LOOP,
SUBCMD_PLAY_NOSTOP,SUBCMD_PLAY_NOWAIT,
SUBCMD_PLAY_NOCOMPLAIN
};
/* Default options for playing sound */
optsync=0;
optloop=0;
optstop=1;
optwait=-1;
/* Default generic options */
optcomplain=1;
/* For debugging, stdout and stderr are redirected to console */
fprintf(stderr,"Test PlaySound() nbargs=%d\n",objc);
if (objc<=1) {
/* Stop any sound playing */
filename=NULL;
} else {
for (i=1;i<objc-1;i++) {
if (Tcl_GetIndexFromObj(interp, objv[i], playswitches,
"option", 0, &subindex)!= TCL_OK) {
return TCL_ERROR;
}
if (subindex==(int) SUBCMD_PLAY_SYNC) {
optsync=1;
} else if (subindex==(int) SUBCMD_PLAY_LOOP) {
optloop=1;
} else if (subindex==(int) SUBCMD_PLAY_NOSTOP) {
optstop=0;
} else if (subindex==(int) SUBCMD_PLAY_NOWAIT) {
optwait=0;
} else if (subindex==(int) SUBCMD_PLAY_NOCOMPLAIN) {
optcomplain=0;
}
}
if (optsync && optloop) {
Tcl_AppendResult(interp,"using -sync and -loop would enter infinite loop", (char *) NULL);
return TCL_ERROR;
}
/* filenameObj=Tcl_FSGetNormalizedPath(interp, objv[objc-1]); */
filenameObj=objv[objc-1];
filename = Tcl_GetStringFromObj(filenameObj, &filenameLength);
printf("Playoung sound file %s\n",filename);
}
if (optwait<0) {
if (optsync) {
optwait=1;
} else {
optwait=1;
}
}
sndopts=SND_NODEFAULT|SND_FILENAME;
if (optsync) {
sndopts |= SND_SYNC;
} else {
sndopts |= SND_ASYNC;
}
if (!optwait) {
sndopts |= SND_NOWAIT;
}
if (optloop) {
sndopts |= SND_LOOP;
}
if (!optstop) {
sndopts |= SND_NOSTOP;
}
Tcl_ResetResult(interp);
rc=TCL_OK;
if (filename==NULL || filename[0]==0 ||
(filename[0]=='-' && filename[1]==0)) {
PlaySoundW(NULL,NULL,sndopts);
} else {
nativename = Tcl_WinUtfToTChar(filename, -1, &ds);
if (!PlaySoundW(nativename,NULL,sndopts)) {
if (optcomplain) {
rc=TCL_ERROR;
Tcl_AppendResult(interp,"can't play sound", (char *) NULL);
}
}
Tcl_DStringFree(&ds);
}
return rc;
}
# This is a Win32/WinCE demo. Tk should be always available,
# let's use it.
package require Tk
# Fit toplevel to screen on Windows Mobile
if {[llength [info command ::etcl::automanage]]>0} {
::etcl::automanage .
}
if {[catch {set os [set ::tcl_platform(os)]}]} {
set os "unknown"
}
# A menu is always recommended on PocketPC and Smartphone
# Force menu theme on PocketPC
set menuargs [list]
lappend menuargs -tearoff 0
if {[string match "Windows CE" $os]} {
lappend menuargs -borderwidth 0
lappend menuargs -background "white"
lappend menuargs -foreground "black"
lappend menuargs -activebackground "#000080"
lappend menuargs -activeforeground "white"
lappend menuargs -relief flat
}
# Default menu options on X11 are just ugly...
if {![string compare "x11" [tk windowingsystem]]} {
lappend menuargs -borderwidth 1
lappend menuargs -relief raised
lappend menuargs -activeborderwidth 1
lappend menuargs -activeforeground "\#000000"
lappend menuargs -activebackground "\#e0e0e0"
# lappend menuargs -font $S(font)
}
set mb [eval [list menu .mb] $menuargs]
set m [eval [list menu $mb.file] $menuargs]
$m add command -label "Exit" -command {destroy .}
$mb add cascade -label "File" \
-menu $m -underline 0
. configure -menu $mb
# Display console if it exists
# catch {console show}
update
puts "Odyce [package present critcl]"
puts "Critcl [package present critcl]"
# Play standard WAV using PlaySound()
after 1000 [list play -loop "tada.wav"]
# And cancel play after 5s
after 5000 [list play -]
# Play any multimedia file (MP3, ...) using MCI
# playsimple [file nativename [file normalize test.mp3]]
Category Example | Category Critcl | Category Multimedia | Category Sound