source: CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/opentea.tcl @ 4775

Last change on this file since 4775 was 4775, checked in by aclsce, 4 years ago
  • Imported oasis3-mct from Cerfacs svn server (not suppotred anymore).

The version has been extracted from ​https://oasis3mct.cerfacs.fr/svn/branches/OASIS3-MCT_2.0_branch/oasis3-mct@1818
File size: 14.4 KB
Line 
1#  This program is under CECILL_B licence. See footer for details.
2
3
4set load_start_time [clock milliseconds]
5
6
7
8
9##############################################################
10# Handle  errors in thecode with a message                   #
11##############################################################
12proc popup_error {msg {type exitcontinue} } {
13    raise .
14    .startup.l configure -text  "Problem at startup\nClick here for more informations"
15    # Display a pop up for the user
16    set win ".popup"
17    set ierror 0
18    puts "################"
19    if {[winfo exists $win]} {
20        destroy $win
21    } 
22
23    switch $type {
24        "exitcontinue" {
25            puts "POPUP WARNING..."
26            puts $msg
27            set reply [tk_dialog $win "Error" $msg ""  0 exit continue]
28
29            if {$reply == 0} {
30                exit
31            }
32        }
33        "strict" {
34            puts "POPUP ERROR..."
35            puts $msg
36           
37            tk_messageBox -icon error -message "$msg"
38            exit
39        }
40    }
41   
42}
43
44
45
46
47
48####################################
49# Read the arguments
50
51ttk::frame .startup
52ttk::label .startup.l -text "Starting up GUI..."
53pack .startup -fill both
54pack .startup.l
55
56
57
58if {[expr [llength $argv] % 2] != 0} {
59    tk_messageBox -icon error -message "Error : arguments ($argv) are invalid."
60    exit
61}
62
63foreach { keyword argument } $argv {
64    # test keywords
65    if {![string match -* $keyword ]} {
66        tk_messageBox -icon error -message "Error : keyword must be like -*"
67        exit
68    }
69
70    set varname [ string trim $keyword "-"]
71    set listkeyword [list "code" "file" "config" "library" "plugins"]
72    if {$varname in $listkeyword} {
73        set key_$varname $argument
74    } else {
75        set listkey [join $listkeyword "\n-"]
76        #foreach $item $listkeyword {set listkey "$listkey \n $item"}
77        popup_error "Error : keyword -$varname is not recognized. \n Use one from \n \n-$listkey" strict
78        exit
79    }
80}
81
82
83
84####################################
85#Initialize variables
86
87
88
89global debug loading FunctionUsed solverList loadApplication configTree widgetInfo configPath pluginsPath starpack relaunchCmd
90global logHistory loadedProject metaTree requiredValue additionalWidgets
91global workingDir
92
93
94set workingDir [pwd]
95set configTree ""
96set loadApplication "none"
97set loadedProject "none"
98set abort_cmd ""
99set widgetInfo(SetViewMode)  "none"
100set widgetInfo(ReGrid)  "no"
101set widgetInfo(nregrid) 0
102set widgetInfo(form_to_update) ""
103set widgetInfo(tabfocus) ""
104set widgetInfo(fixedview) "1"
105set solverOrder(none) "0"
106set log_channel stdout
107
108
109
110set debug 1
111set wrapper 0
112set TraceProfile 1
113set tabscroll 1
114
115set ndim 3
116set requiredValue ""
117set widgetInfo(classApp) ""
118
119
120####################################
121# Initialize the pathes
122
123set pathEngine [file normalize [file dirname [info script]]]
124
125if {"vfs" ni [package names]} {
126    #The project has NOT been starpacked / classical behavior
127    set starpack 0
128    set topPath [file dirname $pathEngine ]
129    set relaunchCmd "[file normalize [info nameofexecutable]] [file normalize $argv0] "
130} else {
131    # The project has been starpacked
132    set starpack 1
133    set topPath [file dirname $starkit::topdir]
134    set relaunchCmd [file normalize [info nameofexecutable]]
135}
136
137# Gittag
138set gittag_file [file join $topPath "gittag"]
139if {[file exists $gittag_file ]} {
140    set engine_version [read [ open $gittag_file  ]]
141} else {
142    set engine_version "- No gittag -"
143}
144
145# Config
146#set configPath [file normalize [file join $topPath "myconfig.xml"]]
147if {[info exists key_config]} {
148    set configPathtmp [file normalize [file join [pwd] $key_config]]
149    if {[file exists $configPathtmp]} {
150        set configPath $configPathtmp
151    } else {
152        file copy -force $configPath $::env(HOME)
153        popup_error "The config file provided $configPathtmp does not exists. A template has been copied on your \$HOME." strict
154    }
155} else {
156    file copy -force $configPath $::env(HOME)
157    popup_error "You must specify a config file with -config option. A template has been copied on your \$HOME." strict
158}
159if {![file exists $configPath]} {
160    popup_error "Config file $configPath doesn't exist." strict
161}
162
163
164set relaunchCmd "$relaunchCmd -config $configPath"
165
166# library
167set libraryPath [file normalize [file join $topPath "library"]]
168if {[info exists key_library]} {
169    set libraryPath  [file normalize $key_library]
170    set widgetInfo(libraryPath)   $libraryPath
171
172}
173if {![file exists $libraryPath]} {
174    popup_error "Library folder $libraryPath does not exist." strict
175}
176
177set relaunchCmd "$relaunchCmd -config $configPath -library $libraryPath"
178
179# plugin
180set pluginsPath [file normalize [file join $topPath "library" "DATA" "pluginscripts"]]
181if {[info exists key_plugins]} {
182    set pluginsPath  [file normalize $key_plugins]
183    set widgetInfo(pluginsPath)  $pluginsPath
184
185}
186if {![file exists $pluginsPath]} {
187    popup_error "Plugins folder $pluginsPath does not exist." strict
188}
189
190set relaunchCmd "$relaunchCmd -config $configPath -plugins $pluginsPath"
191
192
193# XDR
194set XDRpath [file normalize [file join $topPath "XDRpy"]]
195if {![file exists $XDRpath]} {
196    popup_error "XDR folder $XDRpath does not exist." strict
197}
198
199
200####################################
201# Check if XDRpy folder is available in the the PYTHONPATH
202if {"PYTHONPATH" in [array names ::env]} {
203    puts "PYTHONPATH content at startup : $::env(PYTHONPATH)"
204    puts "XDRpy is expected at  : $XDRpath"
205   
206} else {
207    puts "Warning ,  PYTHONPATH variable not set, no link possible with XDRpy"
208    puts "The XDRpy library is expected to be located at \n: $XDRpath " 
209    puts "exiting..."
210    exit
211}
212   
213if { ![string match *XDRpy* $::env(PYTHONPATH)] } {
214    puts "Warning ,  no pattern XDRpy found in PYTHONPATH"
215    puts "The XDRpy library is expected to be located at : $XDRpath"
216    puts "exiting..."
217    exit
218}
219
220
221
222
223
224
225
226
227####################################
228# Load the procedures
229
230
231if {$wrapper==1} {
232    source [file join $pathEngine "wrapper.tcl"]
233} else {
234    source [file join $pathEngine "unwrapped.tcl"]
235}   
236
237source [file join $pathEngine "functions.tcl"]
238source [file join $pathEngine "functions_theme.tcl"]
239source [file join $pathEngine "functions_help.tcl"]
240source [file join $pathEngine "dTree.tcl"]
241source [file join $pathEngine "test_vartypes.tcl"]
242source [file join $pathEngine "create_gui.tcl"]
243source [file join $pathEngine "declare_icons.tcl"]
244source [file join $pathEngine "declare_faq.tcl"]
245source [file join $pathEngine "XMLparser.tcl"]
246source [file join $pathEngine "dTreeBrowser.tcl"]
247source [file join $pathEngine "treeAnalyser.tcl"]
248source [file join $pathEngine "create_entry.tcl"]
249source [file join $pathEngine "create_cluster.tcl"]
250source [file join $pathEngine "create_comment.tcl"]
251source [file join $pathEngine "create_comparator.tcl"]
252source [file join $pathEngine "create_action.tcl"]
253source [file join $pathEngine "create_choice.tcl"]
254source [file join $pathEngine "create_dynlist.tcl"]
255source [file join $pathEngine "create_graph.tcl"]
256source [file join $pathEngine "create_glance.tcl"]
257source [file join $pathEngine "create_info.tcl"]
258source [file join $pathEngine "create_emptyNode.tcl"]
259source [file join $pathEngine "create_multiple.tcl"]
260source [file join $pathEngine "create_metaTree.tcl"]
261source [file join $pathEngine "create_switch.tcl"]
262source [file join $pathEngine "create_browser.tcl"]
263source [file join $pathEngine "create_selection.tcl"]
264source [file join $pathEngine "create_tabs.tcl"]
265source [file join $pathEngine "create_main.tcl"]
266source [file join $pathEngine "create_modelframe.tcl"]
267source [file join $pathEngine "create_modelxor_light.tcl"]
268source [file join $pathEngine "create_solverframe.tcl"]
269source [file join $pathEngine "create_scrollform.tcl"]
270source [file join $pathEngine "create_switchform.tcl"]
271source [file join $pathEngine "create_status.tcl"]
272source [file join $pathEngine "create_timeline.tcl"]
273source [file join $pathEngine "create_window.tcl"]
274source [file join $pathEngine "create_viewer.tcl"]
275source [file join $pathEngine "color_utilities.tcl"]
276source [file join $pathEngine "metaWidget_functions.tcl"]
277source [file join $pathEngine "config.tcl"]
278source [file join $pathEngine "openpipe.tcl"]
279source [file join $pathEngine "recentProjects.tcl"]
280source [file join $pathEngine "genPyFromXMLtree.tcl"]
281source [file join $pathEngine "grapher_utilities.tcl"]
282source [file join $pathEngine "smartpacker.tcl"]
283source [file join $pathEngine "load_save.tcl"]
284
285
286if {[info exists additionalWidgets] == 0} {
287    set additionalWidgets ""
288}
289
290foreach widget $additionalWidgets  {
291    source [file join $pathEngine "SOURCES_PRIV" create_$widget.tcl]   
292}
293
294
295
296
297
298.startup.l configure -image  icon_gui_small -compound top
299
300
301#Build application list, then check
302set applicationList [glob -tails -type d -directory $libraryPath *]
303lremove applicationList DATA
304set widgetInfo(applicationList) $applicationList
305if {[info exists key_code]} {
306    if {[lsearch $applicationList $key_code] < 0} {
307        set listappl [join $applicationList "\n"]
308        popup_error "Application $key_code was not found in the library.\n\n Applications available are:\n$listappl." strict
309    }
310    set loadApplication $key_code
311}
312
313
314
315if {[info exists key_file]} {
316    set fileerror 0
317    if {[file extension $key_file] != ".xml"} {
318        set fileerror "File $key_file is not an XML file."
319    }
320    if {![file exists $key_file]} {
321        set fileerror "File $key_file was not found."
322    }
323   
324    if {$fileerror != 0 } {
325        set dir [file dirname $key_file]
326       
327        set listfile [join [glob -directory $dir "*.xml"] "\n"]
328       
329        set fileerror "$fileerror \n\n Other xml files in this directory are \n$listfile."
330       
331        popup_error $fileerror strict
332        exit
333    }
334    set loadedProject [file normalize $key_file]
335}
336
337
338# declare fonts (see function.tcl)
339font_create
340ThemeUpdate [ getConfig "config gui appearance theme"]
341
342
343
344############################
345# Creating the Application #
346############################
347
348
349if {$loadApplication == "none"} {
350    main_create
351   
352} else {
353    # make sure default solver is in solverList
354    if {[lsearch $applicationList $loadApplication] < 0} {
355            tk_messageBox -icon error -message "Application $loadApplication was not found in the library.\nApplications available : [split $applicationList {, }]"
356            exit
357    } 
358   
359    set modelPath [file normalize [file join $libraryPath $loadApplication XML]]
360    set codesPath [file join $libraryPath $loadApplication scripts]
361    set dataPath [file join $libraryPath]
362   
363    set startNode ""
364    set XMLtree ""
365    set tmpTree ""
366    set DStree ""
367    set metaTree ""
368   
369     
370    global DStree
371    global XMLtree
372    global tmpTree
373    global metaTree
374   
375   
376   
377    dTree_init DStree
378    dTree_init tmpTree
379   
380    fill_metaTree
381
382   
383    set browsemode [getConfig "config gui paths"]
384    if { $browsemode == "constant"} {
385        set workingDir [getConfig "config gui paths constant workingDir"]
386        if {![file exists $workingDir]} {
387            popup_error "Constant working dir $workingDir doest not exists\nTo fix the pb, edit your file  $configPath \n with a valid path" strict
388        }
389    } else {
390        set workingDir [pwd]
391    }
392   
393    cd $workingDir
394    smartpacker_getconfig 
395   
396   
397   
398    OpenTeaXML2tree XMLtree $modelPath $dataPath
399   
400   
401    set nodes_to_skip ""
402    # Get the list of nodes to skip
403    set filename [file join $modelPath "nodes_to_skip" ]
404    if [file exists $filename ] {
405        set chout [ open $filename r ]
406        set content [ split [ read $chout] "\n" ]
407        close $chout
408        foreach line $content {
409            if {$line != "" && [string index $line 0] != "#"} {
410                lappend nodes_to_skip $line
411            }
412        }
413    }
414   
415    # Get the list of solvers to add
416    set solvers_to_add ""
417    set filename [file join $modelPath "solvers_to_add" ]
418    if [file exists $filename ] {
419        set chout [ open $filename r ]
420        set content [ split [ read $chout] "\n" ]
421        close $chout
422        foreach line $content {
423            if {$line != "" && [string index $line 0] != "#"} {
424                lappend solvers_to_add $line
425            }
426        }
427    }
428   
429    analyseModelTree XMLtree $nodes_to_skip $solvers_to_add
430   
431    if {[dTree_attrExists $XMLtree "root $loadApplication" "class"]} {
432         set widgetInfo(classApp) [dTree_getAttribute $XMLtree "root $loadApplication" "class"]       
433    }
434    log_create
435    Start_think ""
436    createWin .
437       
438    ttk::frame .main
439    pack .main -side left -fill both -expand true
440    set gui_win [gui_create -path ".main" -solver $loadApplication]
441    wm title . " [string toupper $loadApplication]"
442     
443    updateTitle   
444
445   
446    RefreshFamily "root"
447    update
448   
449    smartpacker_initialize_gui $loadedProject 
450   
451   
452    bind . <Escape> {+Stop_think abort}
453    bind . <Control-s> {Save_XML_File  "save"}
454    bind . <Control-h> {Window_help_generator}
455    bind . <Control-q> {quit_gui}
456   
457   
458    smartpacker_focus_correction
459   
460   
461    set load_stop_time [clock milliseconds]
462    set msgloadtime "Startup time :  [format "%0.3f" [expr { ($load_stop_time - $load_start_time)*0.001 }]] s."
463    log $msgloadtime
464
465    Stop_think normal
466}
467
468
469destroy .startup
470
471
472
473
474
475#  Copyright CERFACS 2014
476#   
477#  antoine.dauptain@cerfacs.fr
478#   
479#  This software is a computer program whose purpose is to ensure technology
480#  transfer between academia and industry.
481#   
482#  This software is governed by the CeCILL-B license under French law and
483#  abiding by the rules of distribution of free software.  You can  use,
484#  modify and/ or redistribute the software under the terms of the CeCILL-B
485#  license as circulated by CEA, CNRS and INRIA at the following URL
486#  "http://www.cecill.info".
487#   
488#  As a counterpart to the access to the source code and  rights to copy,
489#  modify and redistribute granted by the license, users are provided only
490#  with a limited warranty  and the software's author,  the holder of the
491#  economic rights,  and the successive licensors  have only  limited
492#  liability.
493#   
494#  In this respect, the user's attention is drawn to the risks associated
495#  with loading,  using,  modifying and/or developing or reproducing the
496#  software by the user in light of its specific status of free software,
497#  that may mean  that it is complicated to manipulate,  and  that  also
498#  therefore means  that it is reserved for developers  and  experienced
499#  professionals having in-depth computer knowledge. Users are therefore
500#  encouraged to load and test the software's suitability as regards their
501#  requirements in conditions enabling the security of their systems and/or
502#  data to be ensured and,  more generally, to use and operate it in the
503#  same conditions as regards security.
504#   
505#  The fact that you are presently reading this means that you have had
506#  knowledge of the CeCILL-B license and that you accept its terms.
Note: See TracBrowser for help on using the repository browser.