Posted to tcl by xharx at Tue Mar 09 11:46:43 GMT 2021view raw

  1. #include <stdio.h>
  2. #include <unistd.h>
  3. #include <tk.h>
  4. #include <tcl.h>
  5. #include <string.h>
  6. #include <pthread.h>
  7. #include <stdlib.h>
  8.  
  9. char ptglobstr[1024];
  10.  
  11. int TKquit(ClientData clientdata, Tcl_Interp *interp, int argc, const char **argv) {
  12. exit (0);
  13. }
  14.  
  15. typedef struct {
  16. Tcl_Interp *pti;
  17. char *varname;
  18. char *str;
  19. }tfast;
  20.  
  21. int fast(tfast *ptin) {
  22. sleep(1);
  23. sprintf(ptin->str, "zweiter Versuch");
  24. printf("%s %s\n", ptin->varname, ptin->str);
  25. Tcl_UpdateLinkedVar(ptin->pti, ptin->varname);
  26. }
  27.  
  28. int TKgettext(ClientData clientdata, Tcl_Interp *interp, int argc, const char **argv) {
  29. //printf("TKgettext\n");
  30. char *str=malloc(1024);
  31. char *varname=malloc(1024);
  32. sprintf(varname, "linkedstr");
  33. Tcl_LinkVar(interp, varname, str, TCL_LINK_STRING);
  34. pthread_t mthread;
  35. if (argc>1 && !strcmp(argv[1], "slow")) {
  36. tfast *ptfast=calloc(1, sizeof(tfast));
  37. ptfast->pti=interp;
  38. ptfast->varname=varname;
  39. ptfast->str=str;
  40. //pthread_create(&mthread, 0, (void *)fast, ptfast);
  41. Tcl_Eval(interp, "procver1");
  42. sprintf(str, "fast 444");
  43. }
  44. else if (argc>1 && !strcmp(argv[1], "utext")) {
  45. str=ptglobstr;
  46. printf("gettext utext %s\n", str);
  47. }
  48. else {
  49. static int i=0;
  50. sprintf(str, "{.c gettext bla %i}", i++);
  51. }
  52. Tcl_Obj *mobj=Tcl_NewStringObj(str, strlen(str));
  53. Tcl_SetObjResult(interp, mobj);
  54. return TCL_OK;
  55. }
  56.  
  57. char *realloc_strcat(char *str1, char*str2) {
  58. char *ptraus=realloc(str1, strlen(str1)+strlen(str2)+1);
  59. if (!ptraus) {
  60. printf("realloc_strcat: Kein Speicher %d %d\n", (int) strlen(str1), (int) strlen(str2));
  61. exit (0);
  62. }
  63. strcat(ptraus,str2);
  64. return ptraus;
  65. }
  66.  
  67. void utthread(Tcl_Interp *interp) {
  68. int i=0;
  69. while (1) {
  70. char puf[1024];
  71. sprintf(puf, "{ut %i} \n", i++);
  72. strcat(ptglobstr, puf);
  73. Tcl_Eval(interp, "updateutext");
  74. sleep(1);
  75. }
  76. }
  77.  
  78. int TKutext(ClientData clientdata, Tcl_Interp *interp, int argc, const char **argv) {
  79. pthread_t thread;
  80. pthread_create(&thread, 0, (void *)utthread, interp);
  81. }
  82.  
  83. void registercommands (Tcl_Interp *tcl_interp) {
  84. Tcl_CreateCommand(tcl_interp, "quit", TKquit, (ClientData)(NULL), (Tcl_CmdDeleteProc *)NULL);
  85. Tcl_CreateCommand(tcl_interp, "gettext", TKgettext, (ClientData)(NULL), (Tcl_CmdDeleteProc *)NULL);
  86. Tcl_CreateCommand(tcl_interp, "utext", TKutext, (ClientData)(NULL), (Tcl_CmdDeleteProc *)NULL);
  87. }
  88.  
  89. Tcl_Interp *EPtkinit() {
  90. Tcl_Interp * tcl_interp = Tcl_CreateInterp() ;
  91. if ( tcl_interp == NULL )
  92. {
  93. fprintf( stderr, "Could not create interpreter!\n" ) ;
  94. return 0;
  95. }
  96. if (Tcl_Init(tcl_interp) != TCL_OK) {
  97. printf("Tcl_Init error\n");
  98. return 0;
  99. }
  100. if (Tk_Init(tcl_interp) != TCL_OK) {
  101. printf("Tk_Init error\n");
  102. return 0;
  103. }
  104. return tcl_interp;
  105. }
  106.  
  107. int EPtkexecfile(Tcl_Interp *tcl_interp, char *filename) {
  108. int rc ;
  109. size_t filesize ;
  110. char * pstr ;
  111.  
  112. if (filename) {
  113. FILE *infile = fopen(filename, "r") ;
  114. if ( infile == NULL )
  115. {
  116. printf("datei nicht gefunden: %s\n", filename);
  117. return 0;
  118. }
  119.  
  120. //read the whole file ...
  121. fseek( infile, 0L, SEEK_END ) ;
  122. filesize = ftell( infile ) ;
  123. pstr = (char * ) malloc( (filesize+1) * sizeof(char) ) ;
  124. if ( pstr == NULL )
  125. {
  126. printf("Datei ist leer\n");
  127. return 0;
  128. }
  129. fseek( infile, 0L, SEEK_SET ) ;
  130. fread( pstr, filesize, 1, infile ) ;
  131. pstr[filesize] = '\0' ;
  132. rc = Tcl_Eval( tcl_interp, pstr ) ;
  133. if ( rc != TCL_OK )
  134. {
  135. fprintf( stderr, "Error loading script library\n" ) ;
  136. return 0;
  137. }
  138.  
  139. free( pstr ) ;
  140. }
  141. else {
  142. printf("Kein Dateiname angegeben\n");
  143. return 0;
  144. }
  145. return 1;
  146. }
  147.  
  148. int exec_tkmainloop_thread(char *filename) {
  149. Tcl_Interp *tcl_interp=EPtkinit();
  150. registercommands(tcl_interp);
  151. EPtkexecfile(tcl_interp, filename);
  152. printf("start Tk_MainLoop()\n");
  153. Tk_MainLoop();
  154. printf("stop TK_MainLoop\n");
  155. return 0;
  156. }
  157.  
  158. int main() {
  159. pthread_t tkmainloopthread;
  160. char *filename="tkupdatev2.tk";
  161. pthread_create(&tkmainloopthread, 0, (void *)exec_tkmainloop_thread, filename);
  162. pthread_join(tkmainloopthread, 0);
  163. printf("main ends\n");
  164. }
  165.  
  166.  
  167.  
  168. proc buttoncommand {} {
  169. quit
  170. destroy .
  171. }
  172.  
  173. proc new {} {
  174. utext
  175. }
  176.  
  177. proc updateutext {} {
  178. set ret [gettext utext]
  179. puts $ret
  180. set ::ltext $ret
  181. update
  182. }
  183.  
  184. listbox .l1 -width 50 -height 10 -listvariable ::ltext
  185. pack .l1
  186. button .b1 -text "ok" -command {quit}
  187. button .b2 -text "update" -command {new}
  188. pack .b1
  189. pack .b2
  190.  
  191.