Posted to tcl by ro at Fri Feb 18 23:46:30 GMT 2011view raw
- #define USE_TCL_STUBS
- #define USE_TK_STUBS
- #include <tcl.h>
- #include <tk.h>
- #include <windows.h>
- #include <mmsystem.h>
- #undef TCL_STORAGE_CLASS
- #define TCL_STORAGE_CLASS DLLEXPORT
- int MmtimersTimeBeginPeriodCmd(ClientData clientdata, Tcl_Interp *interp,
- int objc, Tcl_Obj *const objv[]);
- int MmtimersTimeSetEventCmd(ClientData clientdata, Tcl_Interp *interp,
- int objc, Tcl_Obj *const objv[]);
- static Tcl_Interp *QTERP;
- EXTERN int
- Mmtimers_Init(Tcl_Interp *interp)
- {
- if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
- return TCL_ERROR;
- }
- if (Tk_InitStubs(interp, "8.1", 0) == NULL) {
- return TCL_ERROR;
- }
- Tcl_CreateObjCommand(interp, "e1", MmtimersTimeBeginPeriodCmd,
- (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
- Tcl_CreateObjCommand(interp, "ee", MmtimersTimeSetEventCmd,
- (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
- QTERP = interp;
- return TCL_OK;
- }
- int MmtimersTimeBeginPeriodCmd(ClientData clientdata, Tcl_Interp *interp,
- int objc, Tcl_Obj *const objv[])
- {
- if (objc != 1) {
- Tcl_SetResult(interp, "no arguments please", TCL_STATIC);
- return TCL_ERROR;
- }
- timeBeginPeriod(1);
- return TCL_OK;
- }
- void CALLBACK cbproc (UINT uTimerID, UINT uMsg,
- DWORD_PTR dwUser, DWORD_PTR dw1, DWORD_PTR dw2)
- {
- //Tcl_Eval(QTERP, "set x 388");
- //Tcl_SetVar(QTERP, "x", "192", TCL_GLOBAL_ONLY);
- //Tcl_Eval(QTERP, "after 100 xtouched");
- Tcl_Eval(QTERP, "set x [clock micro]");
- //Tcl_ThreadAlert(Tcl_GetCurrentThread());
- }
- int MmtimersTimeSetEventCmd(ClientData clientdata, Tcl_Interp *interp,
- int objc, Tcl_Obj *const objv[])
- {
- timeSetEvent(1, 0, cbproc, 0, TIME_ONESHOT | TIME_CALLBACK_FUNCTION);
- return TCL_OK;
- }