source: CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_gui.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: 12.0 KB
Line 
1#  This program is under CECILL_B licence. See footer for details.
2
3
4
5
6# hello world
7
8# Create a GUI associated to a tree
9proc gui_create { args } {
10    global widgetInfo
11    global XMLtree
12    global initializedSolver
13    global solverPath
14    global libraryPath
15    global solverOrder
16   
17    set address "root"
18    set initializedSolver ""
19   
20    # An initialization is mandatory for the root node but the initWidget doesn't fit requirements for the root node
21    set widgetInfo($address-require) ""
22    set widgetInfo($address-status) 0
23    set widgetInfo($address-check) ""
24    set widgetInfo($address-refresh) ""
25    set widgetInfo($address-refreshStatus) ""
26   
27    # loop on keywords provided
28    foreach { keyword argument } $args {
29        # test keywords
30        if {![string match -* $keyword ]} {
31            tk_messageBox -icon error -message "Error : keyword must be like -*"
32            return
33        }
34        # assign keywords
35        switch -- $keyword {
36            "-path" {
37               set win $argument
38            }
39            "-solver" {
40               set solver $argument
41            }
42            default {
43                tk_messageBox -icon error -message  "Error : $keyword is not recognized"
44                return
45            }
46        }
47    }
48    set widgetInfo($address-refreshStatus) ""
49   
50    set win_GUI [ solverframe_create -path_father $win -address "root"]
51   
52    # ensure that destroying the GUI frame will wipe out its associated memory
53    bind $win_GUI <Destroy> "gui_destroy $solver"
54   
55    # start the recursive creation of widgets
56   
57    ######## Sort the children according to their "order" attribute
58   
59    # First, get children and associated orders
60    foreach child [dTree_getChildren $XMLtree "root"]  {
61        set order "0"
62        set childAndOrder ""
63        # Retrieve order from either dict solver order (set solvers_to_add) or XML if absent
64        if { $child in [array names solverOrder]} {
65            set order $solverOrder($child)
66        } else {
67            set order [dTree_tryGetAttribute $XMLtree "root $child" order "9999"]
68        }
69        lappend childAndOrder $order
70        lappend childAndOrder $child
71        lappend childrenAndOrder $childAndOrder
72    }
73   
74    # Then, sort
75    set childrenAndOrder [lsort -index 0 -integer $childrenAndOrder]
76    # Finally, store them
77    foreach child $childrenAndOrder {
78        lappend sortedChildren [lindex $child 1]
79    }
80
81    ############ Loop over children
82    foreach solv $sortedChildren {
83        if {$solv == "DATA"} {
84            continue
85        }
86        set initializedSolver $solv
87        set solverPath [file join $libraryPath $solv]
88        gui_addpart -address root.$solv -path_father $win_GUI -class solver
89    }
90   
91   
92    return $win_GUI
93}
94
95proc gui_addpart { args } {
96    global GuiInfo
97    global DStree
98    global XMLtree
99    global additionalWidgets
100   
101    # set style . If style flat, simple frames will be used instead of labelframes
102    # used for labelframed widgets in modelxor or multiple
103    set part_style "normal"   
104   
105    # loop on keywords provided
106    foreach { keyword argument } $args {
107        # test keywords
108        if {![string match -* $keyword ]} {
109            tk_messageBox -icon error -message "Error : keyword must be like -*"
110            return
111        }
112        # assign keywords
113        switch -- $keyword {
114            "-address" {
115                set address $argument
116                set full_address_XML [split $argument "."]
117                set node_XML [lindex $full_address_XML end ]
118                set parent_address_XML [lrange $full_address_XML 0 end-1 ]
119                set parent_address [join $parent_address_XML .]
120            }
121            "-path_father" {
122               set path_father $argument
123            }
124            "-class" {
125                set part_class $argument
126            }
127            "-style" {
128                set part_style $argument
129            }
130           
131            default {
132                tk_messageBox -icon error -message  "Error : $keyword is not recognized"
133                return
134            }
135        }
136    }
137       
138
139    switch -glob $part_class {
140        "solver" {
141            set part_winactive [solverframe_add -path_father $path_father -address $address]
142        }
143        "tab" {
144            set part_winactive [tabs_add -path_father $path_father -address $address]
145        }
146        "model" {
147            set part_winactive [modelframe_create -path_father $path_father -address $address -style $part_style]
148        }
149        "multiple" {
150            set part_winactive [multiple_create -path_father $path_father -address $address]
151        }
152        "xor" {
153            set part_winactive [modelxor_create -path_father $path_father -address $address -style $part_style]
154        }
155        "action" {
156            set part_winactive [action_create -path_father $path_father -address $address -style $part_style]
157        }
158        "info" {
159            set part_winactive [info_create -path_father $path_father -address $address]
160        }
161        "choice" {
162            set part_winactive [choice_create -path_father $path_father -address $address]
163        }
164        "comment" {
165            set part_winactive [comment_create -path_father $path_father -address $address]
166        }
167        "comparator" {
168            set part_winactive [comparator_create -path_father $path_father -address $address]
169        }
170        "status" {
171            set part_winactive [status_create -path_father $path_father -address $address]
172        }
173        "graph" {
174            set part_winactive [graph_create -path_father $path_father -address $address]
175        }
176        "glance" {
177            set part_winactive [glance_create -path_father $path_father -address $address]
178        }
179        "timeline" {
180            set part_winactive [timeline_create -path_father $path_father -address $address]
181        }
182        "option" {
183            set part_winactive [choice_add -path_father $path_father -address $address]
184        }
185        "param" {
186            set param_type [dTree_getAttribute $XMLtree  $full_address_XML "type"]
187           
188            switch -glob $param_type {
189                "onoff" {
190                    set part_winactive [switch_create -path_father $path_father -address $address]
191                }
192                "double*" -
193                "integer*" -
194                "fraction" -
195                "date" -
196                "complex" -
197                "string*" -
198                "ascii*" -
199                "vector" -
200                "liststring" {
201                    set part_winactive [entry_create -path_father $path_father -address $address]
202                }
203                "list_*" {
204                    set part_winactive [cluster_create -path_father $path_father -address $address]
205                }
206                "selection" {
207                    set part_winactive [selection_create -path_father $path_father -address $address]
208                }
209                "file" -
210                "multiple_files" -
211                "h5_asciiBound" -
212                "folder" {
213                    set part_winactive [browser_create -path_father $path_father -address $address]
214                }
215                "speccompo" {
216                    error "speccompo is not supported anymore"
217                 #   set part_winactive [speccompo_create -path_father $path_father -address $address]
218                }
219                "labelimage" {
220                    error "labelimage is not supported anymore"
221                    #set part_winactive [labelimage_create -path_father $path_father -address $address]
222                }
223                default {
224                    set widget_title [dTree_getAttribute $XMLtree $full_address_XML "title"]
225                    set widget_status "GuiInfo($address-valid)"
226                    set $widget_status 0
227           
228                    set part_winactive  $path_father.$node_XML
229                    ttk::label $part_winactive -text "$widget_title ($param_type)"
230                    pack $part_winactive
231                }
232            }
233        }
234        "viewer" {
235            set part_winactive [viewer_create -path_father $path_father -address $address]
236        }
237        default {
238            if {$part_class in $additionalWidgets} {
239                set part_winactive [$part_class\_create -path_father $path_father -address $address]
240            } else {
241                debug "part_class Unknown : $part_class ; $address"
242                set part_winactive "unknown"
243            }
244        }
245    }
246   
247    # recursive GUI generation
248   
249    set GuiInfo($address-children) [dTree_getChildren $XMLtree $full_address_XML]
250   
251    set sortedChildren ""
252    set childrenAndOrder ""
253   
254    ######## Sort the children according to their "order" attribute
255   
256    # First, get children and associated orders
257    foreach child $GuiInfo($address-children) {
258        set order "0"
259        set childAndOrder ""
260        # Retrieve order from attributes of the child
261        set order [dTree_tryGetAttribute $XMLtree "$full_address_XML $child" order "9999"]
262        lappend childAndOrder $order
263        lappend childAndOrder $child
264        lappend childrenAndOrder $childAndOrder
265    }
266   
267    # Then, sort
268    set childrenAndOrder [lsort -index 0 -integer $childrenAndOrder]
269   
270    # Finally, store them
271    foreach child $childrenAndOrder {
272        lappend sortedChildren [lindex $child 1]
273    }
274   
275    set GuiInfo($address-children) $sortedChildren
276   
277    if {$part_class != "xor" && $part_class != "multiple"  && $part_class != "choice"} {
278        foreach child $GuiInfo($address-children) {
279            # Case of ";" type nodes (options)
280            if {[string match "*;*" $child]} {
281                set XML_node_address_child "$full_address_XML \{$child\}"
282            } else {
283                set XML_node_address_child [concat $full_address_XML $child]
284            }
285           
286            if {[catch {set widget_child_class "[dTree_getAttribute $XMLtree $XML_node_address_child nodeType]"}]} {
287                warning "WARNING : $XML_node_address_child doesn't have a node type ...\n Setting it to container ..."
288                set widget_child_class "container"
289            }
290            gui_addpart -address $address.$child  -path_father $part_winactive -class $widget_child_class
291        }
292    }
293   
294   
295    return $part_winactive
296}
297
298
299
300
301proc gui_destroy {win} {
302    global GuiInfo
303    foreach item [array names GuiInfo "$win-*"] {
304        unset GuiInfo($item)
305    }
306}
307
308
309
310#  Copyright CERFACS 2014
311#   
312#  antoine.dauptain@cerfacs.fr
313#   
314#  This software is a computer program whose purpose is to ensure technology
315#  transfer between academia and industry.
316#   
317#  This software is governed by the CeCILL-B license under French law and
318#  abiding by the rules of distribution of free software.  You can  use,
319#  modify and/ or redistribute the software under the terms of the CeCILL-B
320#  license as circulated by CEA, CNRS and INRIA at the following URL
321#  "http://www.cecill.info".
322#   
323#  As a counterpart to the access to the source code and  rights to copy,
324#  modify and redistribute granted by the license, users are provided only
325#  with a limited warranty  and the software's author,  the holder of the
326#  economic rights,  and the successive licensors  have only  limited
327#  liability.
328#   
329#  In this respect, the user's attention is drawn to the risks associated
330#  with loading,  using,  modifying and/or developing or reproducing the
331#  software by the user in light of its specific status of free software,
332#  that may mean  that it is complicated to manipulate,  and  that  also
333#  therefore means  that it is reserved for developers  and  experienced
334#  professionals having in-depth computer knowledge. Users are therefore
335#  encouraged to load and test the software's suitability as regards their
336#  requirements in conditions enabling the security of their systems and/or
337#  data to be ensured and,  more generally, to use and operate it in the
338#  same conditions as regards security.
339#   
340#  The fact that you are presently reading this means that you have had
341#  knowledge of the CeCILL-B license and that you accept its terms.
Note: See TracBrowser for help on using the repository browser.