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