extern Standard_Boolean Draw_Batch;
extern Standard_Boolean Draw_VirtualWindows;
-static Tcl_Interp *interp; /* Interpreter for this application. */
static NCollection_List<Draw_Window::FCallbackBeforeTerminate> MyCallbacks;
void Draw_Window::AddCallbackBeforeTerminate(FCallbackBeforeTerminate theCB)
{
Draw_Interpretor& aCommands = Draw::GetInterpretor();
aCommands.Init();
- interp = aCommands.Interp();
+ Tcl_Interp *interp = aCommands.Interp();
+ Tcl_Init (interp);
- Tcl_Init(interp) ;
try {
OCC_CATCH_SIGNALS
Tk_Init(interp) ;
*/
prompt:
- if (tty) Prompt(interp, gotPartial);
+ if (tty) Prompt(Draw::GetInterpretor().Interp(), gotPartial);
} catch (Standard_Failure) {}
Standard_Boolean Init_Appli(HINSTANCE hInst,
HINSTANCE hPrevInst, int nShow, HWND& hWndFrame )
{
- Draw_Interpretor& aCommands = Draw::GetInterpretor();
-
DWORD IDThread;
HANDLE hThread;
console_semaphore = STOP_CONSOLE;
- aCommands.Init();
- interp = aCommands.Interp();
- Tcl_Init(interp) ;
dwMainThreadId = GetCurrentThreadId();
0, // use default creation flags
&IDThread);
if (!hThread) {
- cout << "Tcl/Tk main loop thread not created. Switching to batch mode..." << endl;
+ cout << "Failed to create Tcl/Tk main loop thread. Switching to batch mode..." << endl;
Draw_Batch = Standard_True;
+ Draw_Interpretor& aCommands = Draw::GetInterpretor();
+ aCommands.Init();
+ Tcl_Interp *interp = aCommands.Interp();
+ Tcl_Init(interp);
#ifdef _TK
try {
OCC_CATCH_SIGNALS
- Tk_Init(interp) ;
- } catch (Standard_Failure) {
- cout <<" Pb au lancement de TK_Init "<<endl;
+ Tk_Init(interp);
+ } catch (Standard_Failure& anExcept) {
+ cout << "Failed to initialize Tk: " << anExcept.GetMessageString() << endl;
}
Tcl_StaticPackage(interp, "Tk", Tk_Init, (Tcl_PackageInitProc *) NULL);
{
Tcl_CreateExitHandler(exitProc, 0);
+ Draw_Interpretor& aCommands = Draw::GetInterpretor();
+ aCommands.Init();
+ Tcl_Interp *interp = aCommands.Interp();
+ Tcl_Init(interp);
+
// Work-around against issue with Tcl standard channels on Windows.
// These channels by default use OS handles owned by the system which
// may get invalidated e.g. by dup2() (see dlog command).
// ActiveState Tcl (at least 8.6.4) does not seem to do that, so channels
// need to be set into interpretor explicitly
{
- Draw_Interpretor& aCommands = Draw::GetInterpretor();
-
Tcl_Channel aChannelIn = Tcl_GetStdChannel (TCL_STDIN);
Tcl_Channel aChannelOut = Tcl_GetStdChannel (TCL_STDOUT);
Tcl_Channel aChannelErr = Tcl_GetStdChannel (TCL_STDERR);
--- /dev/null
+# testgrid demo draw -overwrite
+
+catch {cpulimit 10}
+
+package require Thread
+
+set NBTHREADS 1
+set NBWORKERS 1
+
+puts "Creating worker"
+set worker [tpool::create -minworkers $NBWORKERS -maxworkers $NBWORKERS]
+
+puts "Suspending worker"
+tpool::suspend $worker
+
+puts "Arranging jobs"
+for {set i 1} {$i <= $NBTHREADS} {incr i} {
+ set job [tpool::post $worker "puts Executing_job_$i"]
+ puts "Job $i: $job"
+# set job [tpool::post -nowait $worker "puts $i"]
+ set jobs($job) $job
+}
+
+puts "Resuming worker"
+tpool::resume $worker
+
+puts "Waiting while all threads complete"
+after 1000
+
+puts "Obtaining results"
+while { [llength [array names jobs]] > 0 } {
+ puts "Queue: [array names jobs]"
+
+ foreach job [tpool::wait $worker [array names jobs]] {
+ puts -nonewline "Completed $job: "
+ puts "[tpool::get $worker $job]"
+ unset jobs($job)
+ }
+}
+
+puts "Releasing worker"
+tpool::release $worker
+
+catch {cpulimit 0}
+
+puts "TEST COMPLETED"