Posted to tcl by ro at Fri Feb 18 23:46:30 GMT 2011view raw

  1.  
  2. #define USE_TCL_STUBS
  3. #define USE_TK_STUBS
  4.  
  5. #include <tcl.h>
  6. #include <tk.h>
  7. #include <windows.h>
  8. #include <mmsystem.h>
  9.  
  10.  
  11. #undef TCL_STORAGE_CLASS
  12. #define TCL_STORAGE_CLASS DLLEXPORT
  13.  
  14. int MmtimersTimeBeginPeriodCmd(ClientData clientdata, Tcl_Interp *interp,
  15. int objc, Tcl_Obj *const objv[]);
  16. int MmtimersTimeSetEventCmd(ClientData clientdata, Tcl_Interp *interp,
  17. int objc, Tcl_Obj *const objv[]);
  18.  
  19. static Tcl_Interp *QTERP;
  20.  
  21. EXTERN int
  22. Mmtimers_Init(Tcl_Interp *interp)
  23. {
  24. if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
  25. return TCL_ERROR;
  26. }
  27.  
  28. if (Tk_InitStubs(interp, "8.1", 0) == NULL) {
  29. return TCL_ERROR;
  30. }
  31.  
  32. Tcl_CreateObjCommand(interp, "e1", MmtimersTimeBeginPeriodCmd,
  33. (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
  34.  
  35. Tcl_CreateObjCommand(interp, "ee", MmtimersTimeSetEventCmd,
  36. (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
  37.  
  38. QTERP = interp;
  39.  
  40. return TCL_OK;
  41. }
  42.  
  43.  
  44. int MmtimersTimeBeginPeriodCmd(ClientData clientdata, Tcl_Interp *interp,
  45. int objc, Tcl_Obj *const objv[])
  46. {
  47.  
  48. if (objc != 1) {
  49. Tcl_SetResult(interp, "no arguments please", TCL_STATIC);
  50. return TCL_ERROR;
  51. }
  52.  
  53. timeBeginPeriod(1);
  54.  
  55. return TCL_OK;
  56. }
  57.  
  58.  
  59. void CALLBACK cbproc (UINT uTimerID, UINT uMsg,
  60. DWORD_PTR dwUser, DWORD_PTR dw1, DWORD_PTR dw2)
  61. {
  62.  
  63. //Tcl_Eval(QTERP, "set x 388");
  64. //Tcl_SetVar(QTERP, "x", "192", TCL_GLOBAL_ONLY);
  65. //Tcl_Eval(QTERP, "after 100 xtouched");
  66.  
  67. Tcl_Eval(QTERP, "set x [clock micro]");
  68.  
  69. //Tcl_ThreadAlert(Tcl_GetCurrentThread());
  70.  
  71.  
  72. }
  73.  
  74. int MmtimersTimeSetEventCmd(ClientData clientdata, Tcl_Interp *interp,
  75. int objc, Tcl_Obj *const objv[])
  76. {
  77.  
  78. timeSetEvent(1, 0, cbproc, 0, TIME_ONESHOT | TIME_CALLBACK_FUNCTION);
  79.  
  80. return TCL_OK;
  81. }
  82.  
  83.  
  84.  
  85.  
  86.  
  87.  
  88.  
  89.