Posted to tcl by xharx at Tue Mar 09 11:46:43 GMT 2021view pretty
#include <stdio.h> #include <unistd.h> #include <tk.h> #include <tcl.h> #include <string.h> #include <pthread.h> #include <stdlib.h> char ptglobstr[1024]; int TKquit(ClientData clientdata, Tcl_Interp *interp, int argc, const char **argv) { exit (0); } typedef struct { Tcl_Interp *pti; char *varname; char *str; }tfast; int fast(tfast *ptin) { sleep(1); sprintf(ptin->str, "zweiter Versuch"); printf("%s %s\n", ptin->varname, ptin->str); Tcl_UpdateLinkedVar(ptin->pti, ptin->varname); } int TKgettext(ClientData clientdata, Tcl_Interp *interp, int argc, const char **argv) { //printf("TKgettext\n"); char *str=malloc(1024); char *varname=malloc(1024); sprintf(varname, "linkedstr"); Tcl_LinkVar(interp, varname, str, TCL_LINK_STRING); pthread_t mthread; if (argc>1 && !strcmp(argv[1], "slow")) { tfast *ptfast=calloc(1, sizeof(tfast)); ptfast->pti=interp; ptfast->varname=varname; ptfast->str=str; //pthread_create(&mthread, 0, (void *)fast, ptfast); Tcl_Eval(interp, "procver1"); sprintf(str, "fast 444"); } else if (argc>1 && !strcmp(argv[1], "utext")) { str=ptglobstr; printf("gettext utext %s\n", str); } else { static int i=0; sprintf(str, "{.c gettext bla %i}", i++); } Tcl_Obj *mobj=Tcl_NewStringObj(str, strlen(str)); Tcl_SetObjResult(interp, mobj); return TCL_OK; } char *realloc_strcat(char *str1, char*str2) { char *ptraus=realloc(str1, strlen(str1)+strlen(str2)+1); if (!ptraus) { printf("realloc_strcat: Kein Speicher %d %d\n", (int) strlen(str1), (int) strlen(str2)); exit (0); } strcat(ptraus,str2); return ptraus; } void utthread(Tcl_Interp *interp) { int i=0; while (1) { char puf[1024]; sprintf(puf, "{ut %i} \n", i++); strcat(ptglobstr, puf); Tcl_Eval(interp, "updateutext"); sleep(1); } } int TKutext(ClientData clientdata, Tcl_Interp *interp, int argc, const char **argv) { pthread_t thread; pthread_create(&thread, 0, (void *)utthread, interp); } void registercommands (Tcl_Interp *tcl_interp) { Tcl_CreateCommand(tcl_interp, "quit", TKquit, (ClientData)(NULL), (Tcl_CmdDeleteProc *)NULL); Tcl_CreateCommand(tcl_interp, "gettext", TKgettext, (ClientData)(NULL), (Tcl_CmdDeleteProc *)NULL); Tcl_CreateCommand(tcl_interp, "utext", TKutext, (ClientData)(NULL), (Tcl_CmdDeleteProc *)NULL); } Tcl_Interp *EPtkinit() { Tcl_Interp * tcl_interp = Tcl_CreateInterp() ; if ( tcl_interp == NULL ) { fprintf( stderr, "Could not create interpreter!\n" ) ; return 0; } if (Tcl_Init(tcl_interp) != TCL_OK) { printf("Tcl_Init error\n"); return 0; } if (Tk_Init(tcl_interp) != TCL_OK) { printf("Tk_Init error\n"); return 0; } return tcl_interp; } int EPtkexecfile(Tcl_Interp *tcl_interp, char *filename) { int rc ; size_t filesize ; char * pstr ; if (filename) { FILE *infile = fopen(filename, "r") ; if ( infile == NULL ) { printf("datei nicht gefunden: %s\n", filename); return 0; } //read the whole file ... fseek( infile, 0L, SEEK_END ) ; filesize = ftell( infile ) ; pstr = (char * ) malloc( (filesize+1) * sizeof(char) ) ; if ( pstr == NULL ) { printf("Datei ist leer\n"); return 0; } fseek( infile, 0L, SEEK_SET ) ; fread( pstr, filesize, 1, infile ) ; pstr[filesize] = '\0' ; rc = Tcl_Eval( tcl_interp, pstr ) ; if ( rc != TCL_OK ) { fprintf( stderr, "Error loading script library\n" ) ; return 0; } free( pstr ) ; } else { printf("Kein Dateiname angegeben\n"); return 0; } return 1; } int exec_tkmainloop_thread(char *filename) { Tcl_Interp *tcl_interp=EPtkinit(); registercommands(tcl_interp); EPtkexecfile(tcl_interp, filename); printf("start Tk_MainLoop()\n"); Tk_MainLoop(); printf("stop TK_MainLoop\n"); return 0; } int main() { pthread_t tkmainloopthread; char *filename="tkupdatev2.tk"; pthread_create(&tkmainloopthread, 0, (void *)exec_tkmainloop_thread, filename); pthread_join(tkmainloopthread, 0); printf("main ends\n"); } proc buttoncommand {} { quit destroy . } proc new {} { utext } proc updateutext {} { set ret [gettext utext] puts $ret set ::ltext $ret update } listbox .l1 -width 50 -height 10 -listvariable ::ltext pack .l1 button .b1 -text "ok" -command {quit} button .b2 -text "update" -command {new} pack .b1 pack .b2