git.maemo.org Git - opencv/blob - apps/cvenv/cvenv2.cpp

   1 /*M///////////////////////////////////////////////////////////////////////////////////////
   2 //
   3 //  IMPORTANT: READ BEFORE DOWNLOADING, COPYING, INSTALLING OR USING.
   4 //
   5 //  By downloading, copying, installing or using the software you agree to this license.
   6 //  If you do not agree to this license, do not download, install,
   7 //  copy or use the software.
   8 //
   9 //
  10 //                        Intel License Agreement
  11 //                For Open Source Computer Vision Library
  12 //
  13 // Copyright (C) 2000, Intel Corporation, all rights reserved.
  14 // Third party copyrights are property of their respective owners.
  15 //
  16 // Redistribution and use in source and binary forms, with or without modification,
  17 // are permitted provided that the following conditions are met:
  18 //
  19 //   * Redistribution's of source code must retain the above copyright notice,
  20 //     this list of conditions and the following disclaimer.
  21 //
  22 //   * Redistribution's in binary form must reproduce the above copyright notice,
  23 //     this list of conditions and the following disclaimer in the documentation
  24 //     and/or other materials provided with the distribution.
  25 //
  26 //   * The name of Intel Corporation may not be used to endorse or promote products
  27 //     derived from this software without specific prior written permission.
  28 //
  29 // This software is provided by the copyright holders and contributors "as is" and
  30 // any express or implied warranties, including, but not limited to, the implied
  31 // warranties of merchantability and fitness for a particular purpose are disclaimed.
  32 // In no event shall the Intel Corporation or contributors be liable for any direct,
  33 // indirect, incidental, special, exemplary, or consequential damages
  34 // (including, but not limited to, procurement of substitute goods or services;
  35 // loss of use, data, or profits; or business interruption) however caused
  36 // and on any theory of liability, whether in contract, strict liability,
  37 // or tort (including negligence or otherwise) arising in any way out of
  38 // the use of this software, even if advised of the possibility of such damage.
  39 //
  40 //M*/
  41
  42 #include "tcl.h"
  43 #include "tk.h"
  44
  45 #ifndef WIN32
  46 #include <pthread.h>
  47 #include <sys/types.h>
  48 #include <sys/stat.h>
  49 #include <unistd.h>
  50 #include <signal.h>
  51 #include <wait.h>
  52 #include <stdlib.h>
  53 #include <string.h>
  54 #endif
  55
  56 //#include <string>
  57 //using namespace std;
  58
  59 #ifdef WIN32
  60 #include <windows.h>
  61
  62 #define PIPESIZE 100
  63
  64 PROCESS_INFORMATION pi;
  65
  66 HANDLE g_hReadPipe = NULL;
  67 HANDLE g_hWritePipe = NULL;
  68 HANDLE g_hErrReadPipe = NULL;
  69 HANDLE g_hErrWritePipe = NULL;
  70 HANDLE g_hInputReadPipe = NULL;
  71 HANDLE g_hInputWritePipe = NULL;
  72
  73 #else
  74 static char home_path[200];
  75 #endif
  76
  77 char cmd[300];
  78 char* g_pchBuf = NULL;
  79
  80 void    MainEx(int argc, char **argv, Tcl_AppInitProc *pfappInitProc, Tcl_Interp *pintrp,
  81                char *pchfileName);
  82 int             Tcl_AppInit(Tcl_Interp *pintrp);
  83 void    Panic (Tcl_Interp * pintrp, const char * pch);
  84 void    WishPanic TCL_VARARGS_DEF(char *,arg1);
  85
  86 #include "colorer.h"
  87 #include "cvenv.h"
  88
  89 //string g_sCfgFile = "colors.cfg";
  90
  91 bool g_bNonStop = true;
  92 bool g_bRun = false;
  93
  94 /*
  95  *----------------------------------------------------------------------
  96  *
  97  * Commands routines.
  98  *
  99  * Results:
 100  *  TCL_OK - if sucsess, or TCL_ERROR
 101  *
 102  *----------------------------------------------------------------------
 103  */
 104
 105 static char* module_path;
 106
 107 static char* GetPathFromModuleName( char* modulename )
 108 {
 109     int i;
 110     if( !modulename )
 111         return 0;
 112 #ifndef WIN32
 113     /* if module is link find real path */
 114     int  len;
 115     char real[1000];
 116     strcpy( real, modulename );
 117     while( (len = readlink( real, real, 1000 )) > 0 )
 118         real[len] = 0;
 119     char* path = (char*)malloc( strlen( real ) + 10 );
 120     strcpy( path, real );
 121 #else
 122     char* path = (char*)malloc( strlen( modulename ) + 10 );
 123     strcpy( path, modulename );
 124 #endif
 125
 126     for( i = strlen( path ) - 1;
 127          i > 0 && path[i] != '\\' && path[i] != '/';
 128          i-- );
 129
 130     if( i <= 0 )
 131     {
 132         path[0] = '.';
 133         i = 1;
 134     }
 135
 136     path[i] = '/';
 137     path[i + 1] = 0;
 138
 139 #ifdef WIN32
 140     for( i = 0; i < (int)strlen( path ); i++ )
 141         if( path[i] == '\\' )
 142             path[i] = '/';
 143 #endif
 144
 145     return path;
 146 }
 147
 148 int _LoadColors (ClientData cd, Tcl_Interp *pintrp,
 149     int argc, char **argv)
 150 {
 151
 152         char fn[300];
 153 #ifdef WIN32
 154     strcat( strcpy( fn, module_path ), "/colors.tcl" );
 155 #else
 156         strcat( strcpy( fn, home_path ), "/.cvenv/colors.tcl" );
 157 #endif
 158     LoadColors( pintrp, fn );
 159     return TCL_OK;
 160 }
 161
 162 int _SaveColors (ClientData cd, Tcl_Interp *pintrp,
 163     int argc, char **argv)
 164 {
 165     char fn[300];
 166 #ifdef WIN32
 167     strcat( strcpy( fn, module_path ), "/colors.tcl" );
 168 #else
 169         strcat( strcpy( fn, home_path ), "/.cvenv" );
 170     mkdir( fn, 0700 );
 171     strcat( fn, "/colors.tcl" );
 172 #endif
 173     SaveColors( pintrp, fn );
 174     return TCL_OK;
 175 }
 176
 177 static int finished = 0;
 178 static int started = 0;
 179 static char* buffer = 0;
 180 static char* errbuffer = 0;
 181
 182 #ifdef WIN32
 183 CRITICAL_SECTION  mutex;
 184
 185 DWORD WINAPI ErrReaderFun (LPVOID pvParam)
 186 {
 187     DWORD cchReadBuffer,cchErrReadBuffer,counter = 0;  /* number of bytes read or to be written */
 188
 189     char * chErrReadBuffer = (char*)malloc( PIPESIZE + 1 );  /* pipe read buffer */
 190
 191     while( ReadFile( g_hErrReadPipe, chErrReadBuffer, PIPESIZE, &cchErrReadBuffer, 0 ) )
 192     {
 193         counter++;
 194         chErrReadBuffer[cchErrReadBuffer] = 0;
 195         EnterCriticalSection( &mutex );
 196         if(!errbuffer)
 197         {
 198             errbuffer = (char*)malloc( strlen( chErrReadBuffer ) + 1 );
 199             strcpy( errbuffer, chErrReadBuffer );
 200         }
 201         else
 202         {
 203             errbuffer = (char*)realloc( errbuffer, strlen( errbuffer ) + strlen( chErrReadBuffer ) + 2 );
 204             strcat( errbuffer, chErrReadBuffer );
 205         }
 206         LeaveCriticalSection( &mutex );
 207     }
 208
 209     free(chErrReadBuffer);
 210 return 0;
 211 }
 212
 213 DWORD WINAPI ReaderFun (LPVOID pvParam)
 214 {
 215     char* comline = (char*)pvParam;
 216
 217     //-----------------------------------------------------------------------
 218     BOOL bOk;  /* BOOL return code for APIs */
 219
 220     DWORD cchReadBuffer,cchErrReadBuffer,counter = 0;  /* number of bytes read or to be written */
 221     STARTUPINFO si;  /* for CreateProcess call */
 222     SECURITY_ATTRIBUTES saPipe,saErrPipe;  /* security for anonymous pipe */
 223     DWORD  retCode;                     // Used to trap return codes.
 224     //-----------------------------------------------------------------------
 225
 226     //-----------------------------------------------------------------------
 227     /* set up the security attributes for the anonymous pipe */
 228     saPipe.nLength = sizeof(SECURITY_ATTRIBUTES);
 229     saPipe.lpSecurityDescriptor = NULL;
 230     saErrPipe.nLength = sizeof(SECURITY_ATTRIBUTES);
 231     saErrPipe.lpSecurityDescriptor = NULL;
 232
 233     /* In order for the child to be able to write to the pipe, the handle */
 234     /* must be marked as inheritable by setting this flag: */
 235     saPipe.bInheritHandle = TRUE;
 236     saErrPipe.bInheritHandle = TRUE;
 237     //-----------------------------------------------------------------------
 238
 239     bOk = CreatePipe(&g_hReadPipe,
 240                      &g_hWritePipe,
 241                      &saPipe,
 242                      PIPESIZE);
 243
 244     if (!bOk)
 245     {
 246             retCode = GetLastError();
 247             printf("Reader: Can't create STDOUT pipe, Error #%d\n",GetLastError());
 248             return 0;
 249     }
 250
 251     bOk = CreatePipe(&g_hErrReadPipe,
 252                      &g_hErrWritePipe,
 253                      &saErrPipe,
 254                      PIPESIZE);
 255
 256     if (!bOk)
 257     {
 258             retCode = GetLastError();
 259             printf("Reader: Can't create STDERR pipe, Error #%d\n",GetLastError());
 260             return 0;
 261     }
 262
 263     bOk = CreatePipe(&g_hInputReadPipe,
 264                      &g_hInputWritePipe,
 265                      &saErrPipe,
 266                      PIPESIZE);
 267
 268     if (!bOk)
 269     {
 270             retCode = GetLastError();
 271             printf("Reader: Can't create STDIN pipe, Error #%d\n",GetLastError());
 272             return 0;
 273     }
 274
 275
 276     /* Set up the STARTUPINFO structure for the CreateProcess() call */
 277     memset(&si, 0, sizeof(si));
 278     si.cb = sizeof(si);
 279     //si.hStdError = si.hStdOutput = g_hWritePipe;
 280     //si.dwFlags = STARTF_USESTDHANDLES;
 281
 282     //Out//
 283     //si.hStdOutput = g_hWritePipe; /* write end of the pipe */
 284     //si.dwFlags = STARTF_USESTDHANDLES;
 285
 286     char buf[1000] ="";
 287     char ln[300];
 288     strcpy( buf, module_path );
 289     strcat( buf, comline );
 290     sprintf(ln," %u",g_hWritePipe);
 291     strcat( buf, ln );
 292     sprintf(ln," %u",g_hErrWritePipe);
 293     strcat( buf, ln );
 294     sprintf(ln," %u",g_hInputReadPipe);
 295     strcat( buf, ln );
 296
 297
 298     /* Now create the child process, inheriting handles */
 299     bOk = CreateProcess(NULL,       /* filename */
 300                         buf,        /* full command line for child */
 301                         NULL,       /* process security descriptor */
 302                         NULL,       /* thread security descriptor */
 303                         TRUE,       /* inherit handles? Also use if STARTF_USESTDHANDLES */
 304                         /*DETACHED_PROCESS*/0,          /* creation flags */ //Out// 0
 305                         NULL,       /* inherited environment address */
 306                         NULL,       /* startup dir; NULL = start in current */
 307                         &si,        /* pointer to startup info (input) */
 308                         &pi);       /* pointer to process info (output) */
 309
 310     CloseHandle( g_hWritePipe ); g_hWritePipe = NULL;
 311     CloseHandle( g_hErrWritePipe ); g_hErrWritePipe = NULL;
 312     CloseHandle( g_hInputReadPipe ); g_hInputReadPipe = NULL;
 313
 314     started = 1;
 315
 316     char * chReadBuffer = (char*)malloc( PIPESIZE + 1 );  /* pipe read buffer */
 317
 318     DWORD tid;
 319     CloseHandle(CreateThread(NULL, 0, ErrReaderFun,
 320                              NULL, 0, &tid));
 321
 322     while( ReadFile( g_hReadPipe, chReadBuffer, PIPESIZE, &cchReadBuffer, 0 ) )
 323     {
 324         chReadBuffer[cchReadBuffer] = 0;
 325         EnterCriticalSection( &mutex );
 326         if(!buffer)
 327         {
 328             buffer = (char*)malloc( strlen( chReadBuffer ) + 1 );
 329             strcpy( buffer, chReadBuffer );
 330         }
 331         else
 332         {
 333             buffer = (char*)realloc( buffer, strlen( buffer ) + strlen( chReadBuffer ) + 2 );
 334             strcat( buffer, chReadBuffer );
 335         }
 336         LeaveCriticalSection( &mutex );
 337     }
 338
 339     free(chReadBuffer);
 340     finished = 1;
 341     //--------------------------------------------------
 342     printf("ReaderID: I finish myself\n");
 343     //--------------------------------------------------
 344
 345     return 0;
 346 }
 347 #else
 348
 349 char** global_argv;
 350 int    global_argc;
 351 int    main_seance( int argc, char** argv );
 352
 353 static pid_t child;
 354 static pthread_mutex_t mutex;
 355 static int fd[2];
 356 static int err[2];
 357 static int fdi[2];
 358
 359 static void* errrun_process( void* a )
 360 {
 361     int nbytes;
 362     char buff[100];
 363     while( (nbytes = read( err[0], buff, sizeof(errbuffer) )) > 0 )
 364     {
 365         buff[nbytes] = 0;
 366         pthread_mutex_lock( &mutex );
 367         if( !errbuffer )
 368         {
 369             errbuffer = (char*)malloc( strlen( buff ) + 1 );
 370             errbuffer[0] = 0;
 371         }
 372         else
 373             errbuffer = (char*)realloc( errbuffer, strlen( errbuffer ) + strlen( buff ) + 2 );
 374         strcat( errbuffer, buff );
 375         pthread_mutex_unlock( &mutex );
 376     }
 377
 378     close( err[0] );
 379
 380     return 0;
 381 }
 382
 383 static void* run_process( void* a )
 384 {
 385     char* argv = (char*)a;
 386     // creating pipe for interproc communications
 387     pipe( fd );
 388     pipe( err );
 389     pipe( fdi );
 390
 391     // creating child process
 392     if( (child = fork()) == -1 )
 393     {
 394         printf( "can't fork\n" );
 395         exit( 1 );
 396     }
 397
 398     if( !child )
 399     {
 400         /* we are in child process */
 401         char pip[100];
 402         char errp[100];
 403         char pipi[100];
 404         sprintf( pip, "%d", fd[1] );
 405         sprintf( errp, "%d", err[1] );
 406         sprintf( pipi, "%d", fdi[0] );
 407         close( fd[0] );
 408         close( err[0] );
 409         close( fdi[1] );
 410         char* _argv[] = {global_argv[0], argv, pip, errp, pipi,0};
 411         main_seance( 5, _argv );
 412         close( fd[1] );
 413         close( err[1] );
 414         close( fdi[0] );
 415         exit( 0 );
 416     }
 417     else
 418     {
 419         // we are in parent process
 420         close( fd[1] );
 421         close( err[1] );
 422         close( fdi[0] );
 423         char buff[100];
 424
 425         pthread_t thread;
 426         pthread_create( &thread, 0, errrun_process, 0 );
 427
 428         int nbytes;
 429         while( (nbytes = read( fd[0], buff, sizeof(buffer) )) > 0 )
 430         {
 431             buff[nbytes] = 0;
 432             pthread_mutex_lock( &mutex );
 433             if( !buffer )
 434             {
 435                 buffer = (char*)malloc( strlen( buff ) + 1 );
 436                 buffer[0] = 0;
 437             }
 438             else
 439                 buffer = (char*)realloc( buffer, strlen( buffer ) + strlen( buff ) + 2 );
 440             strcat( buffer, buff );
 441             pthread_mutex_unlock( &mutex );
 442         }
 443
 444         close( fd[0] );
 445         finished = 1;
 446         wait( 0 );
 447     }
 448
 449     return 0;
 450 }
 451 #endif
 452
 453 static char filename[1000];
 454
 455 int InputData (ClientData, Tcl_Interp *interp,
 456     int, char **argv)
 457 {
 458
 459 #ifdef WIN32
 460     if (g_hInputWritePipe)
 461 #else
 462     if( fdi[1] )
 463 #endif
 464     {
 465         char* data =  Tcl_GetVar(interp, "CVEnv::inputdata", TCL_GLOBAL_ONLY);
 466
 467         if (*data)
 468         {
 469             size_t len = strlen( data );
 470             unsigned long num;
 471
 472 #           ifdef WIN32
 473                 WriteFile(g_hInputWritePipe,
 474                         (LPCVOID) data,
 475                         len,
 476                         &num,
 477                         NULL);
 478 #           else
 479                 write( fdi[1], data, len );
 480 #           endif
 481
 482         }
 483     }
 484     return TCL_OK;
 485 }
 486
 487 int Execute_Command (ClientData, Tcl_Interp *interp,
 488     int, char **argv)
 489 {
 490     Tcl_Eval(interp,
 491         "$CVEnv::tb.bbox3.b0 configure -state disable -relief link\n"
 492         "$CVEnv::tb.bbox3.b1 configure -state active -relief link\n"
 493         //"$CVEnv::tb.bbox3.b1 _leave\n"
 494         );
 495
 496 #ifdef WIN32
 497     DWORD tid;
 498     strcpy(cmd , "seance ");
 499     strcat(cmd, argv[1] );
 500     CloseHandle(CreateThread(NULL, 0, ReaderFun,
 501                              cmd, 0, &tid));
 502 #else
 503     strcpy( filename, argv[1] );
 504     pthread_t thread;
 505     pthread_create( &thread, 0, run_process, filename );
 506 #endif
 507
 508     return TCL_OK;
 509 }
 510
 511
 512 int Stop_Command (ClientData, Tcl_Interp *interp, int, char**)
 513 {
 514     Tcl_Eval(interp,
 515         "$CVEnv::tb.bbox3.b1 configure -state disable -relief link\n"
 516         "$CVEnv::tb.bbox3.b0 configure -state active -relief link\n"
 517         //"$CVEnv::tb.bbox3.b0 _leave"
 518             );
 519
 520 #ifdef WIN32
 521     if (TerminateProcess(pi.hProcess,1))
 522         return TCL_OK;
 523     else return TCL_ERROR;
 524 #else
 525     if( kill( child, 9 ) )
 526     {
 527         printf( "kill error\n" );
 528     }
 529     return TCL_OK;
 530 #endif
 531 }
 532
 533 ////////////////////////////////////////////////////////////////////////
 534
 535 /*
 536  *----------------------------------------------------------------------
 537  *
 538  * Commands_Init --     Commands initialisation routine.
 539  *
 540  * Results:
 541  *      TCL_OK - if sucsess, or TCL_ERROR
 542  *
 543  *----------------------------------------------------------------------
 544  */
 545 int
 546 Commands_Init(Tcl_Interp *interp)
 547 {
 548     Tcl_CreateCommand (interp, "pExecute", Execute_Command,
 549         (ClientData *) NULL, (Tcl_CmdDeleteProc *) NULL);
 550     Tcl_CreateCommand (interp, "pStop", Stop_Command,
 551         (ClientData *) NULL, (Tcl_CmdDeleteProc *) NULL);
 552     Tcl_CreateCommand (interp, "pLoadColors", _LoadColors,
 553         (ClientData *) NULL, (Tcl_CmdDeleteProc *) NULL);
 554     Tcl_CreateCommand (interp, "pSaveColors", _SaveColors,
 555         (ClientData *) NULL, (Tcl_CmdDeleteProc *) NULL);
 556     Tcl_CreateCommand (interp, "pParsebegin", ParseTextBegin,
 557         (ClientData *) NULL, (Tcl_CmdDeleteProc *) NULL);
 558     Tcl_CreateCommand (interp, "pParseend", ParseTextEnd,
 559         (ClientData *) NULL, (Tcl_CmdDeleteProc *) NULL);
 560     Tcl_CreateCommand (interp, "pInput", InputData,
 561         (ClientData *) NULL, (Tcl_CmdDeleteProc *) NULL);
 562
 563     return TCL_OK;
 564 }
 565
 566
 567 /*
 568  *----------------------------------------------------------------------
 569  *
 570  * MainEx -- Main program for Tk-based applications.
 571  *
 572  *----------------------------------------------------------------------
 573  */
 574 void
 575 MainEx( int argc, char** argv, Tcl_AppInitProc *appInitProc,
 576         Tcl_Interp *pintrp, char *fileName )
 577 {
 578 #ifndef WIN32
 579     global_argv = argv;
 580     global_argc = argc;
 581 #endif
 582
 583     int code;
 584
 585     (*appInitProc)(pintrp);
 586
 587     if ( Commands_Init(pintrp) != TCL_OK)
 588         Panic (pintrp,"Can't initialise commands!");
 589
 590     //if (!LoadColors(pintrp,string("colors.tcl")))
 591     //    Panic (pintrp,"Can't load config file!");
 592
 593     char set_path[1000];
 594     strcat( strcat( strcpy( set_path, "set ::image_path \"" ), module_path ), "\"" );
 595     code = Tcl_Eval( pintrp, set_path );
 596
 597         if (fileName != NULL)
 598     {
 599         char  script[1000];
 600         strcat( strcat( strcpy( script, module_path ), "" ), fileName );
 601         code = Tcl_EvalFile(pintrp, script);
 602         if (code != TCL_OK)
 603             Panic (pintrp,"Evaluate file error!");
 604     }
 605     else Tcl_SourceRCFile(pintrp);
 606
 607     Tcl_ResetResult(pintrp);
 608
 609 #ifdef WIN32
 610     InitializeCriticalSection( &mutex );
 611 #else
 612     pthread_mutex_init( &mutex, 0 );
 613 #endif
 614
 615     while( Tk_GetNumMainWindows() > 0 )
 616     {
 617         while( Tcl_DoOneEvent( TCL_DONT_WAIT ) );
 618
 619 #ifdef WIN32
 620         EnterCriticalSection( &mutex );
 621 #else
 622         pthread_mutex_lock( &mutex );
 623 #endif
 624         if( buffer )
 625         {
 626             char* pchcom = (char*)malloc( strlen( buffer ) + 1000 );
 627             strcpy(pchcom , "set outputText \"");
 628             strcat(pchcom , (const char*)buffer);
 629             strcat(pchcom , "\"\n");
 630             //strcat(pchcom , "$CVEnv::outtx configure -state normal\n");
 631             strcat(pchcom , "$CVEnv::outtx insert end $outputText\n");
 632             //strcat(pchcom , "$CVEnv::outtx configure -state disabled\n");
 633             strcat(pchcom , "$CVEnv::outtx see \"end -1 lines\"\n");
 634             strcat(pchcom , "unset outputText\n");
 635             Tcl_Eval( pintrp, pchcom );
 636             free( pchcom );
 637
 638             free( buffer );
 639             buffer = 0;
 640         }
 641
 642         if( errbuffer )
 643         {
 644             char* pchcom = (char*)malloc( strlen( errbuffer ) + 1000 );
 645             strcpy(pchcom , "set errText \"");
 646             strcat(pchcom , (const char*)errbuffer);
 647             strcat(pchcom , "\"\n");
 648             //strcat(pchcom , "$CVEnv::outtx configure -state normal\n");
 649             strcat(pchcom , "$CVEnv::parsetx insert end $errText\n");
 650             //strcat(pchcom , "$CVEnv::outtx configure -state disabled\n");
 651             strcat(pchcom , "$CVEnv::parsetx see \"end -1 lines\"\n");
 652             strcat(pchcom , "unset errText\n");
 653             Tcl_Eval( pintrp, pchcom );
 654             free( pchcom );
 655
 656             free( errbuffer );
 657             errbuffer = 0;
 658         }
 659
 660         if( finished )
 661         {
 662             finished = 0;
 663             Tcl_Eval(pintrp,
 664                     "$CVEnv::tb.bbox3.b1 configure -state disable -relief link\n"
 665                     "$CVEnv::tb.bbox3.b0 configure -state active -relief link\n"
 666                     //"$CVEnv::tb.bbox3.b0 _leave"
 667                         );
 668
 669 #ifdef WIN32
 670             CloseHandle( g_hReadPipe ); g_hReadPipe = NULL;
 671             CloseHandle( g_hErrReadPipe ); g_hErrReadPipe = NULL;
 672             CloseHandle( g_hInputWritePipe ); g_hInputWritePipe = NULL;
 673 #else
 674 #endif
 675             }
 676 #ifdef WIN32
 677         LeaveCriticalSection( &mutex );
 678         Sleep( 1 );
 679 #else
 680         pthread_mutex_unlock( &mutex );
 681         usleep( 100 );
 682 #endif
 683     }
 684     Tcl_DeleteInterp(pintrp);
 685     return;
 686 }
 687
 688
 689 /*
 690  *----------------------------------------------------------------------
 691  *
 692  * WishPanic -- escape function.
 693  *
 694  *----------------------------------------------------------------------
 695  */
 696
 697 void WishPanic TCL_VARARGS_DEF(char *,arg1)
 698 {
 699     va_list argList;
 700     char buf[1024];
 701     char *format;
 702
 703     format = TCL_VARARGS_START(char *,arg1,argList);
 704     printf(buf, format, argList);
 705 }
 706
 707 /*
 708  *----------------------------------------------------------------------
 709  *
 710  * Panic -- error output & exit function.
 711  *
 712  *----------------------------------------------------------------------
 713  */
 714
 715 void Panic (Tcl_Interp * pintrp, const char * pch)
 716 {
 717     printf("Thread %P:",Tcl_GetCurrentThread());
 718         printf(pch);
 719         printf("\n    Reason:");
 720         printf(pintrp->result);
 721         printf("\n");
 722
 723         Tcl_DeleteInterp(pintrp);
 724     Tcl_Exit(1);
 725 }
 726
 727 /*
 728  *----------------------------------------------------------------------
 729  *
 730  * Tcl_AppInit -- Initialisation function.
 731  *
 732  *----------------------------------------------------------------------
 733  */
 734
 735 int Tcl_AppInit(Tcl_Interp *pintrp)
 736 {
 737
 738     if (Tcl_InitStubs(pintrp, TCL_VERSION, 1) == NULL)
 739         Panic (pintrp,"Tcl stub's initialisation failed!");
 740
 741         if (Tcl_Init(pintrp) == TCL_ERROR)
 742             Panic (pintrp,"Tcl's initialisation failed!");
 743
 744     if (Tk_Init(pintrp) == TCL_ERROR)
 745         Panic (pintrp,"Tk's initialisation failed!");
 746 // in unix disable multythread support
 747     return TCL_OK;
 748 }
 749
 750 //-----------------------------------------------------------------------------
 751
 752 int main(int argc, char* argv[])
 753 {
 754     module_path = GetPathFromModuleName( argv[0] );
 755
 756 #ifndef WIN32
 757     if( argc == 2 )
 758         main_seance( argc, argv );
 759
 760         char* hdir = getenv( "HOME" );
 761         if( hdir )
 762                 strcpy( home_path, hdir );
 763 #endif
 764
 765     Tcl_Interp* g_pInterp = Tcl_CreateInterp();
 766
 767         Tcl_SetPanicProc(WishPanic);
 768     Tcl_FindExecutable(argv[0]);
 769
 770     MainEx(argc, argv, Tcl_AppInit, g_pInterp, "cvenv.tcl");
 771
 772     Tcl_DeleteInterp(g_pInterp);
 773
 774     return 0;
 775 }
 776