Posted to tcl by hypnotoad at Fri Jan 26 15:18:33 GMT 2018view raw

  1. /* File : example.tcl */
  2.  
  3. my include <time.h>
  4. my code header {
  5. double My_variable = 3.0;
  6. }
  7.  
  8. my c_function {int fact(int n)} {
  9. if (n <= 1) return 1;
  10. else return n*fact(n-1);
  11. }
  12.  
  13. my c_function {int my_mod(int x, int y)} {
  14. return (x%y);
  15. }
  16.  
  17. my c_function {char *get_time()} {
  18. time_t ltime;
  19. time(&ltime);
  20. return ctime(&ltime);
  21. }
  22.  
  23. my c_tclcmd ::fact {
  24. int _result;
  25. int _arg0;
  26.  
  27. if (objv != 2) {
  28. Tcl_SetResult(interp, "Wrong # args int : fact n ",TCL_STATIC);
  29. return TCL_ERROR;
  30. }
  31. if(Tcl_GetIntFromObj(interp,objv[1],&_arg0)) {
  32. return TCL_ERROR;
  33. }
  34. _result = fact(_arg0);
  35. Tcl_SetObjResult(interp,Tcl_NewIntObj(_result));
  36. return TCL_OK;
  37. }
  38.  
  39. my c_tclcmd ::fact mod {
  40. int _result;
  41. int _arg0;
  42. int _arg1;
  43.  
  44. if (objv != 3) {
  45. Tcl_SetResult(interp, "Wrong # args int : mod x y ",TCL_STATIC);
  46. return TCL_ERROR;
  47. }
  48. if(Tcl_GetIntFromObj(interp,objv[1],&_arg0)) return TCL_ERROR;
  49. if(Tcl_GetIntFromObj(interp,objv[2],&_arg1)) {
  50. _result = mod(_arg0,_arg1);
  51. Tcl_SetObjResult(interp,Tcl_NewIntObj(_result));
  52. return TCL_OK;
  53. }
  54.  
  55. my c_tclcmd ::get_time {
  56. char * _result;
  57. if (objv != 1) {
  58. Tcl_WrongNumArgs(interp, 1, objv, "");
  59. return TCL_ERROR;
  60. }
  61. }
  62. _result = get_time();
  63. Tcl_SetObjResult(interp,Tcl_NewStringObj(_result,-1));
  64. return TCL_OK;
  65. }
  66.  
  67. my code cinit {
  68. Tcl_LinkVar(interp, "My_variable", (char *) &My_variable, TCL_LINK_DOUBLE);
  69. }