Project

General

Profile

Statistics
| Branch: | Revision:

root / src / tkenv / tklib.cc @ e1750c09

History | View | Annotate | Download (3.49 KB)

1
//==========================================================================
2
//  TKLIB.CC - part of
3
//
4
//                     OMNeT++/OMNEST
5
//            Discrete System Simulation in C++
6
//
7
//==========================================================================
8

    
9
/*--------------------------------------------------------------*
10
  Copyright (C) 1992-2008 Andras Varga
11
  Copyright (C) 2006-2008 OpenSim Ltd.
12

13
  This file is distributed WITHOUT ANY WARRANTY. See the file
14
  `license' for details on this and other legal matters.
15
*--------------------------------------------------------------*/
16

    
17
// Work around an MSVC .NET bug: WinSCard.h causes compilation
18
// error due to faulty LPCVOID declaration, so prevent it from
19
// being pulled in (we don't need the SmartCard API here anyway ;-)
20
#define _WINSCARD_H_
21

    
22
#include <stdio.h>
23
#include <string.h>
24
#include <time.h>
25
#include <assert.h>
26
#include <tk.h>
27

    
28
#include "tklib.h"
29
#include "tkutil.h"
30
#include "tkenv.h"
31
#include "exception.h"
32

    
33
NAMESPACE_BEGIN
34

    
35
int exit_omnetpp;
36
extern "C" int Tkpng_Init(Tcl_Interp *interp);
37

    
38
// Procedure to handle X errors
39
static int XErrorProc(ClientData, XErrorEvent *errEventPtr)
40
{
41
    fprintf(stderr, "X protocol error: ");
42
    fprintf(stderr, "error=%d request=%d minor=%d\n",
43
                    errEventPtr->error_code,
44
                    errEventPtr->request_code,
45
                    errEventPtr->minor_code );
46
    return 0;  // claim to have handled the error
47
}
48

    
49
// initialize Tcl/Tk and return a pointer to the interpreter
50
Tcl_Interp *initTk(int argc, char **argv)
51
{
52
    // create interpreter
53
    Tcl_Interp *interp = Tcl_CreateInterp();
54

    
55
    // pass application name to interpreter
56
    Tcl_FindExecutable(argv[0]);
57

    
58
    // Tcl/Tk args interfere with OMNeT++'s own command-line args
59
    //if (Tk_ParseArgv(interp, (Tk_Window)NULL, &argc, argv, argTable, 0)!=TCL_OK)
60
    //{
61
    //    fprintf(stderr, "%s\n", Tcl_GetStringResult(interp));
62
    //    return TCL_ERROR;
63
    //}
64

    
65
    if (Tcl_Init(interp) != TCL_OK)
66
        throw opp_runtime_error("Tkenv: Tcl_Init failed: %s\n", Tcl_GetStringResult(interp));
67

    
68
    if (Tk_Init(interp) != TCL_OK)
69
        throw opp_runtime_error("Tkenv: Tk_Init failed: %s\n", Tcl_GetStringResult(interp));
70

    
71
    Tcl_StaticPackage(interp, "Tk", Tk_Init, (Tcl_PackageInitProc *) NULL);
72

    
73
    if (Tkpng_Init(interp) != TCL_OK)
74
        throw opp_runtime_error("Tkenv: Tkpng_Init failed: %s\n", Tcl_GetStringResult(interp));
75

    
76

    
77
    Tk_Window mainWindow = Tk_MainWindow(interp);
78

    
79
    Tk_SetAppName( mainWindow, "omnetpp" );
80
    Tk_SetClass( mainWindow, "Omnetpp" );
81

    
82
    // Register X error handler and ask for synchronous protocol to help debugging
83
    Tk_CreateErrorHandler( Tk_Display(mainWindow), -1,-1,-1, XErrorProc, (ClientData)mainWindow );
84

    
85
    // Grab initial size and background
86
    Tk_GeometryRequest(mainWindow,200,200);
87

    
88
    return interp;
89
}
90

    
91
// create custom commands (implemented in tkcmd.cc) in Tcl
92
int createTkCommands(Tcl_Interp *interp, OmnetTclCommand *commands)
93
{
94
    for (; commands->namestr!=NULL; commands++)
95
    {
96
        Tcl_CreateCommand( interp, TCLCONST(commands->namestr),
97
                                   (Tcl_CmdProc *)commands->func,
98
                                   (ClientData)NULL,
99
                                   (Tcl_CmdDeleteProc *)NULL);
100
    }
101
    return TCL_OK;
102
}
103

    
104
// run the Tk application
105
int runTk(Tcl_Interp *)
106
{
107
    // Custom event loop
108
    //  the C++ variable exit_omnetpp is used for exiting
109
    while (!exit_omnetpp)
110
    {
111
       Tk_DoOneEvent(TK_ALL_EVENTS);
112
    }
113

    
114
    return TCL_OK;
115
}
116

    
117
NAMESPACE_END
118